##' Collect information on package sources
##' @title Collect information on package sources
##'
##' @param cran A single URL for the CRAN repo to use. If
##' \code{NULL}, then this will use the rstudio mirror.
##'
##' @param repos A character vector of additional repositories to use.
##' Repositories of the form \code{drat://username} will be
##' translated to a drat repository hosted on github (e.g.,
##' \code{https://username.github.io/drat})
##'
##' @param github A vector of github package specifications (e.g.,
##' username/password). The full syntax as implemented in
##' \code{\link{parse_github_repo_spec}} is supported (packages in
##' subdirectories, or referencing a particular branch, commit or
##' tag).
##'
##' @param local A character vector of local files to include. Can be
##' directories or built packages (source or binary)
##'
##' @param expire Optional period, in days, to expire the local copy
##' of the package. If specified, then if a package was downloaded
##' more than\code{expire} days ago when the local copy is checked,
##' a new version will be downloaded. Can be a fractional value
##' (e.g., \code{expire = 0.04} for an expiry of around an hour).
##'
##' @param local_drat Optional location to cache downloaded packages,
##' when \code{github} or \code{local} packages are used. If not
##' given, this can be set at any time by setting the
##' \code{local_drat} element of the returned element. If not given
##' by the time that the packages need to be downloaded then a
##' session-specific temporary directory will be used.
##'
##' @param data An object of class \code{package_sources_list},
##' created by running the \code{as_list()} method of a
##' \code{package_sources} object. This is useful for serialisation
##' without saving references to \code{provisionr}.
##'
##' @param spec Raw entries of the form \code{<type>::<user>/<repo>...}
##'
##' @export
package_sources <- function(cran = NULL, repos = NULL,
github = NULL, local = NULL,
expire = NULL, local_drat = NULL,
data = NULL, spec = NULL) {
R6_package_sources$new(cran, repos, github, local, expire, local_drat,
data, spec)
}
##' @importFrom R6 R6Class
R6_package_sources <- R6::R6Class(
"package_sources",
public = list(
cran = NULL,
repos = NULL,
spec = NULL,
local_drat = NULL,
expire = NULL,
initialize = function(cran, repos, github, local, expire, local_drat,
data = NULL, spec = NULL) {
if (!is.null(data)) {
assert_is(data, "package_sources_list")
## Could require that none of these other arguments are non-NULL
self$cran <- data$cran
self$repos <- data$repos
self$spec <- data$spec
self$expire <- data$expire
self$local_drat <- data$local_drat
return()
}
if (is.null(cran)) {
cran <- sanitise_options_cran()
} else {
## No reason why this can't be a vector, though it does get a bit
## overlappy with repos
assert_character(cran)
if (length(cran) == 0) {
stop("At least one cran repository must be given")
}
}
self$cran <- cran
if (!is.null(repos)) {
assert_character(repos)
names(repos) <- repos
is_drat <- grepl("^drat://", repos)
repos[is_drat] <- sprintf("https://%s.github.io/drat/",
sub("^drat://", "", repos[is_drat]))
if (!all(grepl("^[a-z]+://", repos))) {
stop("Missing url scheme")
}
self$repos <- repos
}
## Collect all the spec information here into a single vector, I
## think; that'll be easier to modify.
if (!is.null(spec)) {
i <- grepl("^repo::", spec)
if (any(i)) {
tmp <- sub("^repo::", "", spec[i])
err <- tmp[!grepl("(https?|file)://", tmp)]
if (length(err) > 0L) {
stop("Invalid repo spec ", paste(err, collapse = ", "))
}
self$repos <- c(self$repos, tmp)
spec <- spec[!i]
}
spec <- vcapply(spec, function(s) parse_remote(s)$spec,
USE.NAMES = FALSE)
}
if (!is.null(github)) {
tmp <- lapply(github, parse_remote)
err <- vcapply(tmp, "[[", "type") != "github"
if (any(err)) {
stop("Non-github spec ", paste(github[err], collapse = ", "))
}
spec <- c(spec, vcapply(tmp, "[[", "spec"))
}
if (!is.null(local)) {
if (!all(file.exists(local))) {
stop("Missing local files: ",
paste(local[!file.exists(local)], collapse = ", "))
}
spec <- c(spec, paste0("local::", local))
}
self$spec <- spec
if (!is.null(expire)) {
assert_scalar_numeric(expire)
if (expire <= 0) {
stop("'expire' must be positive")
}
self$expire <- expire
}
if (!is.null(local_drat)) {
assert_scalar_character(local_drat)
self$local_drat <- local_drat
}
},
as_list = function() {
ret <- list(cran = self$cran,
repos = self$repos,
spec = self$spec,
local_drat = self$local_drat,
expire = self$expire)
class(ret) <- "package_sources_list"
ret
},
needs_build = function() {
path <- self$local_drat
rebuild <- length(self$spec) > 0 &&
(is.null(path) || !file.exists(path) ||
!all(drat_storr(path)$exists(self$spec)))
if (!rebuild && !is.null(self$expire)) {
db <- drat_storr(path)
v <- db$mget(db$list())
t_old <- Sys.time() - self$expire * 24 * 60 * 60
rebuild <- any(vlapply(v, function(el) el$timestamp < t_old))
}
rebuild
},
build = function(refresh = FALSE, force = FALSE, progress = NULL) {
if (length(self$spec) > 0L) {
if (is.null(self$local_drat)) {
## TODO: this may not always be desirable, because if this
## ends up serialised, it will point to a directory that has
## disappeared after the session disappears. I think that
## use of clone() should get around this enough.
self$local_drat <- tempfile()
}
path <- self$local_drat
if (refresh || self$needs_build()) {
drat_build(self$spec, path, force, progress)
}
}
invisible(self)
}
))
prepare_package_sources <- function(src, refresh = FALSE, progress = NULL) {
if (inherits(src, "package_sources")) {
src$build(refresh, progress = progress)
} else if (!is.null(src)) {
stop("Invalid input for src")
}
src
}
##' @export
print.package_sources <- function(x, ...) {
cat(paste(as.character(x), collapse = "\n"), "\n")
invisible(x)
}
##' @export
as.character.package_sources <- function(x, ...) {
f <- function(nm, list) {
c(sprintf(" %s:", nm),
sprintf(" - %s", list[[nm]]))
}
str <- c("<package_sources>",
sprintf(" cran: %s", x$cran),
if (length(x$repos) > 0L) f("repos", x))
if (length(x$spec) > 0L) {
x_spec <- split_spec(x$spec)
x_spec <- split(x_spec[, "value"], x_spec[, "type"])
str <- c(str,
unlist(lapply(names(x_spec), f, x_spec), use.names = FALSE))
}
if (!is.null(x$local_drat)) {
db <- drat_storr(x$local_drat)
k <- db$list()
v <- db$mget(k)
dat <- data.frame(name = vcapply(v, "[[", "Package"),
version = vcapply(v, "[[", "Version"),
updated = vcapply(v, function(el)
prettyunits::time_ago(el$timestamp)),
stringsAsFactors = FALSE)
str <- c(str,
" drat:",
sprintf(" path: %s", x$local_drat),
" contents:",
paste(" ", capture.output(print(dat, row.names = FALSE))))
if (!is.null(x$expire) && length(v) > 0L) {
expire <- lapply(v, function(el) el$timestamp + x$expire * 24 * 60 * 60)
dt <- expire[[which.max(unlist(expire))]] - Sys.time()
expire_str <-
prettyunits::pretty_dt(as.difftime(x$expire, units = "days"))
if (dt > 0) {
str <- c(str,
sprintf(" expires: %s (valid for %s)",
prettyunits::pretty_dt(dt), expire_str))
} else {
str <- c(str,
sprintf(" expired: %s (valid for %s)",
prettyunits::vague_dt(- dt), expire_str))
}
}
} else if (length(x$spec) > 0L) {
str <- c(str, " drat: <pending build>")
}
str
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.