1# Decompress pkg, if needed 2source_pkg <- function(path, subdir = NULL) { 3 if (!dir.exists(path)) { 4 bundle <- path 5 outdir <- tempfile(pattern = "remotes") 6 dir.create(outdir) 7 8 path <- decompress(path, outdir) 9 } else { 10 bundle <- NULL 11 } 12 13 pkg_path <- if (is.null(subdir)) path else file.path(path, subdir) 14 15 # Check it's an R package 16 if (!file.exists(file.path(pkg_path, "DESCRIPTION"))) { 17 stop("Does not appear to be an R package (no DESCRIPTION)", call. = FALSE) 18 } 19 20 # Check configure is executable if present 21 config_path <- file.path(pkg_path, "configure") 22 if (file.exists(config_path)) { 23 Sys.chmod(config_path, "777") 24 } 25 26 pkg_path 27} 28 29 30decompress <- function(src, target) { 31 stopifnot(file.exists(src)) 32 33 if (grepl("\\.zip$", src)) { 34 my_unzip(src, target) 35 outdir <- getrootdir(as.vector(utils::unzip(src, list = TRUE)$Name)) 36 } else if (grepl("\\.(tar|tar\\.gz|tar\\.bz2|tgz|tbz)$", src)) { 37 untar(src, exdir = target) 38 outdir <- getrootdir(untar(src, list = TRUE)) 39 } else { 40 ext <- gsub("^[^.]*\\.", "", src) 41 stop("Don't know how to decompress files with extension ", ext, 42 call. = FALSE) 43 } 44 45 file.path(target, outdir) 46} 47 48 49# Returns everything before the last slash in a filename 50# getdir("path/to/file") returns "path/to" 51# getdir("path/to/dir/") returns "path/to/dir" 52getdir <- function(path) sub("/[^/]*$", "", path) 53 54# Given a list of files, returns the root (the topmost folder) 55# getrootdir(c("path/to/file", "path/to/other/thing")) returns "path/to" 56# It does not check that all paths have a common prefix. It fails for 57# empty input vector. It assumes that directories end with '/'. 58getrootdir <- function(file_list) { 59 stopifnot(length(file_list) > 0) 60 slashes <- nchar(gsub("[^/]", "", file_list)) 61 if (min(slashes) == 0) return(".") 62 63 getdir(file_list[which.min(slashes)]) 64} 65 66my_unzip <- function(src, target, unzip = getOption("unzip", "internal")) { 67 if (unzip %in% c("internal", "")) { 68 return(utils::unzip(src, exdir = target)) 69 } 70 71 args <- paste( 72 "-oq", shQuote(src), 73 "-d", shQuote(target) 74 ) 75 76 system_check(unzip, args) 77} 78