inst/header.R

In rang: Reconstructing Reproducible R Computational Environments

## generated by rang, do not edit by hand

current.r.version <- paste(R.Version()[c("major","minor")], collapse = ".", sep = "")

if (Sys.getenv("CACHE_PATH") != "") {
    path <- file.path(Sys.getenv("CACHE_PATH"), "rpkgs")
} else {
    path <- tempdir()
}

.install.packages <- function(tarball.path, lib, verbose, current.r.version) {
    if (utils::compareVersion(current.r.version, "3.0") != -1) {
        if (is.na(lib)) {
            install.packages(pkg = tarball.path, repos = NULL, verbose = verbose, quiet = !verbose)
        } else {
            install.packages(pkg = tarball.path, lib = lib, repos = NULL, verbose = verbose, quiet = !verbose)
        }
    } else {
        if (is.na(lib)) {
            install.packages(pkg = tarball.path, repos = NULL)
        } else {
            install.packages(pkg = tarball.path, lib = lib, repos = NULL)
        }
    }
}

.download.package <- function(tarball.path, x, version, handle, source, uid, verbose, cran.mirror, bioc.mirror, current.r.version) {
    if (source == "github") {
        return(.download.package.from.github(tarball.path, x, version, handle, source, uid, current.r.version))
    }
    if (source == "bioc") {
        url <- paste(bioc.mirror, uid, "/src/contrib/", x, "_", version, ".tar.gz", sep = "")
    }
    if (source == "cran") {
        url <- paste(cran.mirror, "src/contrib/Archive/", x, "/", x, "_", version, ".tar.gz", sep = "")
    }

    tryCatch({
        suppressWarnings(download.file(url, destfile = tarball.path, quiet = !verbose))
    }, error = function(e) {
        if (source == "cran") {
            ## is the current latest
            url <- paste(cran.mirror, "src/contrib/", x, "_", version, ".tar.gz", sep = "")
            download.file(url, destfile = tarball.path, quiet = !verbose)
        }
    })
    invisible(tarball.path)
}

.tempfile <- function(tmpdir = tempdir(), fileext = ".tar.gz") {
    file.path(tmpdir,
    paste(paste(sample(c(LETTERS, letters), 20, replace = TRUE), collapse = ""), fileext, sep = ""))
}

.build.raw.tarball <- function(raw.tarball.path, x, version, tarball.path, current.r.version) {
    if (utils::compareVersion(current.r.version, "3.1") != -1) {
        vignetteflag <- "--no-build-vignettes"
    } else {
        vignetteflag <- "--no-vignettes"
    }
    tmp.dir <- .tempfile(fileext = "")
    dir.create(tmp.dir)
    system(command = paste("tar", "-zxf ", raw.tarball.path, "-C", tmp.dir))
    pkg.dir <- list.files(path = tmp.dir, full.names = TRUE)[1]
    new.pkg.dir <- file.path(tmp.dir, x)
    file.rename(pkg.dir, new.pkg.dir)
    res <- system(command = paste("R", "CMD", "build", vignetteflag, new.pkg.dir))
    expected.tarball.path <- paste(x, "_", version, ".tar.gz", sep = "")
    stopifnot(file.exists(expected.tarball.path))
    file.rename(expected.tarball.path, tarball.path)
    return(tarball.path)
}

.build.dir.tarball <- function(dir.pkg.path, x, version, tarball.path, current.r.version) {
    if (utils::compareVersion(current.r.version, "3.1") != -1) {
        vignetteflag <- "--no-build-vignettes"
    } else {
        vignetteflag <- "--no-vignettes"
    }
    expected.tarball.path <- paste(x, "_", version, ".tar.gz", sep = "")
    res <- system(command = paste("R", "CMD", "build", vignetteflag, dir.pkg.path))
    stopifnot(file.exists(expected.tarball.path))
    file.rename(expected.tarball.path, tarball.path)
    return(tarball.path)
}

.install.from.source <- function(x, version, handle, source, uid, lib,
                                 path = tempdir(), verbose, cran.mirror, bioc.mirror, current.r.version) {
    tarball.path <- file.path(path, paste(x, "_", version, ".tar.gz", sep = ""))
    raw.tarball.path <- file.path(path, paste("raw_", x, "_", version, ".tar.gz", sep = ""))
    dir.pkg.path <- file.path(path, paste("dir_", x, "_", version, sep = ""))
    if (!file.exists(tarball.path) && !file.exists(raw.tarball.path) && !file.exists(dir.pkg.path)) {
        .download.package(tarball.path = tarball.path, x = x, version = version, handle = handle, source = source,
                          uid = uid, verbose = verbose, cran.mirror = cran.mirror, bioc.mirror = bioc.mirror,
                          current.r.version = current.r.version)
    }
    if (file.exists(raw.tarball.path)) {
        tarball.path <- .build.raw.tarball(raw.tarball.path, x = x, version = version, tarball.path,
                                           current.r.version = current.r.version)
        if (!file.exists(tarball.path)) {
            stop("building failed.")
        }
    }
    if (file.exists(dir.pkg.path)) {
        tarball.path <- .build.dir.tarball(dir.pkg.path, x = x, version = version, tarball.path,
                                           current.r.version = current.r.version)
        if (!file.exists(tarball.path)) {
            stop("building failed.")
        }
    }
    .install.packages(tarball.path, lib, verbose, current.r.version)
    ## check and error
    if (!is.na(lib)) {
        installed.packages <- installed.packages(lib.loc = lib)
    } else {
        installed.packages <- installed.packages()
    }
    if (!x %in% dimnames(installed.packages)[[1]]) {
        stop("Fail to install ", x, "\n")
    }
    invisible()
}

# installing github packages
.download.github.safe <- function(handle, sha, file) {
    tryCatch(
        download.file(paste("http://api.github.com/repos/", handle, "/tarball/", sha, sep = ""), destfile = file),
        error = function(e) {
            stop(paste("couldn't download ", handle, " from github", sep = ""), call. = FALSE)
        }
    )
}

.download.package.from.github <- function(tarball.path, x, version, handle, source, uid, current.r.version) {
    sha <- uid
    short.sha <- substr(sha, 1, 7)
    raw.tarball.path <- .tempfile(fileext = ".tar.gz")
    tmp.dir <- tempdir()
    tryCatch(
        download.file(paste("https://api.github.com/repos/", handle, "/tarball/", sha, sep = ""), destfile = raw.tarball.path),
        error = function(e) {
            .download.github.safe(handle, sha, raw.tarball.path)
        }
    )
    .build.raw.tarball(raw.tarball.path = raw.tarball.path, x = x, version = version, tarball.path = tarball.path, current.r.version = current.r.version)
    return(tarball.path)
}