From 7d786abb127feaff4973653cbcdd6f464a4d1487 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Tue, 21 Nov 2023 16:00:10 +0100 Subject: [PATCH] Update pkgcache, so it does not import --- src/library/pkgcache/DESCRIPTION | 2 +- src/library/pkgcache/NAMESPACE | 28 --------- src/library/pkgcache/R/aaa-async.R | 80 ++++++++++--------------- src/library/pkgcache/R/archive.R | 12 ++-- src/library/pkgcache/R/async-http.R | 5 +- src/library/pkgcache/R/metadata-cache.R | 49 +++++++-------- src/library/pkgcache/R/onload.R | 2 +- src/library/pkgcache/R/package-cache.R | 12 ++-- src/library/pkgcache/R/progress-bar.R | 20 +++---- 9 files changed, 77 insertions(+), 133 deletions(-) diff --git a/src/library/pkgcache/DESCRIPTION b/src/library/pkgcache/DESCRIPTION index bbe340e47..8e5ae5934 100644 --- a/src/library/pkgcache/DESCRIPTION +++ b/src/library/pkgcache/DESCRIPTION @@ -25,7 +25,7 @@ Language: en-US Roxygen: list(markdown = TRUE, r6 = FALSE) RoxygenNote: 7.2.3 NeedsCompilation: yes -Packaged: 2023-11-21 10:49:19 UTC; gaborcsardi +Packaged: 2023-11-21 14:59:49 UTC; gaborcsardi Author: Gábor Csárdi [aut, cre], Posit Software, PBC [cph, fnd] Maintainer: Gábor Csárdi diff --git a/src/library/pkgcache/NAMESPACE b/src/library/pkgcache/NAMESPACE index 4eea8f12d..dc0dded24 100644 --- a/src/library/pkgcache/NAMESPACE +++ b/src/library/pkgcache/NAMESPACE @@ -48,34 +48,6 @@ export(repo_status) export(with_repo) if (getRversion() >= "4.0.0") importFrom(tools, R_user_dir) importFrom(R6,R6Class) -importFrom(callr,r_process) -importFrom(callr,r_process_options) -importFrom(callr,r_session) -importFrom(callr,rcmd_safe_env) -importFrom(cli,cli_alert_info) -importFrom(cli,cli_process_done) -importFrom(cli,cli_process_start) -importFrom(cli,cli_status) -importFrom(cli,cli_status_clear) -importFrom(cli,cli_status_update) -importFrom(cli,get_spinner) -importFrom(cli,hash_obj_md5) -importFrom(curl,handle_data) -importFrom(curl,handle_setheaders) -importFrom(curl,handle_setopt) -importFrom(curl,multi_add) -importFrom(curl,multi_cancel) -importFrom(curl,multi_fdset) -importFrom(curl,multi_list) -importFrom(curl,multi_run) -importFrom(curl,multi_set) -importFrom(curl,new_handle) -importFrom(curl,new_pool) -importFrom(curl,parse_headers_list) -importFrom(filelock,lock) -importFrom(filelock,unlock) -importFrom(processx,conn_get_fileno) -importFrom(processx,process) importFrom(tools,file_ext) importFrom(utils,URLencode) importFrom(utils,getSrcDirectory) diff --git a/src/library/pkgcache/R/aaa-async.R b/src/library/pkgcache/R/aaa-async.R index 39c314477..21b9fbc5f 100644 --- a/src/library/pkgcache/R/aaa-async.R +++ b/src/library/pkgcache/R/aaa-async.R @@ -1757,8 +1757,6 @@ el_init <- function(self, private) { invisible(self) } -#' @importFrom curl multi_add parse_headers_list handle_data - el_add_http <- function(self, private, handle, callback, progress, file, data) { self; private; handle; callback; progress; outfile <- file; data @@ -1770,7 +1768,7 @@ el_add_http <- function(self, private, handle, callback, progress, file, content <- NULL - multi_add( + curl::multi_add( handle = handle, pool = private$pool, done = function(response) { @@ -1852,13 +1850,11 @@ el_add_next_tick <- function(self, private, func, callback, data) { private$next_ticks <- c(private$next_ticks, id) } -#' @importFrom curl multi_cancel - el_cancel <- function(self, private, id) { private$next_ticks <- setdiff(private$next_ticks, id) private$timers <- private$timers[setdiff(names(private$timers), id)] if (id %in% names(private$tasks) && private$tasks[[id]]$type == "http") { - multi_cancel(private$tasks[[id]]$data$handle) + curl::multi_cancel(private$tasks[[id]]$data$handle) } else if (id %in% names(private$tasks) && private$tasks[[id]]$type %in% c("process", "r-process")) { private$tasks[[id]]$data$process$kill() @@ -1870,11 +1866,9 @@ el_cancel <- function(self, private, id) { invisible(self) } -#' @importFrom curl multi_cancel multi_list - el_cancel_all <- function(self, private) { - http <- multi_list(pool = private$pool) - lapply(http, multi_cancel) + http <- curl::multi_list(pool = private$pool) + lapply(http, curl::multi_cancel) private$next_ticks <- character() private$timers <- Sys.time()[numeric()] @@ -1969,8 +1963,6 @@ el__run_pending <- function(self, private) { length(next_ticks) > 0 || finished_pool } -#' @importFrom curl multi_run multi_fdset - el__io_poll <- function(self, private, timeout) { types <- vcapply(private$tasks, "[[", "type") @@ -2026,7 +2018,7 @@ el__io_poll <- function(self, private, timeout) { } if (!is.null(private$curl_timer) && private$curl_timer <= private$time) { - multi_run(timeout = 0L, poll = TRUE, pool = private$pool) + curl::multi_run(timeout = 0L, poll = TRUE, pool = private$pool) private$curl_timer <- NULL } @@ -2038,7 +2030,7 @@ el__io_poll <- function(self, private, timeout) { ## Any HTTP? if (private$curl_poll && pollables$ready[match("curl", pollables$type)] == "event") { - multi_run(timeout = 0L, poll = TRUE, pool = private$pool) + curl::multi_run(timeout = 0L, poll = TRUE, pool = private$pool) } ## Any processes @@ -2111,8 +2103,6 @@ el__create_task <- function(self, private, callback, data, ..., id, type) { id } -#' @importFrom curl new_pool - el__ensure_pool <- function(self, private) { getopt <- function(nm) { anm <- paste0("async_http_", nm) @@ -2126,7 +2116,7 @@ el__ensure_pool <- function(self, private) { host_con = getopt("host_con") %||% 6, multiplex = getopt("multiplex") %||% TRUE ) - private$pool <- new_pool( + private$pool <- curl::new_pool( total_con = private$http_opts$total_con, host_con = private$http_opts$host_con, multiplex = private$http_opts$multiplex @@ -2134,14 +2124,12 @@ el__ensure_pool <- function(self, private) { } } -#' @importFrom curl multi_set - el_http_setopt <- function(self, private, total_con, host_con, multiplex) { private$ensure_pool() if (!is.null(total_con)) private$http_opts$total_con <- total_con if (!is.null(host_con)) private$http_opts$host_con <- host_con if (!is.null(multiplex)) private$http_opts$multiplex <- multiplex - multi_set( + curl::multi_set( pool = private$pool, total_con = private$http_opts$total_con, host_con = private$http_opts$host_con, @@ -2195,10 +2183,8 @@ el__update_time <- function(self, private) { private$time <- Sys.time() } -#' @importFrom curl multi_fdset -#' el__update_curl_data <- function(self, private) { - private$curl_fdset <- multi_fdset(private$pool) + private$curl_fdset <- curl::multi_fdset(private$pool) num_fds <- length(unique(unlist(private$curl_fdset[1:3]))) private$curl_poll <- num_fds > 0 private$curl_timer <- if ((t <- private$curl_fdset$timeout) != -1) { @@ -2536,7 +2522,6 @@ async_reject <- mark_as_async(async_reject) #' #' @family asyncronous HTTP calls #' @noRd -#' @importFrom curl new_handle handle_setheaders #' @examples #' \donttest{ #' afun <- async(function() { @@ -2555,8 +2540,8 @@ http_get <- function(url, headers = character(), file = NULL, make_deferred_http( function() { assert_that(is_string(url)) - handle <- new_handle(url = url) - handle_setheaders(handle, .list = headers) + handle <- curl::new_handle(url = url) + curl::handle_setheaders(handle, .list = headers) if (!is.null(on_progress)) { options$noprogress <- FALSE @@ -2575,7 +2560,7 @@ http_get <- function(url, headers = character(), file = NULL, reg.finalizer(handle, function(...) fun, onexit = TRUE) } - handle_setopt(handle, .list = options) + curl::handle_setopt(handle, .list = options) list(handle = handle, options = options) }, file @@ -2591,7 +2576,6 @@ http_get <- mark_as_async(http_get) #' #' @family asyncronous HTTP calls #' @noRd -#' @importFrom curl handle_setopt #' @examples #' \donttest{ #' afun <- async(function() { @@ -2618,9 +2602,9 @@ http_head <- function(url, headers = character(), file = NULL, make_deferred_http( function() { assert_that(is_string(url)) - handle <- new_handle(url = url) - handle_setheaders(handle, .list = headers) - handle_setopt(handle, customrequest = "HEAD", nobody = TRUE, + handle <- curl::new_handle(url = url) + curl::handle_setheaders(handle, .list = headers) + curl::handle_setopt(handle, customrequest = "HEAD", nobody = TRUE, .list = options) list(handle = handle, options = options) }, @@ -2676,9 +2660,9 @@ http_post <- function(url, data = NULL, data_file = NULL, make_deferred_http( function() { assert_that(is_string(url)) - handle <- new_handle(url = url) - handle_setheaders(handle, .list = headers) - handle_setopt(handle, customrequest = "POST", + handle <- curl::new_handle(url = url) + curl::handle_setheaders(handle, .list = headers) + curl::handle_setopt(handle, customrequest = "POST", postfieldsize = length(data), postfields = data, .list = options) list(handle = handle, options = options) @@ -2696,9 +2680,9 @@ http_delete <- function(url, headers = character(), file = NULL, make_deferred_http( function() { assert_that(is_string(url)) - handle <- new_handle(url = url) - handle_setheaders(handle, .list = headers) - handle_setopt(handle, customrequest = "DELETE", .list = options) + handle <- curl::new_handle(url = url) + curl::handle_setheaders(handle, .list = headers) + curl::handle_setopt(handle, customrequest = "DELETE", .list = options) list(handle = handle, options = options) }, file @@ -2985,7 +2969,10 @@ async_map_limit <- function(.x, .f, ..., .args = list(), .limit = Inf) { ## nocov start .onLoad <- function(libname, pkgname) { - if (requireNamespace("debugme", quietly = TRUE)) debugme::debugme() + if (Sys.getenv("DEBUGME") != "" && + requireNamespace("debugme", quietly = TRUE)) { + debugme::debugme() + } } ## nocov end @@ -3002,7 +2989,6 @@ async_map_limit <- function(.x, .f, ..., .args = list(), .limit = Inf) { #' #' @family asynchronous external processes #' @noRd -#' @importFrom processx process #' @examples #' \dontrun{ #' afun <- function() { @@ -3029,7 +3015,7 @@ run_process <- function(command = NULL, args = character(), reject <- environment(resolve)$private$reject stdout <- tempfile() stderr <- tempfile() - px <- process$new(command, args = args, + px <- processx::process$new(command, args = args, stdout = stdout, stderr = stderr, poll_connection = TRUE, env = env, cleanup = TRUE, cleanup_tree = TRUE, wd = wd, encoding = encoding, ...) @@ -3055,7 +3041,6 @@ run_process <- mark_as_async(run_process) #' #' @inheritParams callr::r_bg #' @noRd -#' @importFrom callr r_process_options r_process rcmd_safe_env #' #' @examples #' \dontrun{ @@ -3068,7 +3053,7 @@ run_process <- mark_as_async(run_process) run_r_process <- function(func, args = list(), libpath = .libPaths(), repos = c(getOption("repos"), c(CRAN = "https://cloud.r-project.org")), cmdargs = c("--no-site-file", "--slave", "--no-save", "--no-restore"), - system_profile = FALSE, user_profile = FALSE, env = rcmd_safe_env()) { + system_profile = FALSE, user_profile = FALSE, env = callr::rcmd_safe_env()) { func; args; libpath; repos; cmdargs; system_profile; user_profile; env @@ -3081,13 +3066,13 @@ run_r_process <- function(func, args = list(), libpath = .libPaths(), reject <- environment(resolve)$private$reject stdout <- tempfile() stderr <- tempfile() - opts <- r_process_options( + opts <- callr::r_process_options( func = func, args = args, libpath = libpath, repos = repos, cmdargs = cmdargs, system_profile = system_profile, user_profile = user_profile, env = env, stdout = stdout, stderr = stderr, extra = list(cleanup_tree = TRUE)) - rx <- r_process$new(opts) + rx <- callr::r_process$new(opts) pipe <- rx$get_poll_connection() id <<- get_default_event_loop()$add_r_process( list(pipe), @@ -4278,9 +4263,6 @@ wp_init <- function(self, private) { invisible(self) } -#' @importFrom callr r_session -#' @importFrom processx conn_get_fileno - wp_start_workers <- function(self, private) { num <- worker_pool_size() @@ -4289,8 +4271,8 @@ wp_start_workers <- function(self, private) { ## Yeah, start some more to_start <- num - NROW(private$workers) - sess <- lapply(1:to_start, function(x) r_session$new(wait = FALSE)) - fd <- viapply(sess, function(x) conn_get_fileno(x$get_poll_connection())) + sess <- lapply(1:to_start, function(x) callr::r_session$new(wait = FALSE)) + fd <- viapply(sess, function(x) processx::conn_get_fileno(x$get_poll_connection())) new_workers <- data.frame( stringsAsFactors = FALSE, session = I(sess), diff --git a/src/library/pkgcache/R/archive.R b/src/library/pkgcache/R/archive.R index ed3792fe3..0cbf4ad06 100644 --- a/src/library/pkgcache/R/archive.R +++ b/src/library/pkgcache/R/archive.R @@ -264,7 +264,7 @@ cac_cleanup <- function(self, private, force) { rep_etag <- paste0(rep_rds, "-etag") unlink(c(rep_rds, rep_etag), recursive = TRUE, force = TRUE) private$data <- NULL - cli_alert_info("Cleaning up archive cache in {.path {pri_rds}}.") + cli::cli_alert_info("Cleaning up archive cache in {.path {pri_rds}}.") unlink(c(pri_rds, pri_etag, pri_lock), recursive = TRUE, force = TRUE) invisible(self) } @@ -331,9 +331,9 @@ cac__load_primary <- function(self, private, max_age) { pri_lock <- paste0(pri_file, "-lock") mkdirp(dirname(pri_lock)) - l <- lock(pri_lock, exclusive = FALSE, private$lock_timeout) + l <- filelock::lock(pri_lock, exclusive = FALSE, private$lock_timeout) if (is.null(l)) stop("Cannot acquire lock to copy RDS") - on.exit(unlock(l), add = TRUE) + on.exit(filelock::unlock(l), add = TRUE) if (!file.exists(pri_file)) stop("No primary RDS file in cache") time <- file_get_time(pri_file) @@ -345,7 +345,7 @@ cac__load_primary <- function(self, private, max_age) { rep_etag <- paste0(rep_file, "-etag") file_copy_with_time(pri_etag, rep_etag) - unlock(l) + filelock::unlock(l) private$data <- readRDS(rep_file) private$data_time <- time @@ -422,9 +422,9 @@ cac__update_primary <- function(self, private, lock) { if (lock) { pri_lock <- paste0(pri_file, "-lock") mkdirp(dirname(pri_lock)) - l <- lock(pri_lock, exclusive = FALSE, private$lock_timeout) + l <- filelock::lock(pri_lock, exclusive = FALSE, private$lock_timeout) if (is.null(l)) stop("Cannot acquire lock to copy RDS") - on.exit(unlock(l), add = TRUE) + on.exit(filelock::unlock(l), add = TRUE) } file_copy_with_time(rep_file, pri_file) diff --git a/src/library/pkgcache/R/async-http.R b/src/library/pkgcache/R/async-http.R index fda9422ab..38ddb6ae0 100644 --- a/src/library/pkgcache/R/async-http.R +++ b/src/library/pkgcache/R/async-http.R @@ -67,7 +67,6 @@ update_async_timeouts <- function(options) { #' * `etag_file`: The file the ETag was written to, or `NULL` otherwise #' #' @family async HTTP tools -#' @importFrom curl parse_headers_list #' @noRd #' @section Examples: #' ``` @@ -122,7 +121,7 @@ download_file <- function(url, destfile, etag_file = NULL, then(function(resp) { "!DEBUG downloaded `url`" file.rename(tmp_destfile, destfile) - etag <- parse_headers_list(resp$headers)[["etag"]] %||% NA_character_ + etag <- curl::parse_headers_list(resp$headers)[["etag"]] %||% NA_character_ if (!is.null(etag_file) && !is.na(etag[1])) { mkdirp(dirname(etag_file)) writeLines(etag, etag_file) @@ -245,7 +244,7 @@ download_if_newer <- function(url, destfile, etag_file = NULL, } else if (resp$status_code == 200 || resp$status_code == 0) { "!DEBUG downloaded `url`" file.rename(tmp_destfile, destfile) - etag <- parse_headers_list(resp$headers)[["etag"]] %||% NA_character_ + etag <- curl::parse_headers_list(resp$headers)[["etag"]] %||% NA_character_ if (!is.null(etag_file) && !is.na(etag[1])) { mkdirp(dirname(etag_file)) writeLines(etag, etag_file) diff --git a/src/library/pkgcache/R/metadata-cache.R b/src/library/pkgcache/R/metadata-cache.R index 0bfe15e4f..37ca98404 100644 --- a/src/library/pkgcache/R/metadata-cache.R +++ b/src/library/pkgcache/R/metadata-cache.R @@ -376,8 +376,6 @@ cmc_summary <- function(self, private) { ) } -#' @importFrom cli cli_alert_info - cmc_cleanup <- function(self, private, force) { if (!force && !interactive()) { stop("Not cleaning up cache, please specify `force = TRUE`") @@ -396,13 +394,16 @@ cmc_cleanup <- function(self, private, force) { unlink(local_cache_dir, recursive = TRUE, force = TRUE) private$data <- NULL private$data_messaged <- NULL - cli_alert_info("Cleaning up cache directory {.path {cache_dir}}.") + cli::cli_alert_info("Cleaning up cache directory {.path {cache_dir}}.") unlink(cache_dir, recursive = TRUE, force = TRUE) } -#' @importFrom cli hash_obj_md5 #' @importFrom utils URLencode +hash_obj_md5 <- function(x, ...) { + cli::hash_obj_md5(x, ...) +} + repo_encode <- function(repos) { paste0( vcapply(repos$name, URLencode, reserved = TRUE), "-", @@ -603,7 +604,6 @@ cmc__get_memory_cache <- function(self, private, max_age) { #' as current. #' @return The metadata. #' @keywords internal -#' @importFrom cli cli_process_start cli_process_done cmc__load_replica_rds <- function(self, private, max_age) { "!!DEBUG Load replica RDS?" @@ -613,13 +613,13 @@ cmc__load_replica_rds <- function(self, private, max_age) { time <- file_get_time(rds) if (Sys.time() - time > max_age) stop("Replica RDS cache file outdated") - sts <- cli_process_start("Loading metadata database") + sts <- cli::cli_process_start("Loading metadata database") private$data <- readRDS(rds) private$data_time <- time private$data_messaged <- NULL "!!DEBUG Loaded replica RDS!" private$update_memory_cache() - cli_process_done(sts) + cli::cli_process_done(sts) private$data } @@ -632,7 +632,6 @@ cmc__load_replica_rds <- function(self, private, max_age) { #' @inheritParams cmc__load_replica_rds #' @return Metadata. #' @keywords internal -#' @importFrom cli cli_process_start cli_process_done cmc__load_primary_rds <- function(self, private, max_age) { "!!DEBUG Load primary RDS?" @@ -640,9 +639,9 @@ cmc__load_primary_rds <- function(self, private, max_age) { rep_files <- private$get_cache_files("replica") mkdirp(dirname(pri_files$lock)) - l <- lock(pri_files$lock, exclusive = FALSE, private$lock_timeout) + l <- filelock::lock(pri_files$lock, exclusive = FALSE, private$lock_timeout) if (is.null(l)) stop("Cannot acquire lock to copy RDS") - on.exit(unlock(l), add = TRUE) + on.exit(filelock::unlock(l), add = TRUE) if (!file.exists(pri_files$rds)) stop("No primary RDS file in cache") time <- file_get_time(pri_files$rds) @@ -655,16 +654,16 @@ cmc__load_primary_rds <- function(self, private, max_age) { stop("Primary PACKAGES missing or newer than replica RDS, removing") } - sts <- cli_process_start("Loading metadata database") + sts <- cli::cli_process_start("Loading metadata database") file_copy_with_time(pri_files$rds, rep_files$rds) - unlock(l) + filelock::unlock(l) private$data <- readRDS(rep_files$rds) private$data_time <- time private$data_messaged <- NULL private$update_memory_cache() - cli_process_done(sts) + cli::cli_process_done(sts) private$data } @@ -681,7 +680,6 @@ cmc__load_primary_rds <- function(self, private, max_age) { #' @param max_age Max age to consider the files current. #' @return Metadata. #' @keywords internal -#' @importFrom cli cli_process_start cli_process_done cmc__load_primary_pkgs <- function(self, private, max_age) { "!!DEBUG Load replica PACKAGES*?" @@ -690,9 +688,9 @@ cmc__load_primary_pkgs <- function(self, private, max_age) { ## Lock mkdirp(dirname(pri_files$lock)) - l <- lock(pri_files$lock, exclusive = FALSE, private$lock_timeout) + l <- filelock::lock(pri_files$lock, exclusive = FALSE, private$lock_timeout) if (is.null(l)) stop("Cannot acquire lock to copy PACKAGES files") - on.exit(unlock(l), add = TRUE) + on.exit(filelock::unlock(l), add = TRUE) ## Check if PACKAGES exist and current. It is OK if metadata is missing pkg_files <- pri_files$pkgs$path @@ -705,7 +703,7 @@ cmc__load_primary_pkgs <- function(self, private, max_age) { } ## Copy to replica, if we cannot copy the etags, that's ok - sts <- cli_process_start("Loading metadata database") + sts <- cli::cli_process_start("Loading metadata database") private$copy_to_replica(rds = FALSE, pkgs = TRUE, etags = TRUE) ## Update RDS in replica, this also loads it @@ -713,7 +711,7 @@ cmc__load_primary_pkgs <- function(self, private, max_age) { ## Update primary, but not the PACKAGES private$update_primary(rds = TRUE, packages = FALSE, lock = FALSE) - cli_process_done(sts) + cli::cli_process_done(sts) private$data } @@ -785,7 +783,7 @@ missing_pkgs_note <- function(pkgs, result) { where <- vcapply(msgs, "[[", 2) for (wt in unique(what)) { wh <- unique(where[what == wt]) - cli_alert_info("{wt} packages are missing from {wh}") + cli::cli_alert_info("{wt} packages are missing from {wh}") } } @@ -797,11 +795,10 @@ missing_pkgs_note <- function(pkgs, result) { #' @param private private self #' @param alert whether to show message about the update #' @keywords internal -#' @importFrom cli cli_process_start cli_process_done cmc__update_replica_rds <- function(self, private, alert) { "!!DEBUG Update replica RDS" - if (alert) sts <- cli_process_start("Updating metadata database") + if (alert) sts <- cli::cli_process_start("Updating metadata database") rep_files <- private$get_cache_files("replica") data_list <- lapply_rows( @@ -827,7 +824,7 @@ cmc__update_replica_rds <- function(self, private, alert) { private$update_memory_cache() - if (alert) cli_process_done(sts) + if (alert) cli::cli_process_done(sts) private$data } @@ -851,9 +848,9 @@ cmc__update_primary <- function(self, private, rds, packages, lock) { if (lock) { mkdirp(dirname(pri_files$lock)) - l <- lock(pri_files$lock, exclusive = TRUE, private$lock_timeout) + l <- filelock::lock(pri_files$lock, exclusive = TRUE, private$lock_timeout) if (is.null(l)) stop("Cannot acquire lock to update primary cache") - on.exit(unlock(l), add = TRUE) + on.exit(filelock::unlock(l), add = TRUE) } if (rds) { @@ -884,9 +881,9 @@ cmc__copy_to_replica <- function(self, private, rds, pkgs, etags) { rep_files <- private$get_cache_files("replica") mkdirp(dirname(pri_files$lock)) - l <- lock(pri_files$lock, exclusive = FALSE, private$lock_timeout) + l <- filelock::lock(pri_files$lock, exclusive = FALSE, private$lock_timeout) if (is.null(l)) stop("Cannot acquire lock to copy primary cache") - on.exit(unlock(l), add = TRUE) + on.exit(filelock::unlock(l), add = TRUE) if (rds) { file_copy_with_time(pri_files$rds, rep_files$rds) diff --git a/src/library/pkgcache/R/onload.R b/src/library/pkgcache/R/onload.R index 4f336611b..8d8ea770c 100644 --- a/src/library/pkgcache/R/onload.R +++ b/src/library/pkgcache/R/onload.R @@ -641,7 +641,7 @@ if (exists(".onLoad", inherits = FALSE)) { get_cranlike_metadata_cache <- function() { repos <- repo_get() - hash <- cli::hash_obj_md5(repos$url) + hash <- hash_obj_md5(repos$url) if (is.null(pkgenv$global_metadata_cache[[hash]])) { pkgenv$global_metadata_cache[[hash]] <- cranlike_metadata_cache$new() } diff --git a/src/library/pkgcache/R/package-cache.R b/src/library/pkgcache/R/package-cache.R index cdca92dbe..6d6f83994 100644 --- a/src/library/pkgcache/R/package-cache.R +++ b/src/library/pkgcache/R/package-cache.R @@ -121,7 +121,7 @@ package_cache <- R6Class( list = function() { l <- private$lock(exclusive = FALSE) - on.exit(unlock(l), add = TRUE) + on.exit(filelock::unlock(l), add = TRUE) dbfile <- get_db_file(private$path) readRDS(dbfile) }, @@ -132,7 +132,7 @@ package_cache <- R6Class( copy_to = function(target, ..., .list = NULL) { l <- private$lock(exclusive = FALSE) - on.exit(unlock(l), add = TRUE) + on.exit(filelock::unlock(l), add = TRUE) res <- private$find_locked(..., .list = .list) if (!is.null(target) && nrow(res) >= 1) { mkdirp(dirname(target)) @@ -146,7 +146,7 @@ package_cache <- R6Class( assert_that(is_existing_file(file)) l <- private$lock(exclusive = TRUE) - on.exit(unlock(l), add = TRUE) + on.exit(filelock::unlock(l), add = TRUE) dbfile <- get_db_file(private$path) db <- readRDS(dbfile) @@ -294,7 +294,7 @@ package_cache <- R6Class( delete = function(..., .list = NULL) { l <- private$lock(exclusive = TRUE) - on.exit(unlock(l), add = TRUE) + on.exit(filelock::unlock(l), add = TRUE) dbfile <- get_db_file(private$path) ex <- private$find_locked(..., .list = .list) @@ -345,8 +345,8 @@ create_empty_db_file_if_needed <- function(path) { df <- make_empty_db_data_frame() - l <- lock(lockfile) - on.exit(unlock(l)) + l <- filelock::lock(lockfile) + on.exit(filelock::unlock(l)) save_rds(df, dbfile) } diff --git a/src/library/pkgcache/R/progress-bar.R b/src/library/pkgcache/R/progress-bar.R index 51eedc170..134ecda16 100644 --- a/src/library/pkgcache/R/progress-bar.R +++ b/src/library/pkgcache/R/progress-bar.R @@ -1,19 +1,17 @@ -#' @importFrom cli get_spinner cli_status - create_progress_bar <- function(data) { bar <- new.env(parent = emptyenv()) if (isTRUE(getOption("pkg.show_progress", FALSE))) { - bar$status <- cli_status( + bar$status <- cli::cli_status( "Checking for {nrow(data)} new metadata file{?s}", .auto_close = FALSE ) } else { - bar$status <- cli_status(character(), .auto_close = FALSE) + bar$status <- cli::cli_status(character(), .auto_close = FALSE) } - bar$spinner <- get_spinner() + bar$spinner <- cli::get_spinner() bar$spinner_state <- 1L bar$data <- data @@ -52,8 +50,6 @@ update_progress_bar_done <- function(bar, url) { file.size(bar$data$path[[wh]]) } -#' @importFrom cli cli_status_update - show_progress_bar <- function(bar) { if (is.null(bar$status) || !isTRUE(getOption("pkg.show_progress", FALSE))) { @@ -76,18 +72,16 @@ show_progress_bar <- function(bar) { bar$spinner_state <- 1L } - cli_status_update( + cli::cli_status_update( bar$status, c("{spinner} Updating metadata database [{uptodate}/{numfiles}] | ", "Downloading {downloads}") ) } -#' @importFrom cli cli_status_clear - finish_progress_bar <- function(ok, bar) { if (!ok) { - cli_status_clear( + cli::cli_status_clear( bar$status, result = "failed", msg_failed = "{.alert-danger Metadata update failed}" @@ -97,14 +91,14 @@ finish_progress_bar <- function(ok, bar) { dl <- vlapply(bar$data$uptodate, identical, FALSE) files <- sum(dl) bytes <- format_bytes$pretty_bytes(sum(bar$data$size[dl], na.rm = TRUE)) - cli_status_clear( + cli::cli_status_clear( bar$status, result = "done", msg_done = "{.alert-success Updated metadata database: {bytes} in {files} file{?s}.}" ) } else { - cli_status_clear(bar$status) + cli::cli_status_clear(bar$status) } bar$status <- NULL