Allow manual specification of the ZIP file structure

.gitignore

@@ -3,6 +3,7 @@
 .RData
 /src/*.o
 /src/zip.so
+/src/zip.dll
 /revdep
 /README.html
 /sources.zip
@@ -15,3 +16,4 @@
 /r-packages
 /src/tools/zip.exe
 /src/zip.dll
+zip.Rproj

NEWS.md

@@ -1,6 +1,11 @@
 
 # development version
 
+* `zipr()` and `zipr_append()` now support custom filenames in zip files.
+  Use the new argument `keys` to specify the paths within the zip file (#50).
+* `unzip_process()` now works when R library is on different drive than `exdir`
+  on Windows (#45)
+
 # 2.0.4
 
 * `unzip_process()` prints better error messages to the standard error,

R/process.R

@@ -171,8 +171,8 @@ zip_process <- function() {
 }
 
 write_zip_params <- function(files, recurse, include_directories, outfile) {
-  data <- get_zip_data(files, recurse, keep_path = FALSE,
-                       include_directories = include_directories)
+  data <- get_zip_data(files, basename(normalizePath(files)),
+                       recurse, include_directories = include_directories)
   mtime <- as.double(file.info(data$file)$mtime)
 
   con <- file(outfile, open = "wb")

R/utils.R

@@ -1,35 +1,77 @@
 
 `%||%` <- function(l, r) if (is.null(l)) r else l
 
-get_zip_data <- function(files, recurse, keep_path, include_directories) {
-  list <- if (keep_path) {
-    get_zip_data_path(files, recurse)
-  } else {
-    get_zip_data_nopath(files, recurse)
-  }
+get_zip_data <- function(files, keys, recurse, include_directories) {
+  files <- normalizePath(files)
+  is_dir <- file.info(files)$isdir
 
-  if (!include_directories) {
-    list <- list[! list$dir, ]
+  if (!recurse && any(is_dir)) {
+    warning("directories ignored in zip file, specify recurse = TRUE")
+    files <- files[!is_dir]
+    keys <- keys[!is_dir]
+    is_dir <- is_dir[!is_dir]
   }
 
-  list
-}
+  if (!length(files)) {
+    return(data.frame(
+      stringsAsFactors = FALSE,
+      key = character(),
+      files = character(),
+      dir = logical()
+    ))
+  }
 
-get_zip_data_path <- function(files, recurse) {
-    if (recurse && length(files)) {
-    data <- do.call(rbind, lapply(files, get_zip_data_path_recursive))
-    dup <- duplicated(data$files)
-    if (any(dup)) data <- data <- data[ !dup, drop = FALSE ]
-    data
+  zip_data <- do.call(rbind, mapply(
+    function(key, file, is_dir) {
+      if (is_dir) {
+        files <- c(
+          "", # Entry for the parent dir
+          list.files( # Entries for all children (dirs and files)
+            path = file,
+            recursive = TRUE,
+            include.dirs = TRUE,
+            all.files = TRUE,
+            no.. = TRUE
+          )
+        )
+
+        keys <- file.path(key, files)
+        files <- file.path(file, files)
+        dirs <- file.info(files)$isdir
+        keys[dirs & !grepl("/$", keys)] <- paste0(
+          keys[dirs & !grepl("/$", keys)], "/"
+        )
+
+        data.frame(
+          stringsAsFactors = FALSE,
+          key = keys,
+          files = files,
+          dir = dirs
+        )
+      } else {
+        data.frame(
+          stringsAsFactors = FALSE,
+          key = key,
+          files = file,
+          dir = FALSE
+        )
+      }
+    },
+    key = keys,
+    file = files,
+    is_dir = is_dir,
+    SIMPLIFY = FALSE
+  ))
+
+  zip_data <- zip_data[!duplicated(zip_data$key) & zip_data$key != "/", ]
+
+  row.names(zip_data) <- NULL
+  zip_data$files <- normalizePath(zip_data$files)
 
+  if (!include_directories) {
+    zip_data[!zip_data$dir, ]
   } else {
-    files <- ignore_dirs_with_warning(files)
-    data.frame(
-      stringsAsFactors = FALSE,
-      key = files,
-      files = files,
-      dir = rep(FALSE, length(files))
-    )
+    zip_data
   }
 }
 
@@ -44,82 +86,6 @@ warn_for_dotdot <- function(files) {
   files
 }
 
-get_zip_data_nopath <- function(files, recurse) {
-  if (recurse && length(files)) {
-    data <- do.call(rbind, lapply(files, get_zip_data_nopath_recursive))
-    dup <- duplicated(data$files)
-    if (any(dup)) data <- data[ !dup, drop = FALSE ]
-    data
-
-  } else {
-    files <- ignore_dirs_with_warning(files)
-    data.frame(
-      stringsAsFactors = FALSE,
-      key = basename(files),
-      file = files,
-      dir = rep(FALSE, length(files))
-    )
-  }
-}
-
-ignore_dirs_with_warning <- function(files) {
-  info <- file.info(files)
-  if (any(info$isdir)) {
-    warning("directories ignored in zip file, specify recurse = TRUE")
-    files <- files[!info$isdir]
-  }
-  files
-}
-
-get_zip_data_path_recursive <- function(x) {
-  if (file.info(x)$isdir) {
-    files <- c(x, dir(x, recursive = TRUE, full.names = TRUE,
-                      all.files = TRUE, include.dirs = TRUE, no.. = TRUE))
-    dir <- file.info(files)$isdir
-    data.frame(
-      stringsAsFactors = FALSE,
-      key = ifelse(dir, paste0(files, "/"), files),
-      file = normalizePath(files),
-      dir = dir
-    )
-  } else {
-    data.frame(
-      stringsAsFactors = FALSE,
-      key = x,
-      file = normalizePath(x),
-      dir = FALSE
-    )
-  }
-}
-
-get_zip_data_nopath_recursive <- function(x) {
-  x <- normalizePath(x)
-  wd <- getwd()
-  on.exit(setwd(wd))
-  setwd(dirname(x))
-  bnx <- basename(x)
-
-  files <- dir(
-    bnx,
-    recursive = TRUE,
-    all.files = TRUE,
-    include.dirs = TRUE,
-    no.. = TRUE
-  )
-
-  key <- c(bnx, file.path(bnx, files))
-  files <- c(x, file.path(dirname(x), bnx, files))
-  dir <- file.info(files)$isdir
-  key <- ifelse(dir, paste0(key, "/"), key)
-
-  data.frame(
-    stringsAsFactors = FALSE,
-    key = key,
-    file = normalizePath(files),
-    dir = dir
-  )
-}
-
 mkdirp <- function(x, ...) {
   dir.create(x, showWarnings = FALSE, recursive = TRUE, ...)
 }

R/zip.R

@@ -75,6 +75,26 @@ NULL
 #' #> foo2/file3
 #' ```
 #'
+#' @section Custom file structure:
+#'
+#' Both `zipr` and `zip` allow manual specification of the file structure using
+#' the argument `keys`.
+#'
+#' Assuming files `bar/file1_2`, `dir1/file1_2`, `dir1/file2_2"` and `foo2` to
+#' exist in the current working directory, the names can be used to produce a
+#' custom file structure as follows:
+#'
+#' ```
+#' zipr("x.zip", c("bar/file1_2", "dir1_2", "foo2"),
+#'      keys = c("file1", "dir1", "foo2"))
+#' zip_list("x.zip")$filename
+#' #> file1
+#' #> dir1
+#' #> dir1/file1_2
+#' #> dir1/file2_2
+#' #> foo2
+#' ```
+#'
 #' @param zipfile The zip file to create. If the file exists, `zip`
 #'   overwrites it, but `zip_append` appends to it.
 #' @param files List of file to add to the archive. See details below
@@ -89,6 +109,7 @@ NULL
 #'   archive. See "Relative Paths" below for details. (`zip` and
 #'   `zip_append` default to `TRUE`, `zipr` and `zipr_append` default
 #'   to FALSE.)
+#' @param keys Custom file names to set in the zip archive.
 #' @return The name of the created zip file, invisibly.
 #'
 #' @export
@@ -110,44 +131,46 @@ NULL
 #' zip_list(zipfile)
 
 zip <- function(zipfile, files, recurse = TRUE, compression_level = 9,
-                include_directories = TRUE) {
-  zip_internal(zipfile, files, recurse, compression_level, append = FALSE,
-               keep_path = TRUE, include_directories = include_directories)
+                include_directories = TRUE, keys = files) {
+  zip_internal(zipfile, files, keys, recurse, compression_level,
+               append = FALSE, include_directories = include_directories)
 }
 
 #' @rdname zip
 #' @export
-
-zipr <- function(zipfile, files, recurse = TRUE, compression_level = 9,
-                 include_directories = TRUE) {
-  zip_internal(zipfile, files, recurse, compression_level, append = FALSE,
-               keep_path = FALSE, include_directories = include_directories)
+zipr <- function(zipfile, files, recurse = TRUE,
+                 compression_level = 9, include_directories = TRUE,
+                 keys = basename(normalizePath(files))) {
+  zip_internal(zipfile, files, keys, recurse, compression_level,
+               append = FALSE, include_directories = include_directories)
 }
 
 #' @rdname zip
 #' @export
 
 zip_append <- function(zipfile, files, recurse = TRUE,
-                       compression_level = 9, include_directories = TRUE) {
-  zip_internal(zipfile, files, recurse, compression_level, append = TRUE,
-               keep_path = TRUE, include_directories = include_directories)
+                       compression_level = 9, include_directories = TRUE,
+                       keys = files) {
+  zip_internal(zipfile, files, keys, recurse, compression_level,
+               append = TRUE, include_directories = include_directories)
 }
 
 #' @rdname zip
 #' @export
 
 zipr_append <- function(zipfile, files, recurse = TRUE,
-                        compression_level = 9, include_directories = TRUE) {
-  zip_internal(zipfile, files, recurse, compression_level, append = TRUE,
-               keep_path = FALSE, include_directories = include_directories)
+                        compression_level = 9, include_directories = TRUE,
+                        keys = basename(normalizePath(files))) {
+  zip_internal(zipfile, files, keys, recurse, compression_level,
+               append = TRUE, include_directories = include_directories)
 }
 
-zip_internal <- function(zipfile, files, recurse, compression_level,
-                         append, keep_path, include_directories) {
+zip_internal <- function(zipfile, files, keys, recurse, compression_level,
+                         append, include_directories) {
 
   if (any(! file.exists(files))) stop("Some files do not exist")
 
-  data <- get_zip_data(files, recurse, keep_path, include_directories)
+  data <- get_zip_data(files, keys, recurse, include_directories)
   warn_for_dotdot(data$key)
 
   .Call(c_R_zip_zip, zipfile, data$key, data$file, data$dir,