Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
.getRequiredPackages2
function (pkgInfo, quietly = FALSE, lib.loc = NULL, useImports = FALSE)
{
.findVersion <- function(pkg, lib.loc = NULL) {
pfile <- system.file("Meta", "package.rds", package = pkg,
lib.loc = lib.loc)
if (nzchar(pfile))
as.numeric_version(readRDS(pfile)$DESCRIPTION["Version"])
else NULL
}
.findAllVersions <- function(pkg, lib.loc = NULL) {
if (is.null(lib.loc))
lib.loc <- .libPaths()
do.call(c, Filter(Negate(is.null), lapply(lib.loc, .findVersion,
pkg = pkg)))
}
pkgs <- unique(names(pkgInfo$Depends))
pkgname <- pkgInfo$DESCRIPTION["Package"]
for (pkg in setdiff(pkgs, "base")) {
depends <- pkgInfo$Depends[names(pkgInfo$Depends) ==
pkg]
attached <- paste("package", pkg, sep = ":") %in% search()
current <- .findVersion(pkg, lib.loc)
if (is.null(current))
stop(gettextf("package %s required by %s could not be found",
sQuote(pkg), sQuote(pkgname)), call. = FALSE,
domain = NA)
have_vers <- lengths(depends) > 1L
for (dep in depends[have_vers]) {
target <- as.numeric_version(dep$version)
sufficient <- do.call(dep$op, list(current, target))
if (!sufficient) {
if (is.null(lib.loc))
lib.loc <- .libPaths()
versions <- .findAllVersions(pkg, lib.loc)
sufficient <- vapply(versions, dep$op, logical(1L),
target)
if (any(sufficient)) {
warning(gettextf("version %s of %s masked by %s in %s",
versions[which(sufficient)[1L]], sQuote(pkg),
current, lib.loc[which(sufficient)[1L] -
1L]), call. = FALSE, domain = NA)
}
if (attached)
msg <- "package %s %s is loaded, but %s %s is required by %s"
else msg <- "package %s %s was found, but %s %s is required by %s"
stop(gettextf(msg, sQuote(pkg), current, dep$op,
target, sQuote(pkgname)), call. = FALSE, domain = NA)
}
}
if (!attached) {
if (!quietly)
packageStartupMessage(gettextf("Loading required package: %s",
pkg), domain = NA)
library(pkg, character.only = TRUE, logical.return = TRUE,
lib.loc = lib.loc, quietly = quietly) || stop(gettextf("package %s could not be loaded",
sQuote(pkg)), call. = FALSE, domain = NA)
}
}
if (useImports) {
nss <- names(pkgInfo$Imports)
for (ns in nss) loadNamespace(ns, lib.loc)
}
}
<bytecode: 0x103c4bc00>
<environment: namespace:base>
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment