src/library/utils/R/zip.R

#  File src/library/utils/R/zip.R
#  Part of the R package, https://www.R-project.org
#
#  Copyright (C) 1995-2019 The R Core Team
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  A copy of the GNU General Public License is available at
#  https://www.R-project.org/Licenses/

unzip <-
    function(zipfile, files = NULL, list = FALSE, overwrite = TRUE,
             junkpaths = FALSE, exdir = ".", unzip = "internal",
             setTimes = FALSE)
{
    if(identical(unzip, "internal")) {
        if(!list && !missing(exdir))
            dir.create(exdir, showWarnings = FALSE, recursive = TRUE)
        res <- .External(C_unzip, zipfile, files, exdir, list, overwrite,
                         junkpaths, setTimes)
        if(list) {
            dates <- as.POSIXct(res[[3]], "%Y-%m-%d %H:%M",  tz="UTC")
            data.frame(Name = res[[1]], Length = res[[2]], Date = dates,
                       stringsAsFactors = FALSE)
        } else invisible(attr(res, "extracted"))
    } else {
        WINDOWS <- .Platform$OS.type == "windows"
        if(!is.character(unzip) || length(unzip) != 1L || !nzchar(unzip))
            stop("'unzip' must be a single character string")
        zipfile <- path.expand(zipfile)
        if (list) {
            ## -q to suppress per-file and per-archive comments (since 5.52)
            ## it also suppresses the first line "Archive: filename"
            res <- if (WINDOWS)
                    system2(unzip, c("-ql", shQuote(zipfile)), stdout = TRUE)
                else
                    system2(unzip, c("-ql", shQuote(zipfile)), stdout = TRUE,
                            env = c("TZ=UTC"))
            l <- length(res)
            res2 <- res[-c(2, l-1, l)]

            ## this allows space in file name, but it would break with
            ## double quotes (though those are discouraged both by Windows
            ## documentation and POSIX)
            res3 <- gsub(" *([^ ]+) +([^ ]+) +([^ ]+) +(.*)",
                         "\\1 \\2 \\3 \"\\4\"", res2)
            con <- textConnection(res3); on.exit(close(con))
            z <- read.table(con, header=TRUE, as.is=TRUE)
            dt <- paste(z$Date, z$Time)
            ## Unzip 6.00 always uses 4-digits years, but any order is
            ## possible and the separator could be - or / (depending
            ## on the locale on Windows).
            ## Unzip 5.52 uses 2-digit years, but default to "%m-%d-%y" on
            ## most platforms (but is locale-dependent on Windows).
            formats <-
                if (max(nchar(z$Date) > 8))
                    c("%Y-%m-%d", "%d-%m-%Y", "%m-%d-%Y") else
                    ## At this point we are guessing: there is no way
                    ## to know what "08-09-10" means.  Take the most common
                    ## default first.
                    c("%m-%d-%y", "%d-%m-%y", "%y-%m-%d")
            slash <- any(grepl("/", z$Date))
            if (slash) formats <- gsub("-", "/", formats)
            formats <- paste(formats, "%H:%M")
            for (f in formats) {
                zz <- as.POSIXct(dt, tz="UTC", format = f)
                if (all(!is.na(zz))) break
            }
            z[, "Date"] <- zz
            z[c("Name", "Length", "Date")]
        } else {
            ## -n -o -q -j are supported in Unzip 5.52 and 6.00
            args <- character()
            if (junkpaths) args <- c(args, "-j")
            if (overwrite)
                args <- c(args, "-oq", shQuote(zipfile))
            else
                args <- c(args, "-nq", shQuote(zipfile))
            if (length(files)) args <- c(args, shQuote(files))
            if (exdir != ".") args <- c(args, "-d", shQuote(exdir))
            ## there is an unzip clone about that does not respect -q
            if (WINDOWS)
                system2(unzip, args, stdout = NULL, stderr = NULL,
                        invisible = TRUE)
            else
                system2(unzip, args, stdout = NULL, stderr = NULL)
            invisible(NULL)
        }
    }
}

zip <- function(zipfile, files, flags = "-r9X", extras = "",
                zip = Sys.getenv("R_ZIPCMD", "zip"))
{
    if (missing(flags) && (!is.character(files) || !length(files)))
        stop("'files' must a character vector specifying one or more filepaths")
    args <- c(flags, shQuote(path.expand(zipfile)),
              shQuote(files), extras)
    if (sum(nchar(c(args, Sys.getenv()))) + length(args) > 8000) {
        # -@ is supported in Info-ZIP from version 2.3 (like -X), but not in
        # old Mac OS builds (MACOS macro), so better not rely on it for
        # common use
        #
        # 8191 is the maximum command line length on Windows (since 2000/NT)
        # and 8096 is the internal buffer size used by system() on systems
        # without readline
        args <- c(flags, "-@", shQuote(path.expand(zipfile)), extras)
        input <- files
    } else input <- NULL

    if (.Platform$OS.type == "windows")
        invisible(system2(zip, args, input = input, invisible = TRUE))
    else invisible(system2(zip, args, input = input))
}