prunePackagesToInstallExtLib <- function()

in R/R/sqlPackage.R [1201:1275]
49 lines of code
10 McCabe index (conditional complexity)

prunePackagesToInstallExtLib <- function(dependentPackages, topMostPackages, installedPackages, verbose = getOption("verbose"))
{
    prunedPackagesToInstall <- NULL
    prunedPackagesToTop <- NULL

    if (is.null(dependentPackages))
    {
        return(list(NULL, NULL))
    }

    for (pkgToInstallIndex in 1:nrow(dependentPackages))
    {
        pkgToInstall <- dependentPackages[pkgToInstallIndex,]

        # get available packages that match the name of the package we depend on
        #
        availablePkgs <- installedPackages[match(pkgToInstall$Package, installedPackages$Package, nomatch = 0),, drop = FALSE]


        if (nrow(availablePkgs) == 0)
        {
            # no packages available, add packages we depend to the list of pruned packages to install
            #
            prunedPackagesToInstall <- rbind(prunedPackagesToInstall, pkgToInstall)
        }
        else
        {
            # If a package A is installed that depends on B and B is already installed, 3 scenarios are possible:
            # (1) versions are the same -> OK
            # (2) installed version is newer -> OK
            # (3) installed version is older -> we print a warning to allow user to make proper decision
            #
            for(scope in c("PRIVATE", "PUBLIC", "SYSTEM"))
            {
                availablePkg <- availablePkgs[ availablePkgs$Scope == scope,, drop = FALSE ]
                if (nrow(availablePkg) == 1)
                {
                    if (utils::compareVersion(availablePkg$Version, pkgToInstall$Version) == -1)
                    {
                        # pkgToInstall is newer (later) than availablePkg
                        #
                        warning(sprintf("package is already installed but version is older than available in repos:
                                        package='%s', scope='%s', currently installed version='%s', new version=='%s'",
                                        pkgToInstall$Package, scope, availablePkg$Version, pkgToInstall$Version), call. = FALSE)
                    }

                    break
                }
            }

            # if the available package is being requested as a top-level package we check
            # if the top-leve attribute on the package is set to false we will have to update it to true
            #
            if ('Attributes' %in% colnames(installedPackages))
            {
                # package to install is requested as top-level
                #
                if (pkgToInstall$Package %in% topMostPackages)
                {
                    # if package is marked as depended we have to set it as top-level
                    #
                    pkgToTop <- availablePkgs[!is.na(availablePkgs[,'Attributes']) &
                                                  bitwAnd(as.integer(availablePkgs[,'Attributes']), getPackageTopMostAttributeFlag()) ==  0
                                              ,, drop = FALSE]
                    if (nrow(pkgToTop) > 0)
                    {
                        prunedPackagesToTop <- rbind(prunedPackagesToTop, pkgToTop)
                    }
                }
            }
        }
    }

    return (list(prunedPackagesToInstall, prunedPackagesToTop))
}