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