# helper functions for testing
hostname <- function(x) {
y <- sub("https*://", "", x)
sub("latest$", "", y)
}
# Interrupt the test if url can not be reached
skip_if_offline <- function(url = p3m()) {
# browser()
mran_host <- hostname(p3m())
if (is.null(url)) url <- mran_host
if (!is.online(url = url)) testthat::skip("offline")
}
set_test_types <- function() {
types <-
Sys.getenv(
"minicran_test_scope",
unset = "source, win.binary, mac.binary, mac.binary.mavericks"
)
types <- gsub(" +", "", types)
unname(strsplit(types, ",")[[1]])
}
# Use in unit tests to check if source or binary files are in repo
.checkForRepoFiles <- function(path, pkgList, prefix) {
ptn <- "tar\\.gz|zip|tgz"
ff <- list.files(file.path(path, prefix), recursive = TRUE, pattern = ptn)
if (length(ff) < length(pkgList)) return(FALSE)
ret <- sapply(pkgList, function(x)any(grepl(x, ff)))
if (all(ret > 0)) TRUE else {
message(ret)
FALSE
}
}
# These functions mock downloading of packages, for fast testing purposes only
#' @importFrom utils available.packages
mock_download_packages <- function(pkgs, destdir, available, type, ...) {
if (missing(available) || is.null(available)) available <- available.packages()
downloadFileName <- function(package, version, type) {
paste0(package, "_", version, pkgFileExt(type))
}
versions <- setNames(available[pkgs, "Version"], pkgs)
downloads <- mapply(names(versions), versions,
USE.NAMES = FALSE,
FUN = function(p, v) {
fn <- file.path(destdir, downloadFileName(p, v, type))
writeLines("", fn)
matrix(c(p, fn), ncol = 2)
}
)
t(downloads)
}
mock_write_packages <- function(dir, type = "source", r_version) {
pattern <- ".tgz$|.zip$|.tar.gz$"
if (grepl("mac.binary", type)) type <- "mac.binary"
ff <- list.files(dir, recursive = TRUE, full.names = TRUE, pattern = pattern)
ffb <- basename(ff)
pkgs <- ffb[!grepl("^PACKAGES.*", ffb)]
np <- length(pkgs)
pkg_names <- gsub(pattern, "", pkgs)
db <- matrix(unlist(strsplit(pkg_names, "_")), ncol = 2, byrow = TRUE)
colnames(db) <- c("Package", "Version")
db
if (np > 0L) {
db[!is.na(db) & (db == "")] <- NA_character_
con <- file(file.path(dir, "PACKAGES"), "wt")
write.dcf(db, con)
close(con)
con <- gzfile(file.path(dir, "PACKAGES.gz"), "wt")
write.dcf(db, con)
close(con)
rownames(db) <- db[, "Package"]
r_version <- twodigitRversion(r_version)
if (r_version >= "3.5.0") {
saveRDS(db, file.path(dir, "PACKAGES.rds"))
} else {
saveRDS(db, file.path(dir, "PACKAGES.rds"), version = 2)
}
}
np
}
# Create sample repo from p3m snapshot
.createSampleRepo <- function(p3m, path, pkgs, Rversion = "4.0", types) {
if (missing(p3m)) p3m <- p3m("2024-01-02")
if (missing(path)) path <- file.path(tempdir(), "miniCRAN", Sys.Date())
if (missing(pkgs)) pkgs <- c("chron", "curl")
if (missing(types)) types <- set_test_types()
# pdb_source <- pkgAvail(repos = p3m, type = "source", Rversion = Rversion)
# pdb_win <- pkgAvail(repos = p3m, type = "win.binary", Rversion = Rversion)
# pdb_mac <- pkgAvail(repos = p3m, type = "mac.binary", Rversion = Rversion)
mockr::with_mock(
download_packages = mock_download_packages,
write_packages = mock_write_packages,
.env = "miniCRAN",
{
for (type in types) {
pdb <- pkgAvail(repos = p3m, type = type, Rversion = Rversion)
pkgList_source <- pkgDep(pkgs, availPkgs = pdb, repos = p3m,
type = type, suggests = FALSE, Rversion = Rversion)
makeRepo(pkgList_source, path = path, repos = p3m,
type = type,
quiet = TRUE, Rversion = Rversion)
}
}
)
}
make_fake_package <- function(version = "0.1.0", base_path = tempdir()) {
fake_package <- file.path(base_path, "fake.package")
dir.create(fake_package, showWarnings = FALSE)
# Create a fake function to add to the package
foo <- function(x)NA
# Create the skeleton
# browser()
if (getRversion() >= "3.5") {
suppressMessages(
package.skeleton(
"fake.package",
path = base_path,
list = "foo",
force = TRUE,
environment = environment(foo),
encoding = "UTF-8"
)
)
} else {
suppressMessages(
package.skeleton(
"fake.package",
path = base_path,
list = "foo",
force = TRUE,
environment = environment(foo)
)
)
}
# Remove unnecessary detritus from skeleton
file.remove(file.path(fake_package, "NAMESPACE"))
unlink(file.path(fake_package, "data"), recursive = TRUE)
unlink(file.path(fake_package, "man"), recursive = TRUE)
unlink(file.path(fake_package, "Read-and-delete-me"), recursive = TRUE)
# Write a function file with some roxygen
writeLines(
con = file.path(fake_package, "R", "foo.R"),
text = "
#' Foo.
#'
#' Does nothing.
#' @export
#' foo <- function(x)NULL
")
# Set package version
desc <- readLines(file.path(fake_package, "DESCRIPTION"))
version_line <- grep("^Version:", desc)
desc[version_line] <- paste0("Version: ", version)
writeLines(desc, con = file.path(file.path(fake_package, "DESCRIPTION")))
# Document the package
suppressMessages(
devtools::document(fake_package, quiet = TRUE)
)
# Build the package
devtools::build(fake_package, path = base_path, quiet = TRUE)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.