From b34aa44cf554291569b1c44ed61ddd5a11616dac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Sun, 23 Jan 2022 21:17:31 +0100 Subject: [PATCH 1/2] Try untar-listing to check if the format is valid --- R/cloud.R | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/R/cloud.R b/R/cloud.R index 8e8b33b..2dbbf0f 100644 --- a/R/cloud.R +++ b/R/cloud.R @@ -127,7 +127,13 @@ cloud_fetch_results <- function(job_name = cloud_job(pkg = pkg), pkg = ".") { pb2 <- cli_progress_bar(format = "Extracting package results: {pb_percent}", total = sum(to_extract)) for (i in which(to_extract)) { out_file <- out_files[[i]] - utils::untar(out_file, exdir = out_dir) + files <- suppressWarnings(utils::untar(out_file, exdir = out_dir, list = TRUE)) + if (length(files) == 0) { + # Retry downloading next time + unlink(out_file) + } else { + utils::untar(out_file, exdir = out_dir) + } cli_progress_update(id = pb2) } cli_progress_done(id = pb2) From e21be3027215d1577666716b2fab7fb773dfe2e3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Sun, 13 Aug 2023 19:11:06 +0200 Subject: [PATCH 2/2] Tweaks --- DESCRIPTION | 3 ++- NAMESPACE | 2 +- R/cloud.R | 55 +++++++++++++++++++++++++++++++++++++++++++-- R/compare.R | 2 -- R/zzz.R | 6 +++++ man/cloud_broken.Rd | 3 +++ 6 files changed, 65 insertions(+), 6 deletions(-) create mode 100644 R/zzz.R diff --git a/DESCRIPTION b/DESCRIPTION index 9016271..e5a25cd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: revdepcheck Title: Automated Reverse Dependency Checking -Version: 1.0.0.9001 +Version: 1.0.0.9003 Authors@R: c( person("Gábor", "Csárdi", , "csardi.gabor@gmail.com", c("cre", "aut", "cph")), person("Hadley", "Wickham", role = "aut"), @@ -30,6 +30,7 @@ Imports: httr, jsonlite, knitr, + memoise, pkgbuild, prettyunits, processx (>= 3.3.0), diff --git a/NAMESPACE b/NAMESPACE index 5678f29..7427f9f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -20,6 +20,7 @@ export(cloud_fetch_results) export(cloud_job) export(cloud_job_mapping) export(cloud_plot) +export(cloud_problems) export(cloud_report) export(cloud_report_cran) export(cloud_report_failures) @@ -118,7 +119,6 @@ importFrom(prettyunits,vague_dt) importFrom(processx,process) importFrom(progress,progress_bar) importFrom(rcmdcheck,check_details) -importFrom(rcmdcheck,compare_checks) importFrom(rcmdcheck,rcmdcheck_process) importFrom(remotes,bioc_install_repos) importFrom(remotes,install_local) diff --git a/R/cloud.R b/R/cloud.R index 2dbbf0f..35d3efc 100644 --- a/R/cloud.R +++ b/R/cloud.R @@ -123,6 +123,11 @@ cloud_fetch_results <- function(job_name = cloud_job(pkg = pkg), pkg = ".") { cli_progress_done(id = pb) to_extract <- file.exists(out_files) & !dir.exists(file.path(out_dir, packages)) + if (!any(to_extract) && cloud_has_results_cache(job_name, pkg)) { + return() + } + + cloud_write_results_cache(NULL, job_name, pkg) pb2 <- cli_progress_bar(format = "Extracting package results: {pb_percent}", total = sum(to_extract)) for (i in which(to_extract)) { @@ -137,6 +142,32 @@ cloud_fetch_results <- function(job_name = cloud_job(pkg = pkg), pkg = ".") { cli_progress_update(id = pb2) } cli_progress_done(id = pb2) + + results <- cloud_compute_results(job_name, pkg) + cloud_write_results_cache(results, job_name, pkg) +} + +cloud_has_results_cache <- function(job_name, pkg) { + cloud <- dir_find(pkg, "cloud") + path <- file.path(cloud, paste0(job_name, ".rds")) + file.exists(path) +} + +cloud_read_results_cache <- function(job_name, pkg) { + cloud <- dir_find(pkg, "cloud") + path <- file.path(cloud, paste0(job_name, ".rds")) + readRDS(path) +} + +cloud_write_results_cache <- function(results, job_name, pkg) { + cloud <- dir_find(pkg, "cloud") + path <- file.path(cloud, paste0(job_name, ".rds")) + + if (is.null(results)) { + unlink(path, force = TRUE) + } else { + saveRDS(results, path, compress = FALSE) + } } #' Submit a reverse dependency checking job to the cloud @@ -382,9 +413,11 @@ cloud_compare <- function(pkg) { res$version <- description$get("Version")[[1]] return(res) } - rcmdcheck::compare_checks(old, new) + compare_checks(old, new) } +compare_checks <- NULL + #' Display revdep results #' #' Displays nicely formatted results of processed packages run in the cloud. @@ -524,9 +557,13 @@ cloud_report_cran <- function(job_name = cloud_job(pkg = pkg), pkg = ".", result #' @export cloud_results <- function(job_name = cloud_job(pkg = pkg), pkg = ".") { pkg <- pkg_check(pkg) - cloud <- dir_find(pkg, "cloud") cloud_fetch_results(job_name, pkg = pkg) + cloud_read_results_cache(job_name, pkg) +} + +cloud_compute_results <- function(job_name, pkg) { + cloud <- dir_find(pkg, "cloud") cli_alert_info("Comparing results") pkgs <- list.dirs(file.path(cloud, job_name), full.names = TRUE, recursive = FALSE) @@ -737,6 +774,20 @@ cloud_failed <- function(job_name = cloud_job(pkg = pkg), pkg = ".") { unlist(cloud_job_status(job_name, status = "FAILED")$packages) } +#' @rdname cloud_broken +#' @export +cloud_problems <- function(job_name = cloud_job(pkg = pkg), pkg = ".") { + ## We show the packages that are newly broken + is_problem <- function(x) { + any(x$cmp$change == 1) + } + + results <- cloud_results(job_name = job_name, pkg = pkg) + problem <- map_lgl(results, is_problem) + + map_chr(results[problem], `[[`, "package") +} + #' Browse to the AWS url for the job #' #' This is useful for closer inspection of individual jobs while they are diff --git a/R/compare.R b/R/compare.R index 2108869..a28dd79 100644 --- a/R/compare.R +++ b/R/compare.R @@ -1,6 +1,4 @@ -#' @importFrom rcmdcheck compare_checks - try_compare_checks <- function(package, old, new) { if (!inherits(old, "rcmdcheck") || !inherits(new, "rcmdcheck")) { rcmdcheck_error(package, old, new) diff --git a/R/zzz.R b/R/zzz.R new file mode 100644 index 0000000..a2df823 --- /dev/null +++ b/R/zzz.R @@ -0,0 +1,6 @@ +# nolint start +.onLoad <- function(libname, pkgname) { + # nolint end + compare_checks <<- memoise::memoise(rcmdcheck::compare_checks) + cloud_check_result <<- memoise::memoise(cloud_check_result) +} diff --git a/man/cloud_broken.Rd b/man/cloud_broken.Rd index 4664e7a..f8937a5 100644 --- a/man/cloud_broken.Rd +++ b/man/cloud_broken.Rd @@ -3,6 +3,7 @@ \name{cloud_broken} \alias{cloud_broken} \alias{cloud_failed} +\alias{cloud_problems} \title{Retrieve the names broken or failed packages} \usage{ cloud_broken( @@ -13,6 +14,8 @@ cloud_broken( ) cloud_failed(job_name = cloud_job(pkg = pkg), pkg = ".") + +cloud_problems(job_name = cloud_job(pkg = pkg), pkg = ".") } \arguments{ \item{job_name}{The job name, as returned by \code{\link[=cloud_check]{cloud_check()}}.}