Vectorize unzip() over multiple threads

R/threaded.R

@@ -0,0 +1,81 @@
+threaded_unzip <- function(
+  zipfiles,
+  exdirs = ".",
+  num_threads = NULL,
+  passwords = NULL
+) {
+  passwords <- passwords %||% ""
+  stopifnot(
+    length(exdirs) == 1L || length(exdirs) == length(zipfiles),
+    length(passwords) == 1L || length(passwords) == length(zipfiles)
+  )
+  if (length(exdirs) == 1L) {
+    exdirs <- rep_len(exdirs, length(zipfiles))
+  }
+  if (length(passwords) == 1L) {
+    passwords <- rep_len(passwords, length(zipfiles))
+  }
+  num_threads <- num_threads %||% get_num_threads()
+  ret <- .Call(
+    c_R_threaded_unzip,
+    as.character(zipfiles),
+    as.character(exdirs),
+    as.integer(num_threads),
+    as.character(passwords)
+  )
+  failed <- ret[[1]] != 0L
+  if (any(failed)) {
+    msgs <- paste0(
+      "  ",
+      zipfiles[failed],
+      ": ",
+      ret[[2]][failed],
+      collapse = "\n"
+    )
+    stop(
+      "Failed to unzip ",
+      sum(failed),
+      " file",
+      if (sum(failed) > 1) "s" else "",
+      ":\n",
+      msgs,
+      call. = FALSE
+    )
+  }
+  results <- Map(
+    function(zf, ed) {
+      lst <- zip_list(zf)
+      lst$path <- file.path(normalizePath(ed), lst$filename)
+      lst$encryption <- NULL
+      lst
+    },
+    zipfiles,
+    exdirs
+  )
+  invisible(do.call(rbind, results))
+}
+
+get_num_threads <- function() {
+  opt <- getOption("zip_threads")
+  if (!is.null(opt)) {
+    if (!is.numeric(opt) || length(opt) != 1L || opt < 1L) {
+      stop(
+        "Invalid value for 'zip_threads' option, must be a positive integer."
+      )
+    }
+    return(as.integer(opt))
+  }
+  ev <- Sys.getenv("ZIP_THREADS", NA_character_)
+  if (!is.na(ev)) {
+    evval <- suppressWarnings(as.integer(ev))
+    if (is.na(evval) || evval < 1L) {
+      stop(
+        "Invalid value for ZIP_THREADS environment variable, ",
+        "must be a positive integer."
+      )
+    }
+    return(evval)
+  }
+
+  2L
+}

R/zip.R

@@ -443,7 +443,9 @@ encryption_types <- c(
 #' If the zip archive stores permissions and was created on Unix,
 #' the permissions will be restored.
 #'
-#' @param zipfile Path to the zip file to uncompress.
+#' @param zipfile Path to the zip file to uncompress, or a character vector of
+#'   paths. When multiple paths are given and all other arguments are at their
+#'   defaults, the files are unzipped concurrently in a thread pool.
 #' @param files Character vector of files to extract from the archive.
 #'   Files within directories can be specified, but they must use a forward
 #'   slash as path separator, as this is what zip files use internally.
@@ -495,17 +497,49 @@ unzip <- function(
   encoding = NULL,
   password = NULL
 ) {
-  if (startsWith(zipfile, "http://") || startsWith(zipfile, "https://")) {
+  if (
+    length(zipfile) == 1 &&
+      (startsWith(zipfile, "http://") || startsWith(zipfile, "https://"))
+  ) {
     return(unzip_url(zipfile, files, overwrite, junkpaths, exdir, encoding))
   }
   stopifnot(
-    is_string(zipfile),
+    is_character(zipfile),
+    length(zipfile) >= 1,
     is_character_or_null(files),
     is_flag(overwrite),
     is_flag(junkpaths),
     is_string(exdir)
   )
 
+  if (
+    length(zipfile) > 1 &&
+      is.null(files) &&
+      isTRUE(overwrite) &&
+      !isTRUE(junkpaths) &&
+      is.null(encoding) &&
+      !any(startsWith(zipfile, "http://") | startsWith(zipfile, "https://"))
+  ) {
+    pw <- resolve_password(password)
+    passwords <- if (!is.null(pw)) rawToChar(pw) else NULL
+    return(threaded_unzip(zipfile, exdirs = exdir, passwords = passwords))
+  }
+
+  if (length(zipfile) > 1) {
+    results <- lapply(zipfile, function(zf) {
+      unzip(
+        zf,
+        files = files,
+        overwrite = overwrite,
+        junkpaths = junkpaths,
+        exdir = exdir,
+        encoding = encoding,
+        password = password
+      )
+    })
+    return(invisible(do.call(rbind, results)))
+  }
+
   zipfile <- enc2c(normalizePath(zipfile))
   if (!is.null(files)) {
     files <- enc2c(files)

README.Rmd

@@ -130,6 +130,8 @@ variable to `TRUE`.
   Can be set to a string, a raw vector, or a function returning one.
 * `zip_progress`: If set to `TRUE`, progress bars are enabled. Takes
   precedence over the `ZIP_PROGRESS` environment variable.
+* `zip_threads`: The number of threads to use for threaded operations.
+  Takes precedence over the `ZIP_THREADS` environment variable.
 
 #### Environment variables
 
@@ -139,6 +141,8 @@ variable to `TRUE`.
   `cmdunzip.exe` is blocked by system policies on Windows.
 * `ZIP_PROGRESS`: If set to `TRUE`, progress bars are enabled. The
   `zip_progress` option takes precedence over this environment variable.
+* `ZIP_THREADS`: The number of threads to use for threaded operations. The
+  `zip_threads` option takes precedence over this environment variable.
 
 ## License
 

README.md

@@ -148,6 +148,8 @@ environment variable to `TRUE`.
   returning one.
 - `zip_progress`: If set to `TRUE`, progress bars are enabled. Takes
   precedence over the `ZIP_PROGRESS` environment variable.
+- `zip_threads`: The number of threads to use for threaded operations.
+  Takes precedence over the `ZIP_THREADS` environment variable.
 
 #### Environment variables
 
@@ -157,6 +159,9 @@ environment variable to `TRUE`.
   when `cmdunzip.exe` is blocked by system policies on Windows.
 - `ZIP_PROGRESS`: If set to `TRUE`, progress bars are enabled. The
   `zip_progress` option takes precedence over this environment variable.
+- `ZIP_THREADS`: The number of threads to use for threaded operations.
+  The `zip_threads` option takes precedence over this environment
+  variable.
 
 ## License
 

src/Makevars

@@ -10,8 +10,10 @@ MBEDTLS_OBJ = $(MBEDTLS_SRC:.c=.o)
 
 PKG_CPPFLAGS = $(MBEDTLS_CPPFLAGS)
 PKG_CFLAGS = $(C_VISIBILITY)
+PKG_LIBS = -lpthread
 
-OBJECTS = init.o miniz.o rzip.o zip.o crypto.o unixutils.o errors.o cleancall.o $(MBEDTLS_OBJ)
+OBJECTS = init.o miniz.o rzip.o zip.o crypto.o unixutils.o errors.o \
+		  cleancall.o cmdunzip_lib.o $(MBEDTLS_OBJ)
 
 .PHONY: all clean
 

src/Makevars.win

@@ -12,7 +12,7 @@ PKG_CPPFLAGS = $(MBEDTLS_CPPFLAGS)
 # -lbcrypt: BCryptGenRandom(), used for WinZip AES salts (see crypto.c).
 PKG_LIBS = -lbcrypt
 
-OBJECTS = init.o miniz.o rzip.o zip.o crypto.o winutils.o errors.o cleancall.o $(MBEDTLS_OBJ)
+OBJECTS = init.o miniz.o rzip.o zip.o crypto.o winutils.o errors.o cleancall.o cmdunzip_lib.o $(MBEDTLS_OBJ)
 
 .PHONY: all clean