in R/R/sqlPackage.R [913:1120]
sqlEnumPackages <- function(connectionString, owner, scope, priority, fields, subarch, languageName)
{
result <- list(packages = NULL, warnings = NULL, errors = NULL)
scopeint <- parseScope(scope)
pkgGetLibraryPath <- function(scopeint)
{
if (!all.equal(scopeint,as.integer(scopeint)))
{
stop("pkgGetLibraryPathExtLib(): scope expected to be an integer", call. = FALSE)
}
if (scopeint == 0)
{
extLibPath <- Sys.getenv("MRS_EXTLIB_SHARED_PATH")
}
else if (scopeint == 1)
{
extLibPath <- Sys.getenv("MRS_EXTLIB_USER_PATH")
}
else
{
stop(paste0("pkgGetLibraryPathExtLib(): invalid scope value ", scopeint, ""), call. = FALSE)
}
extLibPath <- normalizePath(extLibPath, mustWork = FALSE)
extLibPath <- gsub('\\\\', '/', extLibPath)
return(extLibPath)
}
#
# Returns PRIVATE, PUBLIC and SYSTEM library paths in a data frame in this order
#
sqlGetScopeLibraryPaths <- function(connectionString)
{
getScopeLibraryPaths <- function()
{
publicPath <- try(pkgGetLibraryPath(0), silent = TRUE)
if (inherits(publicPath, "try-error"))
{
publicPath <- NA
}
privatePath <- try(pkgGetLibraryPath(1), silent = TRUE)
if (inherits(privatePath, "try-error"))
{
privatePath <- NA
}
systemPath <- .Library
scopes <- c("PRIVATE", "PUBLIC", "SYSTEM")
return (data.frame(Scope = scopes, Path = c(privatePath, publicPath, systemPath), row.names = scopes, stringsAsFactors = FALSE))
}
libPaths <- sqlRemoteExecuteFun(connectionString,
getScopeLibraryPaths,
asuser = owner,
includeFun = list(pkgGetLibraryPath = pkgGetLibraryPath),
languageName = languageName)
return(libPaths)
}
#
# Appends installed packages for a specific scope & library path
#
addInstalledPackages <- function(connectionString, installedPackages = NULL, libScope, libPath, priority = NULL, fields = "Package", subarch = NULL)
{
result <- list(installedPackages = NULL, warnings = NULL, errors = NULL)
#
# Returns data frame will list of all packages and their 'isTopLevel' attribute for given owner and scope
# If attribute 'isTopLevel' is not set for a package it will be -1
#
sqlQueryIsTopPackageExtLib <- function(connectionString, packagesNames, owner, scope)
{
scopeint <- parseScope(scope)
result <- enumerateTopPackages(
connectionString = connectionString,
packages = packagesNames,
owner = owner,
scope = scopeint,
languageName = languageName)
if (is.null(result) || nrow(result)<1)
{
return(NULL)
}
else if (is.data.frame(result))
{
rownames(result) <- result$name
return (result)
}
}
# enumerate packages installed under sql server R library path
#
packages <- NULL
tryCatch(
{
packages <- sqlRemoteExecuteFun(connectionString, utils::installed.packages, lib.loc = libPath, noCache = TRUE,
priority = priority, fields = NULL, subarch = subarch,
useRemoteFun = TRUE, asuser = owner, languageName = languageName)
},
error = function(err)
{
stop(paste0("failed to enumerate installed packages on library path: ", err$message), call. = FALSE)
})
if (!is.null(packages) && nrow(packages) > 0)
{
packages <- cbind(packages, Attributes = rep(NA, nrow(packages)), Scope = rep(libScope, nrow(packages)))
# get top package flag if attributes column will be present in final results and if we are in PUBLIC or PRIVATE scope
#
if (nrow(packages) > 0 && (libScope == 'PUBLIC' || libScope == 'PRIVATE'))
{
filteredPackages <- processInstalledPackagesResult(packages, fields)
if ('Attributes' %in% colnames(filteredPackages))
{
packagesNames <- rownames(packages[packages[,'Scope'] == libScope,, drop = FALSE])
if (length(packagesNames) > 0)
{
isTopPackageDf<-sqlQueryIsTopPackageExtLib(connectionString, packagesNames, owner, libScope)
if (!is.null(isTopPackageDf))
{
for(pkg in packagesNames)
{
if (packages[pkg,'Scope'] == libScope)
{
isTopPackage <- as.integer(isTopPackageDf[pkg,'IsTopPackage'])
if (isTopPackage == IS_TOP_PACKAGE_MISSING)
{
isTopPackage = 1
}
packages[pkg,'Attributes'] <- isTopPackage
}
}
}
}
}
}
if (is.null(installedPackages))
{
installedPackages <- packages
}
else
{
installedPackages <- rbind(installedPackages, packages)
}
}
result$installedPackages <- installedPackages
return(result)
}
extLibPaths <- sqlGetScopeLibraryPaths(connectionString)
installedPackages <- NULL
for(i in 1:nrow(extLibPaths))
{
libPath <- extLibPaths[i, "Path"]
if (!is.na(libPath))
{
libScope <- extLibPaths[i, "Scope"]
ret <- NULL
if (libScope == "PRIVATE")
{
if (scope == "PRIVATE")
{
ret <- addInstalledPackages(connectionString, installedPackages, libScope, libPath, priority, fields, subarch)
}
}
else
{
ret <- addInstalledPackages(connectionString, installedPackages, libScope, libPath, priority, fields, subarch)
}
if (!is.null(ret))
{
installedPackages <- ret$installedPackages
result$warnings <- c(result$warnings,ret$warnings)
result$errors <- c(result$errors,ret$errors)
}
}
}
installedPackages <- processInstalledPackagesResult(installedPackages, fields)
result$packages <- installedPackages
return(result)
}