1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
bundlePackages <- function(bundleDir,
extraPackages = character(),
quiet = FALSE,
verbose = FALSE,
error_call = caller_env()) {
deps <- computePackageDependencies(
bundleDir,
extraPackages,
quiet = quiet,
verbose = verbose
)
if (nrow(deps) == 0) {
return(list())
}
checkBundlePackages(deps, call = error_call)
# Manifest packages used to generate packrat file on Connect
# https://github.com/rstudio/connect/blob/v2023.03.0/src/connect/manifest/convert.go#L261-L320
packages_list <- lapply(seq_len(nrow(deps)), function(i) {
out <- as.list(deps[i, , drop = FALSE])
out$description <- out$description[[1]]
out$Package <- NULL
out$Version <- NULL
out
})
names(packages_list) <- deps$Package
packages_list
}
usePackrat <- function() {
# Use RSCONNECT_PACKRAT when it has any value; fall-back to rsconnect.packrat when the environment
# variable is unset.
value <- Sys.getenv("RSCONNECT_PACKRAT", unset = NA)
if (is.na(value)) {
value <- getOption("rsconnect.packrat", default = FALSE)
}
return(truthy(value))
}
computePackageDependencies <- function(bundleDir,
extraPackages = character(),
quiet = FALSE,
verbose = FALSE) {
if (usePackrat()) {
taskStart(quiet, "Capturing R dependencies with packrat")
# Remove renv.lock so the packrat call to renv::dependencies does not report an implicit renv
# dependency. Mirrors rsconnect before 1.0.0, which did not include renv.lock in bundles.
# https://github.com/rstudio/rsconnect/blob/v0.8.29/R/bundle.R#L96
removeRenv(bundleDir)
deps <- snapshotPackratDependencies(bundleDir, extraPackages, verbose = verbose)
} else if (file.exists(renvLockFile(bundleDir))) {
# This ignores extraPackages; if you're using a lockfile it's your
# responsibility to install any other packages you need
taskStart(quiet, "Capturing R dependencies from renv.lock")
deps <- parseRenvDependencies(bundleDir)
# Once we've captured the deps, we can remove the renv directory
# from the bundle (retaining the renv.lock).
removeRenv(bundleDir, lockfile = FALSE)
} else {
taskStart(quiet, "Capturing R dependencies")
# TODO: give user option to choose between implicit and explicit
deps <- snapshotRenvDependencies(bundleDir, extraPackages, quiet = quiet, verbose = verbose)
}
taskComplete(quiet, "Found {nrow(deps)} dependenc{?y/ies}")
deps
}
checkBundlePackages <- function(deps, call = caller_env()) {
unknown_source <- is.na(deps$Source)
if (any(unknown_source)) {
pkgs <- deps$Package[unknown_source]
cli::cli_abort(
c(
"All packages must be installed from a reproducible location.",
x = "Can't re-install packages installed from source: {.pkg {pkgs}}.",
i = "See {.fun rsconnect::appDependencies} for more details."
),
call = call
)
}
}
manifestPackageColumns <- function(df) {
# Fields defined in https://bit.ly/42CbD4P
# Most fields are retrieved from the complete embedded description.
# shinyapps.io needs GitHub fields for backward compatibility
github_cols <- grep("^Github", names(df), perl = TRUE, value = TRUE)
intersect(
c("Package", "Version", "Source", "Repository", github_cols),
names(df)
)
}
availablePackages <- function(repos) {
# read available.packages filters (allow user to override if necessary;
# this is primarily to allow debugging)
#
# note that we explicitly exclude the "R_version" filter as we want to ensure
# that packages which require newer versions of R than the one currently
# in use can still be marked as available on CRAN -- for example, currently
# the package "foreign" requires "R (>= 4.0.0)" but older versions of R
# can still successfully install older versions from the CRAN archive
filters <- c(
getOption("rsconnect.available_packages_filters", default = c()),
"duplicates"
)
available.packages(
repos = repos,
type = "source",
filters = filters
)
}
package_record <- function(name, lib_dir = NULL) {
record <- packageDescription(name, lib.loc = lib_dir, encoding = "UTF-8")
unclass(record)
}
|
