Skip to content

Instantly share code, notes, and snippets.

@gswallow
Last active August 29, 2015 14:06
Show Gist options
  • Save gswallow/ba0d18d4b3aeb0ad28d9 to your computer and use it in GitHub Desktop.
Save gswallow/ba0d18d4b3aeb0ad28d9 to your computer and use it in GitHub Desktop.
R package installer (handles specific versions)
#!/usr/bin/env Rscript
# Command line options parser. Shamelessly stolen (and even then
# not well understood).
library('getopt');
spec = matrix(c(
'package', 'p', 1, 'character',
'version', 'v', 2, 'character',
'help', 'h', 0, 'logical'
), byrow=TRUE, ncol=4);
opt = getopt(spec);
# Help, or, how to test your command-line options parser
if ( !is.null(opt$help) ) {
cat(getopt(spec, usage=TRUE));
q(status=1);
}
# Looks in the CRAN archive for the specified package and version. If
# the specified version is NULL or the same as the most recent version
# of the package, this function simply calls install.packages(). Otherwise,
# it looks at the list of archived source tarballs and tries to install
# an older version instead.
check.package.version <- function(package, version = NULL)
{
gsub('-', '.', version) == tryCatch({packageVersion(package)}, error = function(cond) { return(FALSE) })
}
install.package.version <- function(package, version, repos = "http://cran.r-project.org", type = "source")
{
contriburl <- contrib.url(repos, type)
available <- available.packages(contriburl)
if (package %in% row.names(available)) {
current.version <- available[package, 'Version']
if (is.null(version) || version == current.version) {
install.packages(package, repos = repos, contriburl = contriburl, type = type)
return()
}
}
con <- gzcon(url(sprintf("%s/src/contrib/Meta/archive.rds", repos), "rb"))
archive <- readRDS(con)
close(con)
info <- archive[[package]]
if (is.null(info)) {
stop(sprintf("couldn't find package '%s'", package))
}
if (is.null(version)) {
# Just grab the latest one. This will only happen if the package
# has been pulled from CRAN.
# I don't think this code is ever called.
package.path <- info[length(info)]
} else {
package.path <- paste(package, "/", package, "_", version, ".tar.gz", sep="")
if (!(package.path %in% row.names(info))) {
stop(sprintf("version '%s' is invalid for package '%s'", version, package))
}
}
package.url <- sprintf("%s/src/contrib/Archive/%s", repos, package.path)
local.path <- file.path(tempdir(), basename(package.path))
if (download.file(package.url, local.path) != 0) {
stop("couldn't download file: ", package.url)
}
options(install.packages.check.source = "no")
install.packages(local.path, type = type)
}
if (!isTRUE(check.package.version(opt$package,opt$version))) {
install.package.version(opt$package, opt$version)
}
@gswallow
Copy link
Author

gswallow commented Sep 5, 2014

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment