.getRequiredPackages2

.getRequiredPackages2.R

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>