forked from Rdatatable/data.table
-
Notifications
You must be signed in to change notification settings - Fork 0
/
ci.R
184 lines (178 loc) · 9.2 KB
/
ci.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
## most of functions from R tools4pkgs branch
## https://github.com/wch/r-source/tree/tools4pkgs
## https://svn.r-project.org/R/branches/tools4pkgs/src/library/tools/R/packages.R
## added ver argument to produce R version independent urls
## https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=17420
contrib.url <-
function (repos, type = getOption("pkgType"), ver)
{
type <- utils:::resolvePkgType(type)
if (is.null(repos))
return(NULL)
if ("@CRAN@" %in% repos && interactive()) {
cat(gettext("--- Please select a CRAN mirror for use in this session ---"), "\n", sep = "")
flush.console()
chooseCRANmirror()
m <- match("@CRAN@", repos)
nm <- names(repos)
repos[m] <- getOption("repos")["CRAN"]
if (is.null(nm))
nm <- rep("", length(repos))
nm[m] <- "CRAN"
names(repos) <- nm
}
if ("@CRAN@" %in% repos)
stop("trying to use CRAN without setting a mirror")
if(missing(ver)) {
ver <- paste(R.version$major, strsplit(R.version$minor, ".", fixed=TRUE)[[1L]][1L], sep = ".")
} else {
stopifnot(is.character(ver), length(ver)>0L, !is.na(ver))
}
mac.path <- "macosx"
if (substr(type, 1L, 11L) == "mac.binary.") {
mac.path <- paste(mac.path, substring(type, 12L), sep = "/")
type <- "mac.binary"
}
res <- switch(
type,
source = paste(gsub("/$", "", repos), "src", "contrib", sep = "/"),
mac.binary = paste(gsub("/$", "", repos), "bin", mac.path, "contrib", ver, sep = "/"),
win.binary = paste(gsub("/$", "", repos), "bin", "windows", "contrib", ver, sep = "/")
)
res
}
## returns dependencies for a package based on its DESCRIPTION file
dcf.dependencies <-
function(file = "DESCRIPTION",
which = NA,
except.priority = "base") {
if (!is.character(file) || !length(file) || !all(file.exists(file)))
stop("file argument must be character of filepath(s) to existing DESCRIPTION file(s)")
if (!is.character(except.priority))
stop("except.priority should be character vector")
if (!(all(except.priority %in% c("base","recommended")) || identical(except.priority, character(0))))
stop("except.priority accept 'base', 'recommended', both or empty character vector")
which_all <- c("Depends", "Imports", "LinkingTo", "Suggests", "Enhances")
if (is.na(which))
which = c("Depends", "Imports", "LinkingTo")
else if (identical(which, "all"))
which <- which_all
else if (identical(which, "most"))
which <- c("Depends", "Imports", "LinkingTo", "Suggests")
if (!is.character(which) || !length(which) || !all(which %in% which_all))
stop("which argument accept only valid dependency relation: ", paste(which_all, collapse=", "))
x <- unlist(lapply(file, function(f, which) {
dcf <- tryCatch(read.dcf(f, fields = which), error = identity)
if (inherits(dcf, "error") || !length(dcf))
warning(gettextf("error reading file '%s'", f), domain = NA, call. = FALSE)
else dcf[!is.na(dcf)]
}, which = which), use.names = FALSE)
local.extract_dependency_package_names = function (x) {
## do not filter out R like tools:::.extract_dependency_package_names, used for web/$pkg/index.html
if (is.na(x))
return(character())
x <- unlist(strsplit(x, ",[[:space:]]*"))
x <- sub("[[:space:]]*([[:alnum:].]+).*", "\\1", x)
x[nzchar(x)]
}
x <- unlist(lapply(x, local.extract_dependency_package_names))
except <- if (length(except.priority)) c("R", unlist(tools:::.get_standard_package_names()[except.priority], use.names = FALSE))
setdiff(x, except)
}
## returns additional repositories for dependency packages based on its DESCRIPTION file
dcf.repos <-
function(file = "DESCRIPTION") {
if (!is.character(file) || !length(file) || !all(file.exists(file)))
stop("file argument must be character of filepath(s) to existing DESCRIPTION file(s)")
x <- unlist(lapply(file, function(f) {
dcf <- tryCatch(read.dcf(f, fields = "Additional_repositories"), error = identity)
if (inherits(dcf, "error") || !length(dcf))
warning(gettextf("error reading file '%s'", f), domain = NA, call. = FALSE)
else dcf[!is.na(dcf)]
}), use.names = FALSE)
x <- trimws(unlist(strsplit(trimws(x), ",", fixed = TRUE), use.names = FALSE))
unique(x)
}
## Mirror subset of CRAN
## download dependencies recursively for provided packages
## put all downloaded packages into local repository
mirror.packages <-
function(pkgs,
which = c("Depends", "Imports", "LinkingTo"),
repos = getOption("repos"),
type = c("source", "mac.binary", "win.binary"),
repodir,
except.repodir = repodir,
except.priority = "base",
method,
quiet = TRUE,
binary.ver,
...) {
if (!length(pkgs)) # edge case friendly
return(NULL)
if (!is.character(pkgs))
stop("pkgs argument must be character vector of packages to mirror from repository")
if (missing(repodir) || !is.character(repodir) || length(repodir)!=1L)
stop("repodir argument must be non-missing scalar character, local path to repo mirror")
if (!dir.exists(repodir) && !dir.create(repodir, recursive = TRUE, showWarnings = FALSE))
stop("Path provided in 'repodir' argument does not exists and could not be created")
if (missing(type) && .Platform$OS.type == "windows")
type <- "win.binary"
type <- match.arg(type)
if (!missing(binary.ver)) {
if (!is.character(binary.ver) || length(binary.ver)!=1L || is.na(binary.ver))
stop("binary.ver must be non-NA scalar character of type '3.5' so path to arbitrary binaries version can be resolved")
} else binary.ver <- paste(R.version$major, strsplit(R.version$minor, ".", fixed=TRUE)[[1L]][1L], sep = ".")
destdir <- contrib.url(repodir, type = type, ver = binary.ver)
if (!dir.exists(destdir) && !dir.create(destdir, recursive = TRUE, showWarnings = FALSE))
stop(sprintf("Your repo directory provided in 'repodir' exists, but does not have '%s' dir tree and it could not be created", destdir))
if (length(except.repodir) && (!is.character(except.repodir) || length(except.repodir)!=1L || !dir.exists(except.repodir)))
stop("except.repodir argument must be non-missing scalar character, local path to existing directory")
if (!is.character(except.priority) || !length(except.priority) || !all(except.priority %in% c("base","recommended")))
stop("except.priority accept 'base', 'recommended', both")
if (!is.logical(quiet) || length(quiet)!=1L || is.na(quiet))
stop("quiet argument must be TRUE or FALSE")
which_all <- c("Depends", "Imports", "LinkingTo", "Suggests", "Enhances")
if (identical(which, "all"))
which <- which_all
else if (identical(which, "most"))
which <- c("Depends", "Imports", "LinkingTo", "Suggests")
if (!is.character(which) || !length(which) || !all(which %in% which_all))
stop("which argument accept only valid dependency relations: ", paste(which_all, collapse=", "))
## possible interactive CRAN menu
repos.url <- contrib.url(repos, type = type, ver = binary.ver)
db <- utils::available.packages(repos.url, type = type)
allpkgs <- c(pkgs, unlist(tools::package_dependencies(unique(pkgs), db, which, recursive = TRUE), use.names = FALSE))
except <- c("R", unlist(tools:::.get_standard_package_names()[except.priority], use.names = FALSE))
## do not re-download existing packages, ignore version
if (length(except.repodir) && file.exists(file.path(contrib.url(except.repodir, type = type, ver = binary.ver), "PACKAGES"))) {
except.curl <- contrib.url(file.path("file:", normalizePath(except.repodir)), type = type, ver = binary.ver)
except <- c(except, rownames(utils::available.packages(except.curl, type = type, fields = "Package")))
}
newpkgs <- setdiff(allpkgs, except)
if (!all(availpkgs<-newpkgs %in% rownames(db))) {
## source packages are considered mandatory due to _R_CHECK_FORCE_SUGGESTS_=true policy
if (type=="source")
stop(sprintf("Packages sources could not be found in provided repositories: %s", paste(newpkgs[!availpkgs], collapse = ", ")))
warning(sprintf("Packages binaries could not be found in provided reposistories for R version %s: %s", binary.ver, paste(newpkgs[!availpkgs], collapse = ", ")))
newpkgs <- newpkgs[availpkgs]
}
pkgsext <- switch(type,
"source" = "tar.gz",
"mac.binary" = "tgz",
"win.binary" = "zip")
pkgsver <- db[db[, "Package"] %in% newpkgs, c("Package", "Version"), drop=FALSE]
dlfiles <- file.path(destdir, sprintf("%s_%s.%s", pkgsver[,"Package"], pkgsver[,"Version"], pkgsext))
unlink(dlfiles[file.exists(dlfiles)])
## repos argument is not used in download.packages, only as default for contriburl argument
## we provide contriburl to avoid interactive CRAN menu popup twice in mirror.packages
dp <- utils::download.packages(pkgs = newpkgs, destdir = destdir,
available = db, contriburl = repos.url,
type = type, method = method, quiet = quiet)
tools::write_PACKAGES(dir = destdir, type = type, ...)
dp
}
## set repositories for CI tests
if (as.logical(Sys.getenv("GITLAB_CI","false"))) {
options("repos" = if (.Platform$OS.type == "windows") file.path("file://",getwd(),"bus/mirror-packages/cran") else file.path("file:", normalizePath("bus/mirror-packages/cran", mustWork=FALSE)))
}