64 lines
1.9 KiB
R
64 lines
1.9 KiB
R
# Requires utils.R
|
|
|
|
.process_dist_archive <- function(dist_fn, fn) {
|
|
old_opt <- options(stringsAsFactors = FALSE)
|
|
on.exit(options(old_opt))
|
|
|
|
dist_con <- gzfile(dist_fn, "rb")
|
|
on.exit(close(dist_con), add = TRUE)
|
|
archive <- readRDS(dist_con)
|
|
archive <- lapply(archive, function(pkg) {
|
|
packageVersions <- gsub("^([^/]+)/[^_]+_(.+).tar.gz", "\\1%%\\2", rownames(pkg))
|
|
packageVersions <- strsplit(packageVersions, "%%")
|
|
packageVersions <- do.call(rbind, packageVersions)
|
|
if (is.null(packageVersions)) {
|
|
return(NULL)
|
|
}
|
|
pkg[,c("package","version")] <- packageVersions
|
|
sortOrder <- sort(pkg$version, index.return = TRUE)$ix
|
|
pkg[sortOrder,c("package", "version")]
|
|
})
|
|
archive <- do.call(rbind, archive)
|
|
rownames(archive) <- 1:nrow(archive)
|
|
write_con <- gzfile(fn, "wb")
|
|
saveRDS(archive, write_con)
|
|
close(write_con)
|
|
}
|
|
|
|
.fetch_available_archives <- function(refetch) {
|
|
check_pacman_dir()
|
|
fn <- ".pacman/archive.rds"
|
|
dist_fn <- ".pacman/archive_dist.rds"
|
|
if (file.exists(dist_fn)) {
|
|
ts <- as.POSIXct("1970-01-01 00:00:00", tz = "GMT") + as.numeric(Sys.Date()) * 86400
|
|
if (refetch || (ts > file.mtime(dist_fn))) {
|
|
unlink(dist_fn)
|
|
unlink(fn)
|
|
}
|
|
}
|
|
if (!file.exists(dist_fn)) {
|
|
utils::download.file(sprintf("%s/src/contrib/Meta/archive.rds", get_cran_repo()), dist_fn)
|
|
.process_dist_archive(dist_fn, fn)
|
|
}
|
|
con <- gzfile(fn, "rb")
|
|
on.exit(close(con), add = TRUE)
|
|
archive <- readRDS(con)
|
|
return(archive)
|
|
}
|
|
|
|
#' Fetch the current (or check the cache) list of packages archives available
|
|
#' for install from the CRAN repositories.
|
|
#'
|
|
#' @param refetch Boolean indicating if the local cache should be invalidated.
|
|
#'
|
|
#' @return A data frame of available package archives and their versions
|
|
#' @export
|
|
fetch_available_archives <- function(refetch = FALSE) {
|
|
tryCatch(
|
|
{
|
|
.fetch_available_archives(refetch)
|
|
},
|
|
warning = function(e) list(),
|
|
error = function(e) list()
|
|
)
|
|
} |