Nothing
glob_find_replace <- function(glob, FIND, REPLACE){
some.files <- Sys.glob(glob)
for(f in some.files){
l.old <- readLines(f)
l.new <- gsub(FIND, REPLACE, l.old)
writeLines(l.new, f)
}
}
pkg.edit.default <- function(old.Package, new.Package, sha, new.pkg.path){
pkg_find_replace <- function(glob, FIND, REPLACE){
glob_find_replace(file.path(new.pkg.path, glob), FIND, REPLACE)
}
pkg_find_replace(
"DESCRIPTION",
paste0("Package:\\s+", old.Package),
paste("Package:", new.Package))
Package_ <- gsub(".", "_", old.Package, fixed=TRUE)
R_init_pkg <- paste0("R_init_", Package_)
new.Package_ <- paste0(Package_, "_", sha)
pkg_find_replace(
file.path("src", "RcppExports.cpp"),
R_init_pkg,
paste0("R_init_", new.Package_))
pkg_find_replace(
"NAMESPACE",
sprintf('useDynLib\\("?%s"?', Package_),
paste0('useDynLib(', new.Package))
}
atime_versions_remove <- function(Package){
lib <- .libPaths()[1]
pkg.in.lib <- file.path(lib, Package)
pkg.sha.glob <- paste0(pkg.in.lib, ".*")
code <- unlink(pkg.sha.glob, recursive=TRUE, force=TRUE)
paths.after <- Sys.glob(pkg.sha.glob)
pkgs.after <- basename(paths.after)
if(length(pkgs.after)){
warning("packages were not removed, probably because they are currently loaded (fix by restarting R): ", paste(pkgs.after, collapse=", "))
}
code
}
atime_versions_install <- function(Package, pkg.path, new.Package.vec, sha.vec, verbose, pkg.edit.fun=pkg.edit.default){
first.lib <- .libPaths()[1]
DESC.in.lib <- Sys.glob(file.path(first.lib, "*", "DESCRIPTION"))
pkgs.in.lib <- basename(dirname(DESC.in.lib))
new.not.installed <- !new.Package.vec %in% pkgs.in.lib
if(any(new.not.installed)){
## on GH actions windows tempfile() gives C:\Users\RUNNER~1\AppData\Local\Temp\Rtmpc9T5Us/working_dir\Rtmpu23suf\file5d41af35765
tdir <- normalizePath(tempfile(), mustWork=FALSE)
dir.create(tdir)
## pkg.path may be path/to/repo/pkg
norm.pkg.path <- normalizePath(pkg.path)
orig.repo <- git2r::repository(norm.pkg.path)
## path/to/repo root without trailing /.git
orig.repo.path <- normalizePath(dirname(orig.repo$path))
## /pkg
pkg.suffix.in.repo <- sub(orig.repo.path, "", norm.pkg.path, fixed=TRUE)
for(new.i in which(new.not.installed)){
sha <- sha.vec[[new.i]]
new.Package <- new.Package.vec[[new.i]]
if(new.Package %in% pkgs.in.lib){
if(verbose){
message(sprintf(
"not installing %s because it already exists in %s",
new.Package, first.lib))
}
}else if(sha == ""){
install.packages(Package)
}else{
new.repo.path <- file.path(tdir, new.Package)
unlink(new.repo.path, recursive=TRUE, force=TRUE)
repo <- git2r::clone(orig.repo.path, new.repo.path, progress=FALSE)
new.pkg.path <- paste0(new.repo.path, pkg.suffix.in.repo)
tryCatch(
git2r::checkout(repo, branch=sha, force=TRUE),
error=function(e)stop(
e, " when trying to checkout ", sha))
## before editing and installing, make sure directory has sha
## suffix, for windows checks.
unlink(file.path(new.pkg.path, "src", "*.o"))
pkg.edit.fun(
old.Package=Package,
new.Package=new.Package,
sha=sha,
new.pkg.path=new.pkg.path)
INSTALL.cmd <- paste(
shQuote(file.path(
Sys.getenv("R_HOME"),
"bin",
"R")),
'CMD INSTALL -l',
shQuote(.libPaths()[1]),
shQuote(new.pkg.path))
status.int <- system(INSTALL.cmd)
if(status.int != 0){
stop(INSTALL.cmd, " returned error status code ", status.int)
}
if(verbose){
cat("\nPackage info after editing and installation:\n")
grep_glob <- function(glob, pattern){
some.files <- Sys.glob(file.path(new.pkg.path, glob))
out <- list()
for(f in some.files){
line.vec <- readLines(f)
match.vec <- grep(pattern, line.vec, value=TRUE)
if(length(match.vec)){
out[[f]] <- match.vec
}
}
out
}#grep_glob
out <- c(
grep_glob("DESCRIPTION", "^Package"),
grep_glob("NAMESPACE", "^useDynLib"),
grep_glob(file.path("src", "*.c"), "R_init_"),
grep_glob(file.path("src", "*.cpp"), "R_init_"))
src.files <- dir(file.path(new.pkg.path, "src"))
out[["src/*.so|dll"]] <- grep("(so|dll)$", src.files, value=TRUE)
print(out)
cat("\n")
}#if(verbose)
}#if(new package not in lib)
}#for(new.i
}#any to install
}
atime_versions <- function(pkg.path, N=default_N(), setup, expr, sha.vec=NULL, times=10, seconds.limit=0.01, verbose=FALSE, pkg.edit.fun=pkg.edit.default, result=FALSE, N.env.parent=NULL, ...){
ver.args <- list(
pkg.path, substitute(expr), sha.vec, verbose, pkg.edit.fun, ...)
install.seconds <- system.time({
ver.exprs <- do.call(atime_versions_exprs, ver.args)
})[["elapsed"]]
a.args <- list(
N, substitute(setup), ver.exprs, times, seconds.limit, verbose, result, N.env.parent)
bench.seconds <- system.time({
out.list <- do.call(atime, a.args)
})[["elapsed"]]
out.list$install.seconds <- install.seconds
out.list$bench.seconds <- bench.seconds
out.list
}
get_sha_vec <- function(sha.vec, dots.vec){
SHA.vec <- as.list(c(dots.vec, sha.vec))
if(length(SHA.vec)==0){
stop("need to specify at least one git SHA, in either sha.vec, or ...")
}
if(is.null(names(SHA.vec)) || any(names(SHA.vec)=="")){
stop("each ... argument and sha.vec element must be named")
}
is.problem <- !sapply(SHA.vec, function(x){
is.character(x) && length(x)==1 && !is.na(x)
})
if(any(is.problem)){
stop("each ... argument value and sha.vec element must be a string (package version, length=1, not NA), problems: ", paste(names(SHA.vec[is.problem]), collapse=", "))
}
SHA.vec
}
atime_versions_exprs <- function(pkg.path, expr, sha.vec=NULL, verbose=FALSE, pkg.edit.fun=pkg.edit.default, ...){
formal.names <- names(formals())
mc.args <- as.list(match.call()[-1])
dots.vec <- mc.args[!names(mc.args) %in% formal.names]
SHA.vec <- get_sha_vec(sha.vec, dots.vec)
pkg.DESC <- file.path(pkg.path, "DESCRIPTION")
if(!file.exists(pkg.DESC)){
stop(sprintf("pkg.path=%s should be path to an R package, but %s does not exist", pkg.path, pkg.DESC))
}
DESC.mat <- read.dcf(pkg.DESC)
Package <- DESC.mat[,"Package"]
new.Package.vec <- paste0(
Package,
ifelse(SHA.vec=="", "", "."),
SHA.vec)
a.args <- list()
for(commit.i in seq_along(SHA.vec)){
sha <- SHA.vec[[commit.i]]
commit.name <- names(SHA.vec)[[commit.i]]
new.Package <- new.Package.vec[[commit.i]]
old.lines <- capture.output(substitute(expr))
new.lines <- gsub(
paste0(Package,"::"),
paste0(new.Package,"::"),
old.lines,
fixed=TRUE)
if(Package!=new.Package && identical(old.lines,new.lines)){
stop(sprintf("expr should contain at least one instance of %s:: to replace with %s::", Package, new.Package))
}
a.args[[commit.name]] <- str2lang(paste(new.lines, collapse="\n"))
atime_versions_install(
Package, normalizePath(pkg.path),
new.Package.vec, SHA.vec, verbose, pkg.edit.fun)
}
a.args
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.