Nothing
#' package NAMESPACE file
#' @description CRAN package NAMESPACE file taken locally or remotely from GITHUB CRAN mirror or CRAN website.
#' By default works for the newest package version.
#' @inheritParams standard_args
#' @param repos `character` vector repositories URLs to use. Used only for the validation. Default `https://cran.rstudio.com/`
#' @return `list` with names proper for NAMESPACE file, the same as format as returned by `base::parseNamespaceFile`.
#' @note Results are cached for 30 minutes with `memoise` package.
#' This function is mainly built under source code from `base::parseNamespaceFile`.
#' @export
#' @examples
#' \dontrun{
#' pacs::pac_namespace("dplyr", version = "0.8.0")
#' pacs::pac_namespace("dplyr", at = as.Date("2019-02-01"))
#' pacs::pac_namespace("memoise", local = TRUE)
#' }
pac_namespace <- function(pac, version = NULL, at = NULL, local = FALSE, lib.loc = .libPaths(), repos = "https://cran.rstudio.com/") {
stopifnot((isFALSE(local)) ||
(isTRUE(local) && (is.null(version) || isTRUE(utils::packageDescription(pac, lib.loc = lib.loc)$Version == version))))
stopifnot(all(c(is.null(version), is.null(at))) || xor(!is.null(version), !is.null(at)))
stopifnot(is.null(at) || inherits(at, "Date"))
stopifnot(length(pac) == 1 && is.character(pac))
stopifnot(is.null(lib.loc) || (all(lib.loc %in% .libPaths()) && (length(list.files(lib.loc)) > 0)))
stopifnot(is.null(version) || (length(version) == 1 && is.character(version)))
is_installed <- isTRUE(pac %in% rownames(installed_packages(lib.loc = lib.loc)))
if ((!is_installed && local) || (!local && !is_online())) {
return(NA)
}
version_installed <- if (is_installed) {
pac_description(pac, local = TRUE)$Version
} else {
NA
}
version_null <- is.null(version)
if (local && is_installed && is.null(at) && (version_null || isTRUE(utils::compareVersion(version, version_installed) == 0))) {
namespace_lines <- readLines(system.file(package = pac, "NAMESPACE"), warn = FALSE)
desc <- pac_description(pac, local = TRUE)
} else if (isTRUE(is_isin(pac, "https://cran.rstudio.com/"))) {
version <- if (!version_null) {
version
} else if (!is.null(at)) {
res <- pac_timemachine(pac, at = at)
if (isNA(res) || is.null(res)) {
return(NA)
} else {
utils::tail(res$Version, 1)
}
} else {
pac_last(pac, repos = repos)
}
namespace_lines <- pac_readnamespace(pac, version, repos)
desc <- pac_description(pac, version = version)
if (isTRUE(is.na(namespace_lines))) {
return(NA)
}
if (length(namespace_lines) == 0) {
return(NA)
}
} else {
return(NA)
}
enc <- desc$Encoding
if (is.null(enc) || isFALSE(enc %in% c("UTF-8", "latin1", "latin2"))) enc <- "UTF-8"
result <- pac_parse_namespace(namespace_lines, enc)
structure(result, package = pac, version = version)
}
pac_readnamespace_raw <- function(pac, version, repos = "https://cran.rstudio.com/") {
ee <- tempfile()
d_url <- sprintf(
"https://raw.githubusercontent.com/cran/%s/%s/NAMESPACE",
pac,
version
)
tt <- try(
{
suppressWarnings(utils::download.file(d_url,
destfile = ee,
quiet = TRUE
))
},
silent = TRUE
)
if (inherits(tt, "try-error")) {
result <- cran_archive_file(pac, version, repos, "NAMESPACE")
} else {
result <- readLines(ee, warn = FALSE)
unlink(ee)
}
structure(result, package = pac, version = version)
}
pac_readnamespace <- memoise::memoise(pac_readnamespace_raw, cache = cachem::cache_mem(max_age = 30 * 60))
pac_parse_namespace <- function(lines, enc) {
directives <- if (!is.na(enc) && !Sys.getlocale("LC_CTYPE") %in%
c("C", "POSIX")) {
tmp <- iconv(lines, from = enc, to = "")
bad <- which(is.na(tmp))
comm <- grep("^[[:space:]]*#", lines[bad],
invert = TRUE,
useBytes = TRUE
)
if (length(bad[comm])) {
stop("unable to re-encode some lines in NAMESPACE file")
}
tmp <- iconv(lines, from = enc, to = "", sub = "byte")
con <- textConnection(tmp)
on.exit(close(con))
parse(con, keep.source = FALSE, srcfile = NULL)
}
exports <- character()
exportPatterns <- character()
exportClasses <- character()
exportClassPatterns <- character()
exportMethods <- character()
imports <- list()
importMethods <- list()
importClasses <- list()
dynlibs <- character()
nS3methods <- 1000L
S3methods <- matrix(NA_character_, nS3methods, 4L)
nS3 <- 0L
parseDirective <- function(e) {
asChar <- function(cc) {
r <- as.character(cc)
if (any(r == "")) {
stop(gettextf(
"empty name in directive '%s' in 'NAMESPACE' file",
as.character(e[[1L]])
), domain = NA)
}
r
}
evalToChar <- function(cc) {
vars <- all.vars(cc)
names(vars) <- vars
as.character(eval(
eval(call("substitute", cc, as.list(vars))),
.GlobalEnv
))
}
switch(as.character(e[[1L]]),
`if` = if (eval(
e[[2L]],
.GlobalEnv
)) {
parseDirective(e[[3L]])
} else if (length(e) ==
4L) {
parseDirective(e[[4L]])
},
`{` = for (ee in as.list(e[-1L])) parseDirective(ee),
`=` = ,
`<-` = {
parseDirective(e[[3L]])
if (as.character(e[[3L]][[1L]]) == "useDynLib") names(dynlibs)[length(dynlibs)] <<- asChar(e[[2L]])
},
export = {
exp <- e[-1L]
exp <- structure(asChar(exp), names = names(exp))
exports <<- c(exports, exp)
},
exportPattern = {
pat <- asChar(e[-1L])
exportPatterns <<- c(pat, exportPatterns)
},
exportClassPattern = {
pat <- asChar(e[-1L])
exportClassPatterns <<- c(pat, exportClassPatterns)
},
exportClass = ,
exportClasses = {
exportClasses <<- c(asChar(e[-1L]), exportClasses)
},
exportMethods = {
exportMethods <<- c(asChar(e[-1L]), exportMethods)
},
import = {
except <- e$except
e$except <- NULL
pkgs <- as.list(asChar(e[-1L]))
if (!is.null(except)) {
pkgs <- lapply(pkgs, list, except = evalToChar(except))
}
imports <<- c(imports, pkgs)
},
importFrom = {
imp <- e[-1L]
ivars <- imp[-1L]
inames <- names(ivars)
imp <- list(asChar(imp[1L]), structure(asChar(ivars),
names = inames
))
imports <<- c(imports, list(imp))
},
importClassFrom = ,
importClassesFrom = {
imp <- asChar(e[-1L])
pkg <- imp[[1L]]
impClasses <- imp[-1L]
imp <- list(asChar(pkg), asChar(impClasses))
importClasses <<- c(importClasses, list(imp))
},
importMethodsFrom = {
imp <- asChar(e[-1L])
pkg <- imp[[1L]]
impMethods <- imp[-1L]
imp <- list(asChar(pkg), asChar(impMethods))
importMethods <<- c(importMethods, list(imp))
},
useDynLib = {
dyl <- as.character(e[2L])
dynlibs <<- structure(c(dynlibs, dyl), names = c(
names(dynlibs),
ifelse(!is.null(names(e)) && nzchar(names(e)[2L]),
names(e)[2L], ""
)
))
if (length(e) > 2L) {
symNames <- as.character(e[-c(1L, 2L)])
names(symNames) <- names(e[-c(1, 2)])
if (length(names(symNames)) == 0L) {
names(symNames) <- symNames
} else if (any(w <- names(symNames) ==
"")) {
names(symNames)[w] <- symNames[w]
}
dup <- duplicated(names(symNames))
if (any(dup)) {
warning(gettextf(
"duplicate symbol names %s in useDynLib(\"%s\")",
paste(sQuote(names(symNames)[dup]), collapse = ", "),
dyl
), domain = NA, call. = FALSE)
}
symNames <- symNames[!dup]
fixes <- c("", "")
idx <- match(".fixes", names(symNames))
if (!is.na(idx)) {
if (nzchar(symNames[idx])) {
e <- parse(
text = symNames[idx], keep.source = FALSE,
srcfile = NULL
)[[1L]]
if (is.call(e)) val <- eval(e, .GlobalEnv) else val <- as.character(e)
if (length(val)) fixes[seq_along(val)] <- val
}
symNames <- symNames[-idx]
}
useRegistration <- FALSE
idx <- match(".registration", names(symNames))
if (!is.na(idx)) {
useRegistration <- as.logical(symNames[idx])
symNames <- symNames[-idx]
}
}
},
S3method = {
spec <- e[-1L]
if (length(spec) != 2L && length(spec) != 3L) {
stop(gettextf(
"bad 'S3method' directive: %s",
deparse(e)
), call. = FALSE, domain = NA)
}
nS3 <<- nS3 + 1L
if (nS3 > nS3methods) {
old <- S3methods
nold <- nS3methods
nS3methods <<- nS3methods * 2L
new <- matrix(NA_character_, nS3methods, 4L)
ind <- seq_len(nold)
for (i in 1:4) new[ind, i] <- old[ind, i]
S3methods <<- new
rm(old, new)
}
if (is.call(gen <- spec[[1L]]) && identical(
as.character(gen[[1L]]),
"::"
)) {
pkg <- as.character(gen[[2L]])[1L]
gen <- as.character(gen[[3L]])[1L]
S3methods[nS3, c(seq_along(spec), 4L)] <<- c(
gen,
asChar(spec[-1L]), pkg
)
} else {
S3methods[nS3, seq_along(spec)] <<- asChar(spec)
}
},
stop(gettextf(
"unknown namespace directive: %s",
deparse(e, nlines = 1L)
), call. = FALSE, domain = NA)
)
}
for (e in directives) parseDirective(e)
dynlibs <- dynlibs[!duplicated(dynlibs)]
list(
imports = imports, exports = exports, exportPatterns = unique(exportPatterns),
importClasses = importClasses, importMethods = importMethods,
exportClasses = unique(exportClasses), exportMethods = unique(exportMethods),
exportClassPatterns = unique(exportClassPatterns), dynlibs = dynlibs, S3methods = unique(S3methods[seq_len(nS3), ,
drop = FALSE
])
)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.