-
Notifications
You must be signed in to change notification settings - Fork 105
/
insertPackage.R
369 lines (339 loc) · 15.2 KB
/
insertPackage.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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
##' R can use multiple archives: CRAN, BioConductor and Omegahat have
##' been supported for years. It is equally easy to add local
##' archives from the same machine, or local network, or university /
##' company network as well as other publically available
##' repositories. This function aids in the process, and defaults to
##' inserting a given source archive into a given repository.
##'
##' This function inserts the given (source or binary) package file
##' into the given (local) package repository and updates the
##' index. By setting the \code{commit} option to \code{TRUE}, one can
##' then push to a remote git code repository. If the
##' \code{\link[git2r]{git2r}} package is installed, it is used for
##' the interaction with the git repository; otherwise the \code{git}
##' shell command is used.
##'
##' An aliased function \code{insert} is also available, but not
##' exported via \code{NAMESPACE} to not clobber a possibly unrelated
##' function; use it via \code{drat:::insert()}.
##'
##' The function also checks for a top-level \code{index.html} file to ensure
##' external tests against the repository (as for example done by CRAN if you
##' list the repository as an \sQuote{Additional_repositories} in a package)
##' do not return a \sQuote{404} error. If missing, a simple one-line example is
##' shown.
##'
##' @section Options:
##'
##' Set using \code{\link{options}}
##'
##' \describe{
##' \item{\code{dratRepo}}{Path to git repo. Defaults to \code{~/git/drat}}
##' \item{\code{dratBranch}}{The git branch to store packages on. Defaults to \code{gh-pages}}
##' }
##'
##' @title Insert a package source or binary file into a drat repository
##' @aliases drat:::insert
##' @param file One or more R package(s) in source or binary format
##' @param repodir A local directory corresponding to the repository
##' top-level directory.
##' @param commit Either boolean toggle to select automatic git operations
##' \sQuote{add}, \sQuote{commit}, and \sQuote{push} or, alternatively,
##' a character variable can be used to specify a commit message; this also
##' implies the \sQuote{TRUE} values in other contexts.
##' @param pullfirst Boolean toggle to call \code{git pull} before inserting the package.
##' @param action A character string containing one of: \dQuote{none}
##' (the default; add the new package into the repo, effectively masking
##' previous versions), \dQuote{archive} (place any previous versions into
##' a package-specific archive folder, creating such an archive if it does
##' not already exist), or \dQuote{prune} (calling \code{\link{pruneRepo}}).
##' @param ... For \code{insert} the aliases variant, a catch-all collection of
##' parameters. For \code{insertPackage} arguments passed to
##' \code{write_PACKAGES} currently include \code{latestOnly}, for which the
##' default value is set here to \code{FALSE}. See \code{\link{write_PACKAGES}}.
##' @param location A character variable with the GitHub Pages location:
##' either \dQuote{gh-pages} indicating a branch of that name, or
##' \dQuote{docs/} directory in the main branch. The default value can
##' be overridden via the \dQuote{dratBranch} option.
##' @param OSflavour an optional string naming the OSflavour, which is otherwise read as
##' the second element of the 'Built' field of the \code{file}. For packages that do not
##' need compilation on macOS for R >= 4.3 the 'Built' field is empty in the DESCRIPTION
##' in a binary file (tgz), in which case it can be useful to set the \code{OSflavour}
##' e.g. by the value of R.Version()$platform, so that \code{\link{insertPackages}} inserts
##' the binary into the appropriate sub folder (under bin/maxosx).
##' @return NULL is returned.
##' @examples
##' \dontrun{
##' insertPackage("foo_0.2.3.tar.gz") # inserts into (default) repo
##' insertPackage("foo_0.2.3.tar.gz", "/nas/R/") # ... into local dir
##' }
##' \dontrun{
##' insertPackage("foo_0.2.3.tar.gz", action = "prune") # prunes any older copies
##' insertPackage("foo_0.2.3.tar.gz", action = "archive") # archives any older copies
##' }
##' @author Dirk Eddelbuettel
insertPackage <- function(file,
repodir = getOption("dratRepo", "~/git/drat"),
commit = FALSE,
pullfirst = FALSE,
action = c("none", "archive", "prune"),
location = getOption("dratBranch", "gh-pages"),
OSflavour = character(),
...) {
if (!file.exists(file)) stop("File ", file, " not found\n", call. = FALSE)
## TODO src/contrib if needed, preferably via git2r
if (!dir.exists(repodir)) stop("Directory ", repodir, " not found\n", call. = FALSE)
.check_location_arg(location)
## check for the optional git2r package
haspkg <- requireNamespace("git2r", quietly = TRUE)
hascmd <- length(Sys.which("git")) > 0
curwd <- getwd()
on.exit(setwd(curwd)) # restore current working directory
pkg <- basename(file)
msg <- if (isTRUE(commit)) sprintf("Adding %s to drat", pkg) else ""
## special case of commit via message: not TRUE, and character
if (!isTRUE(commit) && typeof(commit) == "character" && nchar(commit) > 0) {
msg <- commit
commit <- TRUE
}
branch <- location
if (commit && haspkg) {
repo <- git2r::repository(repodir)
if (isTRUE(pullfirst)) git2r::pull(repo)
if (branch == "gh-pages") {
git2r::checkout(repo, branch)
}
} else if (commit && hascmd) {
setwd(repodir)
if (isTRUE(pullfirst)) system("git pull")
if (branch == "gh-pages") {
system2("git", c("checkout", branch))
}
setwd(curwd)
}
if (location == "docs") repodir <- file.path(repodir, location)
if (!file.exists(file.path(repodir, "index.html"))) {
message("The repository '", repodir, "' does not have a top-level 'index.html' file. ",
"Consider adding a simple file\nto avoid 404 results on the repo. A one-line ",
"example is '<!doctype html><title>empty</title>'.")
}
pkginfo <- getPackageInfo(file, OSflavour = OSflavour)
pkgtype <- identifyPackageType(file, pkginfo)
pkgdir <- normalizePath(contrib.url2(repodir, pkgtype, pkginfo["Rmajor"]),
mustWork = FALSE)
if (!file.exists(pkgdir)) {
## TODO: this could be in a git branch, need checking
if (!dir.create(pkgdir, recursive = TRUE)) {
stop("Directory ", pkgdir, " couldn't be created\n", call. = FALSE)
}
}
## copy file into repo
if (!file.copy(file, pkgdir, overwrite = TRUE)) {
stop("File ", file, " can not be copied to ", pkgdir, call. = FALSE)
}
## update index
args <- .norm_tools_package_args(...)
do.call(tools::write_PACKAGES,
c(list(dir = pkgdir, type = .get_write_PACKAGES_type(pkgtype)), args))
if (commit) {
if (haspkg) {
repo <- git2r::repository(repodir)
setwd(pkgdir)
git2r::add(repo, pkg)
git2r::add(repo, "PACKAGES")
git2r::add(repo, "PACKAGES.gz")
git2r::add(repo, "PACKAGES.rds")
tryCatch(git2r::commit(repo, msg), error = function(e) warning(e))
#TODO: authentication woes? git2r::push(repo)
message("Added and committed ", pkg, " plus PACKAGES files. Still need to push.\n")
} else if (hascmd) {
setwd(pkgdir)
pkgfs <- "PACKAGES PACKAGES.gz PACKAGES.rds"
cmd <- sprintf(paste("git add %s %s;",
"git commit -m\"%s\";",
"git push"), pkg, pkgfs, msg)
system(cmd) ## TODO: error checking
message("Added, committed and pushed ", pkg, " plus PACKAGES files.\n")
} else {
warning("Commit skipped as both git2r package and git command missing.",
call. = FALSE)
}
}
action <- match.arg(action)
pkgname <- gsub("\\.tar\\..*$", "", pkg)
pkgname <- strsplit(pkgname, "_", fixed = TRUE)[[1L]][1L]
if (action == "prune") {
pruneRepo(repopath = repodir,
type = pkgtype,
pkg = pkgname,
version = pkginfo["Rmajor"],
remove = TRUE)
} else if (action == "archive") {
archivePackages(repopath = repodir,
type = pkgtype,
pkg = pkgname,
version = pkginfo["Rmajor"])
}
invisible(NULL)
}
.norm_tools_package_args <- function(...){
args <- list(...)
if(is.null(args[["latestOnly"]])){
args[["latestOnly"]] <- FALSE
}
args
}
.get_write_PACKAGES_type <- function(pkgtype){
split_pkgtype <- strsplit(pkgtype,"\\.")[[1L]]
write_pkgtype <- paste(split_pkgtype[seq.int(1L,min(2L,length(split_pkgtype)))],
collapse = ".")
# write_pkgtype can only be "source", "mac.binary", or "win.binary"
# pkgtype could be "binary" in ARM Mac
if( write_pkgtype == "binary" && grepl("darwin", R.version$os) ){
write_pkgtype <- "mac.binary"
}
write_pkgtype
}
##' @rdname insertPackage
insertPackages <- function(file, ...){
invisible(lapply(file, insertPackage, ...))
}
##' @rdname insertPackage
insert <- function(...) {
args <- list(...)
if(length(args[["file"]]) > 1L){
insertPackages(...)
} else {
insertPackage(...)
}
}
##' This function identifies the package type from a filename.
##'
##' The returned string is suitable for \code{write_PACKAGES()}.
##' @title Identifies the package type from a filename
##' @param file An R package in source or binary format,
##' @param pkginfo information on the R package referenced by \code{file}
##' @section Note:
##' This is an internal function, use \code{:::} to access it from outside
##' the internal package code.
##' @return string Type of the supplied package.
##' @author Jan Schulz and Dirk Eddelbuettel
identifyPackageType <- function(file, pkginfo = getPackageInfo(file)) {
##from src/library/tools/R/packages.R
ret <- if (grepl("_.*\\.tar\\..*$", file)) {
"source"
} else if (grepl("_.*\\.tgz$", file)) {
"mac.binary"
} else if (grepl("_.*\\.zip$", file)) {
"win.binary"
} else {
stop("Unknown package type", call. = FALSE)
}
if(ret == "mac.binary"){
if(pkginfo["osxFolder"] == ""){
if(package_version(pkginfo["Rmajor"]) < package_version("4.1")){
ret <- switch(pkginfo["Rmajor"],
"3.2" = paste0(ret,".mavericks"),
"3.3" = paste0(ret,".mavericks"),
"3.4" = paste0(ret,".el-capitan"),
"3.5" = paste0(ret,".el-capitan"),
"3.6" = paste0(ret,".el-capitan"),
ret)
} else if (grepl("aarch64", pkginfo["OSflavour"])) {
# ARM Mac for R >= 4.1
ret <- "binary"
}
} else if(pkginfo["osxFolder"] %in% c("mavericks","el-capitan","big-sur-x86_64","big-sur-arm64")) {
ret <- paste0(ret,".",pkginfo["osxFolder"])
} else {
stop("mac.binary subtype couldn't be determined. This shouldn't ",
"happen. Please report it with a reproducable example and ",
"provide the binary, if you can. Thanks.")
}
}
return(ret)
}
##' This function returns the compile-time information added
##' to the \code{DESCRIPTION} file in the package.
##'
##' @title Get information from a binary package
##' @param file the fully qualified path of the package
##' @param OSflavour an optional string naming the OSflavour, which is otherwise read as
##' the second element of the 'Built' field of the \code{file}. For packages that do not
##' need compilation on macOS for R >= 4.3 the 'Built' field is empty in the DESCRIPTION
##' in a binary file (tgz), in which case it can be useful to set the \code{OSflavour}
##' e.g. by the value of R.Version()$platform, so that \code{\link{insertPackages}} inserts
##' the binary into the appropriate sub folder (under bin/maxosx).
##' @section Note:
##' This is an internal function, use \code{:::} to access it from outside
##' the internal package code.
##' @return A named vector with several components
##' @author Dirk Eddelbuettel
getPackageInfo <- function(file, OSflavour = character()) {
if (!file.exists(file)) stop("File ", file, " not found!", call. = FALSE)
td <- tempdir()
if (grepl(".zip$", file)) {
unzip(file, exdir = td) # Windows
} else if (grepl(".tgz$", file)) {
untar(file, exdir = td) # macOS
} else {
# Source
##stop("Not sure we can handle ", file, call.=FALSE)
fields <- c("Source" = TRUE, "Rmajor" = NA, "osxFolder" = "")
return(fields)
}
# Working with data from compressed file only from here on
pkgname <- gsub("^([a-zA-Z0-9.]*)_.*", "\\1", basename(file))
path <- file.path(td, pkgname, "DESCRIPTION")
if(!file.exists(path)){
stop("DESCRIPTION file cannot be opened in '",file,"'. It is expected ",
"to be located in the base directory of compressed file.",
call. = FALSE)
}
builtstring <- read.dcf(path, 'Built')
unlink(file.path(td, pkgname), recursive = TRUE)
fields <- strsplit(builtstring, "; ")[[1]]
names(fields) <- c("Rversion", "OSflavour", "Date", "OS")
# Insert the OSflavour if specified by the user:
if(length(OSflavour) && is.character(OSflavour)) {
fields[["OSflavour"]] <- OSflavour
}
rmajor <- gsub("^R (\\d\\.\\d)\\.\\d.*", "\\1", fields["Rversion"])
osxFolder <- switch(fields["OSflavour"],
"x86_64-apple-darwin13.4.0" = "mavericks",
"x86_64-apple-darwin15.6.0" = "el-capitan",
"x86_64-apple-darwin20" = "big-sur-x86_64",
"aarch64-apple-darwin20" = "big-sur-arm64",
"")
fields <- c(fields, "Rmajor" = unname(rmajor), "osxFolder" = osxFolder)
return(fields)
}
contrib.url2 <- function(repos, type = getOption("pkgType"), version = NULL){
FUN <- function(t){
contrib_url <- contrib.url(repos = repos, type = t)
if(is.null(version)){
return(contrib_url)
} else if(is.na(version)) {
if(t != "source"){
contrib_url <- c(contrib_url,
list.dirs(gsub(DRAT_CONTRIB_VERSION_REGEX, "contrib",
contrib_url),
recursive = FALSE))
contrib_url <- unique(contrib_url)
}
} else {
version <- package_version(version)
contrib_url <- gsub(DRAT_CONTRIB_VERSION_REGEX,
file.path("contrib",
paste0(version$major,".",version$minor)),
contrib_url)
contrib_url
}
contrib_url
}
urls <- lapply(type,FUN)
names <- unlist(mapply(rep,type,lengths(urls),SIMPLIFY = FALSE))
urls <- unlist(urls)
names(urls) <- names
urls
}