Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
quarto-dev
GitHub Repository: quarto-dev/quarto-cli
Path: blob/main/tests/docs/manuscript/qmd-full/renv/activate.R
3593 views
1
2
local({
3
4
# the requested version of renv
5
version <- "0.17.3"
6
7
# the project directory
8
project <- getwd()
9
10
# figure out whether the autoloader is enabled
11
enabled <- local({
12
13
# first, check config option
14
override <- getOption("renv.config.autoloader.enabled")
15
if (!is.null(override))
16
return(override)
17
18
# next, check environment variables
19
# TODO: prefer using the configuration one in the future
20
envvars <- c(
21
"RENV_CONFIG_AUTOLOADER_ENABLED",
22
"RENV_AUTOLOADER_ENABLED",
23
"RENV_ACTIVATE_PROJECT"
24
)
25
26
for (envvar in envvars) {
27
envval <- Sys.getenv(envvar, unset = NA)
28
if (!is.na(envval))
29
return(tolower(envval) %in% c("true", "t", "1"))
30
}
31
32
# enable by default
33
TRUE
34
35
})
36
37
if (!enabled)
38
return(FALSE)
39
40
# avoid recursion
41
if (identical(getOption("renv.autoloader.running"), TRUE)) {
42
warning("ignoring recursive attempt to run renv autoloader")
43
return(invisible(TRUE))
44
}
45
46
# signal that we're loading renv during R startup
47
options(renv.autoloader.running = TRUE)
48
on.exit(options(renv.autoloader.running = NULL), add = TRUE)
49
50
# signal that we've consented to use renv
51
options(renv.consent = TRUE)
52
53
# load the 'utils' package eagerly -- this ensures that renv shims, which
54
# mask 'utils' packages, will come first on the search path
55
library(utils, lib.loc = .Library)
56
57
# unload renv if it's already been loaded
58
if ("renv" %in% loadedNamespaces())
59
unloadNamespace("renv")
60
61
# load bootstrap tools
62
`%||%` <- function(x, y) {
63
if (is.environment(x) || length(x)) x else y
64
}
65
66
`%??%` <- function(x, y) {
67
if (is.null(x)) y else x
68
}
69
70
bootstrap <- function(version, library) {
71
72
# attempt to download renv
73
tarball <- tryCatch(renv_bootstrap_download(version), error = identity)
74
if (inherits(tarball, "error"))
75
stop("failed to download renv ", version)
76
77
# now attempt to install
78
status <- tryCatch(renv_bootstrap_install(version, tarball, library), error = identity)
79
if (inherits(status, "error"))
80
stop("failed to install renv ", version)
81
82
}
83
84
renv_bootstrap_tests_running <- function() {
85
getOption("renv.tests.running", default = FALSE)
86
}
87
88
renv_bootstrap_repos <- function() {
89
90
# get CRAN repository
91
cran <- getOption("renv.repos.cran", "https://cloud.r-project.org")
92
93
# check for repos override
94
repos <- Sys.getenv("RENV_CONFIG_REPOS_OVERRIDE", unset = NA)
95
if (!is.na(repos)) {
96
97
# check for RSPM; if set, use a fallback repository for renv
98
rspm <- Sys.getenv("RSPM", unset = NA)
99
if (identical(rspm, repos))
100
repos <- c(RSPM = rspm, CRAN = cran)
101
102
return(repos)
103
104
}
105
106
# check for lockfile repositories
107
repos <- tryCatch(renv_bootstrap_repos_lockfile(), error = identity)
108
if (!inherits(repos, "error") && length(repos))
109
return(repos)
110
111
# if we're testing, re-use the test repositories
112
if (renv_bootstrap_tests_running()) {
113
repos <- getOption("renv.tests.repos")
114
if (!is.null(repos))
115
return(repos)
116
}
117
118
# retrieve current repos
119
repos <- getOption("repos")
120
121
# ensure @CRAN@ entries are resolved
122
repos[repos == "@CRAN@"] <- cran
123
124
# add in renv.bootstrap.repos if set
125
default <- c(FALLBACK = "https://cloud.r-project.org")
126
extra <- getOption("renv.bootstrap.repos", default = default)
127
repos <- c(repos, extra)
128
129
# remove duplicates that might've snuck in
130
dupes <- duplicated(repos) | duplicated(names(repos))
131
repos[!dupes]
132
133
}
134
135
renv_bootstrap_repos_lockfile <- function() {
136
137
lockpath <- Sys.getenv("RENV_PATHS_LOCKFILE", unset = "renv.lock")
138
if (!file.exists(lockpath))
139
return(NULL)
140
141
lockfile <- tryCatch(renv_json_read(lockpath), error = identity)
142
if (inherits(lockfile, "error")) {
143
warning(lockfile)
144
return(NULL)
145
}
146
147
repos <- lockfile$R$Repositories
148
if (length(repos) == 0)
149
return(NULL)
150
151
keys <- vapply(repos, `[[`, "Name", FUN.VALUE = character(1))
152
vals <- vapply(repos, `[[`, "URL", FUN.VALUE = character(1))
153
names(vals) <- keys
154
155
return(vals)
156
157
}
158
159
renv_bootstrap_download <- function(version) {
160
161
# if the renv version number has 4 components, assume it must
162
# be retrieved via github
163
nv <- numeric_version(version)
164
components <- unclass(nv)[[1]]
165
166
# if this appears to be a development version of 'renv', we'll
167
# try to restore from github
168
dev <- length(components) == 4L
169
170
# begin collecting different methods for finding renv
171
methods <- c(
172
renv_bootstrap_download_tarball,
173
if (dev)
174
renv_bootstrap_download_github
175
else c(
176
renv_bootstrap_download_cran_latest,
177
renv_bootstrap_download_cran_archive
178
)
179
)
180
181
for (method in methods) {
182
path <- tryCatch(method(version), error = identity)
183
if (is.character(path) && file.exists(path))
184
return(path)
185
}
186
187
stop("failed to download renv ", version)
188
189
}
190
191
renv_bootstrap_download_impl <- function(url, destfile) {
192
193
mode <- "wb"
194
195
# https://bugs.r-project.org/bugzilla/show_bug.cgi?id=17715
196
fixup <-
197
Sys.info()[["sysname"]] == "Windows" &&
198
substring(url, 1L, 5L) == "file:"
199
200
if (fixup)
201
mode <- "w+b"
202
203
args <- list(
204
url = url,
205
destfile = destfile,
206
mode = mode,
207
quiet = TRUE
208
)
209
210
if ("headers" %in% names(formals(utils::download.file)))
211
args$headers <- renv_bootstrap_download_custom_headers(url)
212
213
do.call(utils::download.file, args)
214
215
}
216
217
renv_bootstrap_download_custom_headers <- function(url) {
218
219
headers <- getOption("renv.download.headers")
220
if (is.null(headers))
221
return(character())
222
223
if (!is.function(headers))
224
stopf("'renv.download.headers' is not a function")
225
226
headers <- headers(url)
227
if (length(headers) == 0L)
228
return(character())
229
230
if (is.list(headers))
231
headers <- unlist(headers, recursive = FALSE, use.names = TRUE)
232
233
ok <-
234
is.character(headers) &&
235
is.character(names(headers)) &&
236
all(nzchar(names(headers)))
237
238
if (!ok)
239
stop("invocation of 'renv.download.headers' did not return a named character vector")
240
241
headers
242
243
}
244
245
renv_bootstrap_download_cran_latest <- function(version) {
246
247
spec <- renv_bootstrap_download_cran_latest_find(version)
248
type <- spec$type
249
repos <- spec$repos
250
251
message("* Downloading renv ", version, " ... ", appendLF = FALSE)
252
253
baseurl <- utils::contrib.url(repos = repos, type = type)
254
ext <- if (identical(type, "source"))
255
".tar.gz"
256
else if (Sys.info()[["sysname"]] == "Windows")
257
".zip"
258
else
259
".tgz"
260
name <- sprintf("renv_%s%s", version, ext)
261
url <- paste(baseurl, name, sep = "/")
262
263
destfile <- file.path(tempdir(), name)
264
status <- tryCatch(
265
renv_bootstrap_download_impl(url, destfile),
266
condition = identity
267
)
268
269
if (inherits(status, "condition")) {
270
message("FAILED")
271
return(FALSE)
272
}
273
274
# report success and return
275
message("OK (downloaded ", type, ")")
276
destfile
277
278
}
279
280
renv_bootstrap_download_cran_latest_find <- function(version) {
281
282
# check whether binaries are supported on this system
283
binary <-
284
getOption("renv.bootstrap.binary", default = TRUE) &&
285
!identical(.Platform$pkgType, "source") &&
286
!identical(getOption("pkgType"), "source") &&
287
Sys.info()[["sysname"]] %in% c("Darwin", "Windows")
288
289
types <- c(if (binary) "binary", "source")
290
291
# iterate over types + repositories
292
for (type in types) {
293
for (repos in renv_bootstrap_repos()) {
294
295
# retrieve package database
296
db <- tryCatch(
297
as.data.frame(
298
utils::available.packages(type = type, repos = repos),
299
stringsAsFactors = FALSE
300
),
301
error = identity
302
)
303
304
if (inherits(db, "error"))
305
next
306
307
# check for compatible entry
308
entry <- db[db$Package %in% "renv" & db$Version %in% version, ]
309
if (nrow(entry) == 0)
310
next
311
312
# found it; return spec to caller
313
spec <- list(entry = entry, type = type, repos = repos)
314
return(spec)
315
316
}
317
}
318
319
# if we got here, we failed to find renv
320
fmt <- "renv %s is not available from your declared package repositories"
321
stop(sprintf(fmt, version))
322
323
}
324
325
renv_bootstrap_download_cran_archive <- function(version) {
326
327
name <- sprintf("renv_%s.tar.gz", version)
328
repos <- renv_bootstrap_repos()
329
urls <- file.path(repos, "src/contrib/Archive/renv", name)
330
destfile <- file.path(tempdir(), name)
331
332
message("* Downloading renv ", version, " ... ", appendLF = FALSE)
333
334
for (url in urls) {
335
336
status <- tryCatch(
337
renv_bootstrap_download_impl(url, destfile),
338
condition = identity
339
)
340
341
if (identical(status, 0L)) {
342
message("OK")
343
return(destfile)
344
}
345
346
}
347
348
message("FAILED")
349
return(FALSE)
350
351
}
352
353
renv_bootstrap_download_tarball <- function(version) {
354
355
# if the user has provided the path to a tarball via
356
# an environment variable, then use it
357
tarball <- Sys.getenv("RENV_BOOTSTRAP_TARBALL", unset = NA)
358
if (is.na(tarball))
359
return()
360
361
# allow directories
362
if (dir.exists(tarball)) {
363
name <- sprintf("renv_%s.tar.gz", version)
364
tarball <- file.path(tarball, name)
365
}
366
367
# bail if it doesn't exist
368
if (!file.exists(tarball)) {
369
370
# let the user know we weren't able to honour their request
371
fmt <- "* RENV_BOOTSTRAP_TARBALL is set (%s) but does not exist."
372
msg <- sprintf(fmt, tarball)
373
warning(msg)
374
375
# bail
376
return()
377
378
}
379
380
fmt <- "* Bootstrapping with tarball at path '%s'."
381
msg <- sprintf(fmt, tarball)
382
message(msg)
383
384
tarball
385
386
}
387
388
renv_bootstrap_download_github <- function(version) {
389
390
enabled <- Sys.getenv("RENV_BOOTSTRAP_FROM_GITHUB", unset = "TRUE")
391
if (!identical(enabled, "TRUE"))
392
return(FALSE)
393
394
# prepare download options
395
pat <- Sys.getenv("GITHUB_PAT")
396
if (nzchar(Sys.which("curl")) && nzchar(pat)) {
397
fmt <- "--location --fail --header \"Authorization: token %s\""
398
extra <- sprintf(fmt, pat)
399
saved <- options("download.file.method", "download.file.extra")
400
options(download.file.method = "curl", download.file.extra = extra)
401
on.exit(do.call(base::options, saved), add = TRUE)
402
} else if (nzchar(Sys.which("wget")) && nzchar(pat)) {
403
fmt <- "--header=\"Authorization: token %s\""
404
extra <- sprintf(fmt, pat)
405
saved <- options("download.file.method", "download.file.extra")
406
options(download.file.method = "wget", download.file.extra = extra)
407
on.exit(do.call(base::options, saved), add = TRUE)
408
}
409
410
message("* Downloading renv ", version, " from GitHub ... ", appendLF = FALSE)
411
412
url <- file.path("https://api.github.com/repos/rstudio/renv/tarball", version)
413
name <- sprintf("renv_%s.tar.gz", version)
414
destfile <- file.path(tempdir(), name)
415
416
status <- tryCatch(
417
renv_bootstrap_download_impl(url, destfile),
418
condition = identity
419
)
420
421
if (!identical(status, 0L)) {
422
message("FAILED")
423
return(FALSE)
424
}
425
426
message("OK")
427
return(destfile)
428
429
}
430
431
renv_bootstrap_install <- function(version, tarball, library) {
432
433
# attempt to install it into project library
434
message("* Installing renv ", version, " ... ", appendLF = FALSE)
435
dir.create(library, showWarnings = FALSE, recursive = TRUE)
436
437
# invoke using system2 so we can capture and report output
438
bin <- R.home("bin")
439
exe <- if (Sys.info()[["sysname"]] == "Windows") "R.exe" else "R"
440
r <- file.path(bin, exe)
441
442
args <- c(
443
"--vanilla", "CMD", "INSTALL", "--no-multiarch",
444
"-l", shQuote(path.expand(library)),
445
shQuote(path.expand(tarball))
446
)
447
448
output <- system2(r, args, stdout = TRUE, stderr = TRUE)
449
message("Done!")
450
451
# check for successful install
452
status <- attr(output, "status")
453
if (is.numeric(status) && !identical(status, 0L)) {
454
header <- "Error installing renv:"
455
lines <- paste(rep.int("=", nchar(header)), collapse = "")
456
text <- c(header, lines, output)
457
writeLines(text, con = stderr())
458
}
459
460
status
461
462
}
463
464
renv_bootstrap_platform_prefix <- function() {
465
466
# construct version prefix
467
version <- paste(R.version$major, R.version$minor, sep = ".")
468
prefix <- paste("R", numeric_version(version)[1, 1:2], sep = "-")
469
470
# include SVN revision for development versions of R
471
# (to avoid sharing platform-specific artefacts with released versions of R)
472
devel <-
473
identical(R.version[["status"]], "Under development (unstable)") ||
474
identical(R.version[["nickname"]], "Unsuffered Consequences")
475
476
if (devel)
477
prefix <- paste(prefix, R.version[["svn rev"]], sep = "-r")
478
479
# build list of path components
480
components <- c(prefix, R.version$platform)
481
482
# include prefix if provided by user
483
prefix <- renv_bootstrap_platform_prefix_impl()
484
if (!is.na(prefix) && nzchar(prefix))
485
components <- c(prefix, components)
486
487
# build prefix
488
paste(components, collapse = "/")
489
490
}
491
492
renv_bootstrap_platform_prefix_impl <- function() {
493
494
# if an explicit prefix has been supplied, use it
495
prefix <- Sys.getenv("RENV_PATHS_PREFIX", unset = NA)
496
if (!is.na(prefix))
497
return(prefix)
498
499
# if the user has requested an automatic prefix, generate it
500
auto <- Sys.getenv("RENV_PATHS_PREFIX_AUTO", unset = NA)
501
if (auto %in% c("TRUE", "True", "true", "1"))
502
return(renv_bootstrap_platform_prefix_auto())
503
504
# empty string on failure
505
""
506
507
}
508
509
renv_bootstrap_platform_prefix_auto <- function() {
510
511
prefix <- tryCatch(renv_bootstrap_platform_os(), error = identity)
512
if (inherits(prefix, "error") || prefix %in% "unknown") {
513
514
msg <- paste(
515
"failed to infer current operating system",
516
"please file a bug report at https://github.com/rstudio/renv/issues",
517
sep = "; "
518
)
519
520
warning(msg)
521
522
}
523
524
prefix
525
526
}
527
528
renv_bootstrap_platform_os <- function() {
529
530
sysinfo <- Sys.info()
531
sysname <- sysinfo[["sysname"]]
532
533
# handle Windows + macOS up front
534
if (sysname == "Windows")
535
return("windows")
536
else if (sysname == "Darwin")
537
return("macos")
538
539
# check for os-release files
540
for (file in c("/etc/os-release", "/usr/lib/os-release"))
541
if (file.exists(file))
542
return(renv_bootstrap_platform_os_via_os_release(file, sysinfo))
543
544
# check for redhat-release files
545
if (file.exists("/etc/redhat-release"))
546
return(renv_bootstrap_platform_os_via_redhat_release())
547
548
"unknown"
549
550
}
551
552
renv_bootstrap_platform_os_via_os_release <- function(file, sysinfo) {
553
554
# read /etc/os-release
555
release <- utils::read.table(
556
file = file,
557
sep = "=",
558
quote = c("\"", "'"),
559
col.names = c("Key", "Value"),
560
comment.char = "#",
561
stringsAsFactors = FALSE
562
)
563
564
vars <- as.list(release$Value)
565
names(vars) <- release$Key
566
567
# get os name
568
os <- tolower(sysinfo[["sysname"]])
569
570
# read id
571
id <- "unknown"
572
for (field in c("ID", "ID_LIKE")) {
573
if (field %in% names(vars) && nzchar(vars[[field]])) {
574
id <- vars[[field]]
575
break
576
}
577
}
578
579
# read version
580
version <- "unknown"
581
for (field in c("UBUNTU_CODENAME", "VERSION_CODENAME", "VERSION_ID", "BUILD_ID")) {
582
if (field %in% names(vars) && nzchar(vars[[field]])) {
583
version <- vars[[field]]
584
break
585
}
586
}
587
588
# join together
589
paste(c(os, id, version), collapse = "-")
590
591
}
592
593
renv_bootstrap_platform_os_via_redhat_release <- function() {
594
595
# read /etc/redhat-release
596
contents <- readLines("/etc/redhat-release", warn = FALSE)
597
598
# infer id
599
id <- if (grepl("centos", contents, ignore.case = TRUE))
600
"centos"
601
else if (grepl("redhat", contents, ignore.case = TRUE))
602
"redhat"
603
else
604
"unknown"
605
606
# try to find a version component (very hacky)
607
version <- "unknown"
608
609
parts <- strsplit(contents, "[[:space:]]")[[1L]]
610
for (part in parts) {
611
612
nv <- tryCatch(numeric_version(part), error = identity)
613
if (inherits(nv, "error"))
614
next
615
616
version <- nv[1, 1]
617
break
618
619
}
620
621
paste(c("linux", id, version), collapse = "-")
622
623
}
624
625
renv_bootstrap_library_root_name <- function(project) {
626
627
# use project name as-is if requested
628
asis <- Sys.getenv("RENV_PATHS_LIBRARY_ROOT_ASIS", unset = "FALSE")
629
if (asis)
630
return(basename(project))
631
632
# otherwise, disambiguate based on project's path
633
id <- substring(renv_bootstrap_hash_text(project), 1L, 8L)
634
paste(basename(project), id, sep = "-")
635
636
}
637
638
renv_bootstrap_library_root <- function(project) {
639
640
prefix <- renv_bootstrap_profile_prefix()
641
642
path <- Sys.getenv("RENV_PATHS_LIBRARY", unset = NA)
643
if (!is.na(path))
644
return(paste(c(path, prefix), collapse = "/"))
645
646
path <- renv_bootstrap_library_root_impl(project)
647
if (!is.null(path)) {
648
name <- renv_bootstrap_library_root_name(project)
649
return(paste(c(path, prefix, name), collapse = "/"))
650
}
651
652
renv_bootstrap_paths_renv("library", project = project)
653
654
}
655
656
renv_bootstrap_library_root_impl <- function(project) {
657
658
root <- Sys.getenv("RENV_PATHS_LIBRARY_ROOT", unset = NA)
659
if (!is.na(root))
660
return(root)
661
662
type <- renv_bootstrap_project_type(project)
663
if (identical(type, "package")) {
664
userdir <- renv_bootstrap_user_dir()
665
return(file.path(userdir, "library"))
666
}
667
668
}
669
670
renv_bootstrap_validate_version <- function(version) {
671
672
loadedversion <- utils::packageDescription("renv", fields = "Version")
673
if (version == loadedversion)
674
return(TRUE)
675
676
# assume four-component versions are from GitHub;
677
# three-component versions are from CRAN
678
components <- strsplit(loadedversion, "[.-]")[[1]]
679
remote <- if (length(components) == 4L)
680
paste("rstudio/renv", loadedversion, sep = "@")
681
else
682
paste("renv", loadedversion, sep = "@")
683
684
fmt <- paste(
685
"renv %1$s was loaded from project library, but this project is configured to use renv %2$s.",
686
"Use `renv::record(\"%3$s\")` to record renv %1$s in the lockfile.",
687
"Use `renv::restore(packages = \"renv\")` to install renv %2$s into the project library.",
688
sep = "\n"
689
)
690
691
msg <- sprintf(fmt, loadedversion, version, remote)
692
warning(msg, call. = FALSE)
693
694
FALSE
695
696
}
697
698
renv_bootstrap_hash_text <- function(text) {
699
700
hashfile <- tempfile("renv-hash-")
701
on.exit(unlink(hashfile), add = TRUE)
702
703
writeLines(text, con = hashfile)
704
tools::md5sum(hashfile)
705
706
}
707
708
renv_bootstrap_load <- function(project, libpath, version) {
709
710
# try to load renv from the project library
711
if (!requireNamespace("renv", lib.loc = libpath, quietly = TRUE))
712
return(FALSE)
713
714
# warn if the version of renv loaded does not match
715
renv_bootstrap_validate_version(version)
716
717
# execute renv load hooks, if any
718
hooks <- getHook("renv::autoload")
719
for (hook in hooks)
720
if (is.function(hook))
721
tryCatch(hook(), error = warning)
722
723
# load the project
724
renv::load(project)
725
726
TRUE
727
728
}
729
730
renv_bootstrap_profile_load <- function(project) {
731
732
# if RENV_PROFILE is already set, just use that
733
profile <- Sys.getenv("RENV_PROFILE", unset = NA)
734
if (!is.na(profile) && nzchar(profile))
735
return(profile)
736
737
# check for a profile file (nothing to do if it doesn't exist)
738
path <- renv_bootstrap_paths_renv("profile", profile = FALSE, project = project)
739
if (!file.exists(path))
740
return(NULL)
741
742
# read the profile, and set it if it exists
743
contents <- readLines(path, warn = FALSE)
744
if (length(contents) == 0L)
745
return(NULL)
746
747
# set RENV_PROFILE
748
profile <- contents[[1L]]
749
if (!profile %in% c("", "default"))
750
Sys.setenv(RENV_PROFILE = profile)
751
752
profile
753
754
}
755
756
renv_bootstrap_profile_prefix <- function() {
757
profile <- renv_bootstrap_profile_get()
758
if (!is.null(profile))
759
return(file.path("profiles", profile, "renv"))
760
}
761
762
renv_bootstrap_profile_get <- function() {
763
profile <- Sys.getenv("RENV_PROFILE", unset = "")
764
renv_bootstrap_profile_normalize(profile)
765
}
766
767
renv_bootstrap_profile_set <- function(profile) {
768
profile <- renv_bootstrap_profile_normalize(profile)
769
if (is.null(profile))
770
Sys.unsetenv("RENV_PROFILE")
771
else
772
Sys.setenv(RENV_PROFILE = profile)
773
}
774
775
renv_bootstrap_profile_normalize <- function(profile) {
776
777
if (is.null(profile) || profile %in% c("", "default"))
778
return(NULL)
779
780
profile
781
782
}
783
784
renv_bootstrap_path_absolute <- function(path) {
785
786
substr(path, 1L, 1L) %in% c("~", "/", "\\") || (
787
substr(path, 1L, 1L) %in% c(letters, LETTERS) &&
788
substr(path, 2L, 3L) %in% c(":/", ":\\")
789
)
790
791
}
792
793
renv_bootstrap_paths_renv <- function(..., profile = TRUE, project = NULL) {
794
renv <- Sys.getenv("RENV_PATHS_RENV", unset = "renv")
795
root <- if (renv_bootstrap_path_absolute(renv)) NULL else project
796
prefix <- if (profile) renv_bootstrap_profile_prefix()
797
components <- c(root, renv, prefix, ...)
798
paste(components, collapse = "/")
799
}
800
801
renv_bootstrap_project_type <- function(path) {
802
803
descpath <- file.path(path, "DESCRIPTION")
804
if (!file.exists(descpath))
805
return("unknown")
806
807
desc <- tryCatch(
808
read.dcf(descpath, all = TRUE),
809
error = identity
810
)
811
812
if (inherits(desc, "error"))
813
return("unknown")
814
815
type <- desc$Type
816
if (!is.null(type))
817
return(tolower(type))
818
819
package <- desc$Package
820
if (!is.null(package))
821
return("package")
822
823
"unknown"
824
825
}
826
827
renv_bootstrap_user_dir <- function() {
828
dir <- renv_bootstrap_user_dir_impl()
829
path.expand(chartr("\\", "/", dir))
830
}
831
832
renv_bootstrap_user_dir_impl <- function() {
833
834
# use local override if set
835
override <- getOption("renv.userdir.override")
836
if (!is.null(override))
837
return(override)
838
839
# use R_user_dir if available
840
tools <- asNamespace("tools")
841
if (is.function(tools$R_user_dir))
842
return(tools$R_user_dir("renv", "cache"))
843
844
# try using our own backfill for older versions of R
845
envvars <- c("R_USER_CACHE_DIR", "XDG_CACHE_HOME")
846
for (envvar in envvars) {
847
root <- Sys.getenv(envvar, unset = NA)
848
if (!is.na(root))
849
return(file.path(root, "R/renv"))
850
}
851
852
# use platform-specific default fallbacks
853
if (Sys.info()[["sysname"]] == "Windows")
854
file.path(Sys.getenv("LOCALAPPDATA"), "R/cache/R/renv")
855
else if (Sys.info()[["sysname"]] == "Darwin")
856
"~/Library/Caches/org.R-project.R/R/renv"
857
else
858
"~/.cache/R/renv"
859
860
}
861
862
863
renv_json_read <- function(file = NULL, text = NULL) {
864
865
jlerr <- NULL
866
867
# if jsonlite is loaded, use that instead
868
if ("jsonlite" %in% loadedNamespaces()) {
869
870
json <- catch(renv_json_read_jsonlite(file, text))
871
if (!inherits(json, "error"))
872
return(json)
873
874
jlerr <- json
875
876
}
877
878
# otherwise, fall back to the default JSON reader
879
json <- catch(renv_json_read_default(file, text))
880
if (!inherits(json, "error"))
881
return(json)
882
883
# report an error
884
if (!is.null(jlerr))
885
stop(jlerr)
886
else
887
stop(json)
888
889
}
890
891
renv_json_read_jsonlite <- function(file = NULL, text = NULL) {
892
text <- paste(text %||% read(file), collapse = "\n")
893
jsonlite::fromJSON(txt = text, simplifyVector = FALSE)
894
}
895
896
renv_json_read_default <- function(file = NULL, text = NULL) {
897
898
# find strings in the JSON
899
text <- paste(text %||% read(file), collapse = "\n")
900
pattern <- '["](?:(?:\\\\.)|(?:[^"\\\\]))*?["]'
901
locs <- gregexpr(pattern, text, perl = TRUE)[[1]]
902
903
# if any are found, replace them with placeholders
904
replaced <- text
905
strings <- character()
906
replacements <- character()
907
908
if (!identical(c(locs), -1L)) {
909
910
# get the string values
911
starts <- locs
912
ends <- locs + attr(locs, "match.length") - 1L
913
strings <- substring(text, starts, ends)
914
915
# only keep those requiring escaping
916
strings <- grep("[[\\]{}:]", strings, perl = TRUE, value = TRUE)
917
918
# compute replacements
919
replacements <- sprintf('"\032%i\032"', seq_along(strings))
920
921
# replace the strings
922
mapply(function(string, replacement) {
923
replaced <<- sub(string, replacement, replaced, fixed = TRUE)
924
}, strings, replacements)
925
926
}
927
928
# transform the JSON into something the R parser understands
929
transformed <- replaced
930
transformed <- gsub("{}", "`names<-`(list(), character())", transformed, fixed = TRUE)
931
transformed <- gsub("[[{]", "list(", transformed, perl = TRUE)
932
transformed <- gsub("[]}]", ")", transformed, perl = TRUE)
933
transformed <- gsub(":", "=", transformed, fixed = TRUE)
934
text <- paste(transformed, collapse = "\n")
935
936
# parse it
937
json <- parse(text = text, keep.source = FALSE, srcfile = NULL)[[1L]]
938
939
# construct map between source strings, replaced strings
940
map <- as.character(parse(text = strings))
941
names(map) <- as.character(parse(text = replacements))
942
943
# convert to list
944
map <- as.list(map)
945
946
# remap strings in object
947
remapped <- renv_json_remap(json, map)
948
949
# evaluate
950
eval(remapped, envir = baseenv())
951
952
}
953
954
renv_json_remap <- function(json, map) {
955
956
# fix names
957
if (!is.null(names(json))) {
958
lhs <- match(names(json), names(map), nomatch = 0L)
959
rhs <- match(names(map), names(json), nomatch = 0L)
960
names(json)[rhs] <- map[lhs]
961
}
962
963
# fix values
964
if (is.character(json))
965
return(map[[json]] %||% json)
966
967
# handle true, false, null
968
if (is.name(json)) {
969
text <- as.character(json)
970
if (text == "true")
971
return(TRUE)
972
else if (text == "false")
973
return(FALSE)
974
else if (text == "null")
975
return(NULL)
976
}
977
978
# recurse
979
if (is.recursive(json)) {
980
for (i in seq_along(json)) {
981
json[i] <- list(renv_json_remap(json[[i]], map))
982
}
983
}
984
985
json
986
987
}
988
989
# load the renv profile, if any
990
renv_bootstrap_profile_load(project)
991
992
# construct path to library root
993
root <- renv_bootstrap_library_root(project)
994
995
# construct library prefix for platform
996
prefix <- renv_bootstrap_platform_prefix()
997
998
# construct full libpath
999
libpath <- file.path(root, prefix)
1000
1001
# attempt to load
1002
if (renv_bootstrap_load(project, libpath, version))
1003
return(TRUE)
1004
1005
# load failed; inform user we're about to bootstrap
1006
prefix <- paste("# Bootstrapping renv", version)
1007
postfix <- paste(rep.int("-", 77L - nchar(prefix)), collapse = "")
1008
header <- paste(prefix, postfix)
1009
message(header)
1010
1011
# perform bootstrap
1012
bootstrap(version, libpath)
1013
1014
# exit early if we're just testing bootstrap
1015
if (!is.na(Sys.getenv("RENV_BOOTSTRAP_INSTALL_ONLY", unset = NA)))
1016
return(TRUE)
1017
1018
# try again to load
1019
if (requireNamespace("renv", lib.loc = libpath, quietly = TRUE)) {
1020
message("* Successfully installed and loaded renv ", version, ".")
1021
return(renv::load())
1022
}
1023
1024
# failed to download or load renv; warn the user
1025
msg <- c(
1026
"Failed to find an renv installation: the project will not be loaded.",
1027
"Use `renv::activate()` to re-initialize the project."
1028
)
1029
1030
warning(paste(msg, collapse = "\n"), call. = FALSE)
1031
1032
})
1033
1034