downloading directories -- tests updates

PredictiveEcology · Jan 14, 2025 · b979381 · b979381
1 parent 9b2ba7a
commit b979381
Show file tree

Hide file tree

Showing 4 changed files with 75 additions and 25 deletions.
diff --git a/R/download.R b/R/download.R
@@ -55,7 +55,7 @@ downloadFile <- function(archive, targetFile, neededFiles,
   }
 
   if (!is.null(url) || !is.null(dlFun)) {
-    missingNeededFiles <- missingFiles(neededFiles, checkSums, targetFile, destinationPath)
+    missingNeededFiles <- missingFiles(neededFiles, checkSums, destinationPath)
 
     if (missingNeededFiles) { # needed may be missing, but maybe can skip download b/c archive exists
       if (!is.null(archive)) {
@@ -89,7 +89,7 @@ downloadFile <- function(archive, targetFile, neededFiles,
             }
 
             # Check again, post extract ... If FALSE now, then it got it from local, already existing archive
-            missingNeededFiles <- missingFiles(neededFiles, checkSums, targetFile, destinationPath)
+            missingNeededFiles <- missingFiles(neededFiles, checkSums, destinationPath)
             if (!missingNeededFiles) {
               archive <- archive[localArchivesExist]
             }
@@ -695,7 +695,7 @@ downloadRemote <- function(url, archive, targetFile, checkSums, dlFun = NULL,
         }
 
         if (is.call(dlFun)) {
-          out <- try(eval(dlFun, envir = .callingEnv))
+          out <- try(eval(dlFun, envir = .callingEnv), silent = TRUE)
           if (is(out, "try-error")) {
             sfs <- sys.frames()
             for (i in seq_along(sfs)) {
@@ -713,10 +713,19 @@ downloadRemote <- function(url, archive, targetFile, checkSums, dlFun = NULL,
         }
 
         if (!is.call(dlFun)) {
-          formsDlFun <- formalArgs(dlFun)
-          argsKeep <- intersect(formsDlFun, names(args))
-          args <- args[argsKeep]
-          out <- do.call(dlFun, args = args)
+          out <- runDlFun(args, dlFun)
+          # argsOrig <- args
+          # formsDlFun <- formalArgs(dlFun)
+          # argsKeep <- intersect(formsDlFun, names(args))
+          # args <- args[argsKeep]
+          # for (iii in 1:2) {
+          #   out <- try(do.call(dlFun, args = args), silent = TRUE)
+          #   if (!is(out, "try-error")) {
+          #     break
+          #   }
+          #   args <- argsOrig
+          # }
+
         }
 
         needSave <- !is.null(out) # TRUE
@@ -831,14 +840,34 @@ downloadRemote <- function(url, archive, targetFile, checkSums, dlFun = NULL,
                 }
                 filenames <- grep(theGrep, filenames, value = TRUE)
               }
+              # now that we have filenames; need to checksum
               urls <- file.path(url, filenames)
-              messagePrepInputs("url was supplied as a directory; downloading all files ",
-                                "with similar name as targetFile (", filePathSansExt(targetFile), ")",
-                                verbose = verbose)
-              downloadResults <- vapply(urls, function(url)
-                dlGeneric(url, destinationPath = .tempPath, verbose = verbose) |> unlist(),
-                FUN.VALUE = character(1))
-              downloadResults <- list(destFile = downloadResults)
+
+              checkSums <- runChecksums(destinationPath, checkSumFilePath = destinationPath, filenames, verbose)
+              checkSums <- checkSums$checkSums[expectedFile %in% filenames]
+              checkSums <- checkSums[data.table(expectedFile = basename2(filenames)), on = "expectedFile"]
+              missingNeededFiles <- missingFiles(filenames, checkSums, destinationPath)
+              stillNeed <- !checkSums$result %in% "OK"
+
+              downloadResults <- list(destFile = character())
+              if (missingNeededFiles) {
+                stillNeedFile <- match(basename2(urls), checkSums$expectedFile[stillNeed])
+                messagePrepInputs("url was supplied as a directory; downloading\n",
+                                         paste(urls[stillNeed], collapse = "\n"),
+                                  verbose = verbose)
+                downloadResults <- vapply(urls[stillNeedFile], function(url)
+                  dlGeneric(url, destinationPath = .tempPath, verbose = verbose) |> unlist(),
+                  FUN.VALUE = character(1))
+                # named list of local filenames; named with urls
+                downloadResults <- list(destFile = downloadResults)
+              }
+              if (any(!stillNeed)) {
+                filenamesAlreadyHave <- makeAbsolute(checkSums$expectedFile[stillNeed %in% FALSE], destinationPath)
+                alreadyHave <- match(checkSums$expectedFile[stillNeed %in% FALSE], basename2(urls))
+                names(filenamesAlreadyHave) <-  urls[alreadyHave]
+                # downloadResults$destFile <- c(downloadResults$destFile, filenamesAlreadyHave)
+              }
+
             } else {
               stop("url is a directory; need to install.packages(c('httr', 'curl'))")
             }
@@ -903,10 +932,14 @@ downloadRemote <- function(url, archive, targetFile, checkSums, dlFun = NULL,
   } else {
     messagePreProcess("No downloading; no url", verbose = verbose)
   }
+  # clean up from "directory" downloads
+  if (exists("filenamesAlreadyHave", inherits = FALSE)) {
+    downloadResults$destFile <- c(downloadResults$destFile, filenamesAlreadyHave)
+  }
   downloadResults
 }
 
-missingFiles <- function(files, checkSums, targetFile, destinationPath) {
+missingFiles <- function(files, checkSums, destinationPath) {
   filesBasename <- makeRelative(files, destinationPath)
   if (is.null(files)) {
     result <- unique(checkSums$result)
@@ -1173,3 +1206,19 @@ dlErrorHandling <- function(failed, downloadResults, warns, messOrig, numTries,
 .downloadErrorFn <- function(xxxx) {
   try(stop(xxxx))
 }
+
+
+runDlFun <- function(args, dlFun) {
+  argsOrig <- args
+  formsDlFun <- formalArgs(dlFun)
+  argsKeep <- intersect(formsDlFun, names(args))
+  args <- args[argsKeep]
+  for (iii in 1:2) {
+    out <- try(do.call(dlFun, args = args), silent = TRUE)
+    if (!is(out, "try-error")) {
+      break
+    }
+    args <- argsOrig
+  }
+  out
+}
diff --git a/R/preProcess.R b/R/preProcess.R
@@ -722,9 +722,11 @@ preProcess <- function(targetFile = NULL, url = NULL, archive = NULL, alsoExtrac
 
   failStop <- FALSE
   if (isTRUE(isDirectory(url, mustExist = FALSE))) {
-    messagePrepInputs("url pointed to a directory; using targetFilePath:\n",
-                      paste0(downloadFileResult$downloaded, collapse = "\n"))
-    targetFilePath <- downloadFileResult$downloaded
+    if (missing(targetFile)) {
+      messagePrepInputs("url pointed to a directory, but no `targetFile` specified; using targetFilePath:\n",
+                        paste0(downloadFileResult$downloaded, collapse = "\n"))
+      targetFilePath <- downloadFileResult$downloaded
+    }
   }
   if (is.null(targetFilePath)) {
     failStop <- TRUE

diff --git a/tests/testthat/test-preProcessDoesntWork.R b/tests/testthat/test-preProcessDoesntWork.R
@@ -76,7 +76,9 @@ test_that("preProcess fails if user provides non-existing file", {
   )
   expect_true(sum(grepl("Download failed", errMsg)) == 1)
 
+  url <- "https://github.com/tati-micheletti/host/raw/master/data/rasterTest"
   withr::local_options("reproducible.interactiveOnDownloadFail" = TRUE)
+  zipFilename <- tempfile2(fileext = ".zip")
   testthat::with_mocked_bindings(
     .downloadErrorFn = .downloadErrorFn,
     isInteractive = function() {
@@ -88,8 +90,7 @@ test_that("preProcess fails if user provides non-existing file", {
       origDir <- setwd(dirname(theFile))
       on.exit(setwd(origDir), add = TRUE)
       zip(zipfile = zipFilename, files = basename2(theFile), flags = "-q")
-      zipFilenameWithDotZip <- dir(tmpdir, pattern = "\\.zip", full.names = TRUE)
-      file.rename(from = zipFilenameWithDotZip, to = zipFilename)
+      file.copy(zipFilename, file.path(tmpdir, basename(url)))
       "y"
     },
     {
@@ -98,7 +99,8 @@ test_that("preProcess fails if user provides non-existing file", {
           mess <- testthat::capture_messages({
             errMsg <- testthat::capture_error({
               reproducible::preProcess(
-                url = "https://github.com/tati-micheletti/host/raw/master/data/rasterTest",
+                fun = NA,
+                url = url,
                 destinationPath = tmpdir
               )
             })
@@ -110,7 +112,7 @@ test_that("preProcess fails if user provides non-existing file", {
   )
   expect_true(sum(grepl("manual.+download", mess)) == 1) # manual download may be broken by \n
   expect_true(sum(grepl("To prevent", mess)) == 1)
-  expect_true(file.exists(filePathSansExt(zipFilename)))
+  expect_true(file.exists(zipFilename))
   cs <- read.table(file.path(tmpdir, "CHECKSUMS.txt"), header = TRUE)
   expect_true(NROW(cs) == 2 || NROW(cs) == 3) # TODO this may be detecting a bug == on GA it is 2, locally it is 3
   expect_true(all(grepl("rasterTest", cs$file)))

diff --git a/tests/testthat/test-prepInputs-large-files.R b/tests/testthat/test-prepInputs-large-files.R
@@ -30,7 +30,6 @@ test_that("prepInputs correctly unzips large files", {
   expect_true(file.info(fout)[["size"]] > 28 * 1024^3)
 })
 
-
 test_that("Issue 181 geodatabase file", {
   skip_on_cran()
   skip_on_ci()
@@ -55,8 +54,6 @@ test_that("Issue 181 geodatabase file", {
   expect_true(is(sf::st_read(rstLCC$targetFilePath, layer = "EOSD_Mosaic_BWC_range_clip", quiet = TRUE), "sf"))
 })
 
-
-
 test_that("Issue 242 masking fail", {
   skip_on_cran()
   skip_on_ci()