diff --git a/NAMESPACE b/NAMESPACE index 812f617..9bf65a3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,6 +15,7 @@ export(error) export(format_output) export(from_dcf) export(git_resource) +export(http_resource) export(impl_data) export(impl_data_derive) export(impl_data_info) @@ -63,6 +64,7 @@ importFrom(tools,toRd) importFrom(utils,.DollarNames) importFrom(utils,available.packages) importFrom(utils,capture.output) +importFrom(utils,download.file) importFrom(utils,download.packages) importFrom(utils,getCRANmirrors) importFrom(utils,head) diff --git a/R/class_resource.R b/R/class_resource.R index c6333d2..55f5c0d 100644 --- a/R/class_resource.R +++ b/R/class_resource.R @@ -262,6 +262,23 @@ git_resource <- class_git_resource <- new_class( ) ) +#' Package `http(s)` Archive Resource Class +#' +#' A web-based reference to an R package file. Most often this will be used +#' to resolve an http url into a source code archive. +#' +#' @family resources +#' @export +http_resource <- class_http_resource <- new_class( + "http_resource", + #' @inheritParams remote_resource + parent = remote_resource, + properties = list( + #' @param http_url The git repository url + http_url = class_character + ) +) + #' [`resource`] from `character` #' #' Attempt to find any suitable package sources. @@ -277,6 +294,9 @@ method(convert, list(class_character, class_resource)) <- all_resource_type_names <- vcapply(all_resource_types, class_desc) # create an empty list to populate with discovered resources + env <- environment() + env # appease lintr + resources <- list() length(resources) <- length(all_resource_types) @@ -289,7 +309,7 @@ method(convert, list(class_character, class_resource)) <- return() } - resources[[idx]] <<- resource + env$resources[[idx]] <- resource idx } @@ -418,6 +438,15 @@ method(convert, list(class_character, class_install_resource)) <- stop(fmt("Cannot convert string '{from}' into {.cls to}")) } +method(convert, list(class_character, class_http_resource)) <- + function(from, to, ...) { + if (grepl("^https?://.*\\.(tar\\.(gz|bz2?|xz)|zip|tgz)$", from)) { + return(to(http_url = from)) + } + + stop(fmt("Cannot convert string '{from}' into {.cls to}")) + } + method(convert, list(class_character, class_source_archive_resource)) <- function(from, to, ...) { if (file.exists(from) && endsWith(from, ".tar.gz")) { @@ -476,7 +505,8 @@ method(convert, list(class_repo_resource, class_install_resource)) <- pkgs = from@package, lib = lib_path, repos = from@repo, - quiet = quiet + quiet = quiet, + INSTALL_opts = "--install-tests" ) pkg_dir <- list.files(lib_path, full.names = TRUE) @@ -513,6 +543,8 @@ method(convert, list(class_repo_resource, class_source_archive_resource)) <- package <- x[[1, 1]] path <- x[[1, 2]] + + # TODO: archive may be other formats, ctrl-f bz version <- gsub("^.*/[^_]*_(.*)\\.tar\\.gz$", "\\1", path) source_archive_resource( @@ -557,7 +589,30 @@ method(convert, list(class_repo_resource, class_cran_repo_resource)) <- ) } -method(convert, list(class_local_source_resource, class_install_resource)) <- +#' @importFrom utils download.file +method(convert, list(class_http_resource, class_source_archive_resource)) <- + function(from, to, ..., policy = opt("policy"), quiet = opt("quiet")) { + assert_permissions(c("write", "network"), policy@permissions) + + # download package to a temporary directory + filename <- gsub(".*/", "", from@http_url) + destfile <- tempfile() + dir.create(destfile, recursive = TRUE) + destfile <- file.path(destfile, filename) + + download.file(from@http_url, destfile = destfile, quiet = TRUE) + + # propagate downloaded file as new source archive resource + source_archive_resource(path = destfile) + } + +method( + convert, + list( + class_local_source_resource | class_source_archive_resource, + class_install_resource + ) +) <- function(from, to, ..., policy = opt("policy"), quiet = opt("quiet")) { assert_permissions("write", policy@permissions) @@ -570,7 +625,8 @@ method(convert, list(class_local_source_resource, class_install_resource)) <- lib = lib_path, repos = NULL, type = "source", - quiet = quiet + quiet = quiet, + INSTALL_opts = "--install-tests" ) pkg_dir <- list.files(lib_path, full.names = TRUE) diff --git a/R/utils_rd.R b/R/utils_rd.R index 17905dd..65c0543 100644 --- a/R/utils_rd.R +++ b/R/utils_rd.R @@ -78,6 +78,8 @@ rd_sexpr <- function( #' @describeIn utils-rd #' Generate a badge, using shields.io and caching svg images for display in #' html output. +#' +#' @importFrom utils download.file rd_badge <- local({ cache <- NULL diff --git a/man/cran_repo_resource.Rd b/man/cran_repo_resource.Rd index 784355d..9b33b7a 100644 --- a/man/cran_repo_resource.Rd +++ b/man/cran_repo_resource.Rd @@ -42,6 +42,7 @@ is also a CRAN mirror, please follow instructions in \seealso{ Other resources: \code{\link{git_resource}()}, +\code{\link{http_resource}()}, \code{\link{install_resource}()}, \code{\link{local_resource}()}, \code{\link{local_source_resource}()}, diff --git a/man/git_resource.Rd b/man/git_resource.Rd index e43a1c3..e2ec418 100644 --- a/man/git_resource.Rd +++ b/man/git_resource.Rd @@ -38,6 +38,7 @@ A reference to a listing in an R package git source code repository. \seealso{ Other resources: \code{\link{cran_repo_resource}()}, +\code{\link{http_resource}()}, \code{\link{install_resource}()}, \code{\link{local_resource}()}, \code{\link{local_source_resource}()}, diff --git a/man/http_resource.Rd b/man/http_resource.Rd new file mode 100644 index 0000000..e9ef283 --- /dev/null +++ b/man/http_resource.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_resource.R +\name{http_resource} +\alias{http_resource} +\title{Package \code{http(s)} Archive Resource Class} +\usage{ +http_resource( + package = NA_character_, + version = NA_character_, + id = next_id(), + md5 = NA_character_, + http_url = character(0) +) +} +\arguments{ +\item{package}{\code{character(1L)} Package name. Optional, but should be +provided if possible.} + +\item{version}{\code{character(1L)} Package version, provided as a string.} + +\item{id}{\code{integer(1L)} optional id used for tracking resources +throughout execution. Generally not provided directly, as new objects +automatically get a unique identifier. For example, the package source +code from a \code{\link[=repo_resource]{repo_resource()}} may be downloaded to add a +\code{\link[=source_archive_resource]{source_archive_resource()}} and add it to a new \code{\link[=multi_resource]{multi_resource()}}. +Because all of these represent the same package, they retain the same +\code{id}. Primarily the \code{id} is used for isolating temporary files.} + +\item{md5}{\code{character(1L)} md5 digest of the package source code tarball. +This is not generally provided directly, but is instead derived when +acquiring resources.} + +\item{http_url}{The git repository url} +} +\description{ +A web-based reference to an R package file. Most often this will be used +to resolve an http url into a source code archive. +} +\seealso{ +Other resources: +\code{\link{cran_repo_resource}()}, +\code{\link{git_resource}()}, +\code{\link{install_resource}()}, +\code{\link{local_resource}()}, +\code{\link{local_source_resource}()}, +\code{\link{mock_resource}()}, +\code{\link{multi_resource}()}, +\code{\link{remote_resource}()}, +\code{\link{repo_resource}()}, +\code{\link{resource}()}, +\code{\link{source_archive_resource}()}, +\code{\link{source_code_resource}()}, +\code{\link{unknown_resource}()} +} +\concept{resources} diff --git a/man/install_resource.Rd b/man/install_resource.Rd index 66e7700..7ddfb51 100644 --- a/man/install_resource.Rd +++ b/man/install_resource.Rd @@ -40,6 +40,7 @@ An installed version of a package, as would be found in a package library. Other resources: \code{\link{cran_repo_resource}()}, \code{\link{git_resource}()}, +\code{\link{http_resource}()}, \code{\link{local_resource}()}, \code{\link{local_source_resource}()}, \code{\link{mock_resource}()}, diff --git a/man/local_resource.Rd b/man/local_resource.Rd index 0e45f7c..a001ca1 100644 --- a/man/local_resource.Rd +++ b/man/local_resource.Rd @@ -41,6 +41,7 @@ from files locally on the filesystem. Other resources: \code{\link{cran_repo_resource}()}, \code{\link{git_resource}()}, +\code{\link{http_resource}()}, \code{\link{install_resource}()}, \code{\link{local_source_resource}()}, \code{\link{mock_resource}()}, diff --git a/man/local_source_resource.Rd b/man/local_source_resource.Rd index a56f26f..7738754 100644 --- a/man/local_source_resource.Rd +++ b/man/local_source_resource.Rd @@ -47,6 +47,7 @@ process, yet may be informative for metric assessment. Other resources: \code{\link{cran_repo_resource}()}, \code{\link{git_resource}()}, +\code{\link{http_resource}()}, \code{\link{install_resource}()}, \code{\link{local_resource}()}, \code{\link{mock_resource}()}, diff --git a/man/mock_resource.Rd b/man/mock_resource.Rd index ed651b2..778b119 100644 --- a/man/mock_resource.Rd +++ b/man/mock_resource.Rd @@ -40,6 +40,7 @@ a custom data simulation method. Other resources: \code{\link{cran_repo_resource}()}, \code{\link{git_resource}()}, +\code{\link{http_resource}()}, \code{\link{install_resource}()}, \code{\link{local_resource}()}, \code{\link{local_source_resource}()}, diff --git a/man/multi_resource.Rd b/man/multi_resource.Rd index 47d1d41..d43dc80 100644 --- a/man/multi_resource.Rd +++ b/man/multi_resource.Rd @@ -51,6 +51,7 @@ can successfully derive the expected data. Other resources: \code{\link{cran_repo_resource}()}, \code{\link{git_resource}()}, +\code{\link{http_resource}()}, \code{\link{install_resource}()}, \code{\link{local_resource}()}, \code{\link{local_source_resource}()}, diff --git a/man/remote_resource.Rd b/man/remote_resource.Rd index 49095b3..b1af097 100644 --- a/man/remote_resource.Rd +++ b/man/remote_resource.Rd @@ -36,6 +36,7 @@ Abstract Class for Remote Package Resources Other resources: \code{\link{cran_repo_resource}()}, \code{\link{git_resource}()}, +\code{\link{http_resource}()}, \code{\link{install_resource}()}, \code{\link{local_resource}()}, \code{\link{local_source_resource}()}, diff --git a/man/repo_resource.Rd b/man/repo_resource.Rd index 0e99f60..b0c4498 100644 --- a/man/repo_resource.Rd +++ b/man/repo_resource.Rd @@ -40,6 +40,7 @@ A reference to a listing in an R package repository. Other resources: \code{\link{cran_repo_resource}()}, \code{\link{git_resource}()}, +\code{\link{http_resource}()}, \code{\link{install_resource}()}, \code{\link{local_resource}()}, \code{\link{local_source_resource}()}, diff --git a/man/resource.Rd b/man/resource.Rd index 0d3578d..0646f87 100644 --- a/man/resource.Rd +++ b/man/resource.Rd @@ -47,6 +47,7 @@ package. Other resources: \code{\link{cran_repo_resource}()}, \code{\link{git_resource}()}, +\code{\link{http_resource}()}, \code{\link{install_resource}()}, \code{\link{local_resource}()}, \code{\link{local_source_resource}()}, diff --git a/man/source_archive_resource.Rd b/man/source_archive_resource.Rd index 370b3de..c67dd86 100644 --- a/man/source_archive_resource.Rd +++ b/man/source_archive_resource.Rd @@ -40,6 +40,7 @@ The extracted source code from a package's build archive. Other resources: \code{\link{cran_repo_resource}()}, \code{\link{git_resource}()}, +\code{\link{http_resource}()}, \code{\link{install_resource}()}, \code{\link{local_resource}()}, \code{\link{local_source_resource}()}, diff --git a/man/source_code_resource.Rd b/man/source_code_resource.Rd index dc2e3d0..5db0244 100644 --- a/man/source_code_resource.Rd +++ b/man/source_code_resource.Rd @@ -40,6 +40,7 @@ A union of all package resource classes that have local source code. Other resources: \code{\link{cran_repo_resource}()}, \code{\link{git_resource}()}, +\code{\link{http_resource}()}, \code{\link{install_resource}()}, \code{\link{local_resource}()}, \code{\link{local_source_resource}()}, diff --git a/man/unknown_resource.Rd b/man/unknown_resource.Rd index 12bacbf..3284f06 100644 --- a/man/unknown_resource.Rd +++ b/man/unknown_resource.Rd @@ -37,6 +37,7 @@ commonly when a package object is reconstructed from a \code{PACKAGES} file. Other resources: \code{\link{cran_repo_resource}()}, \code{\link{git_resource}()}, +\code{\link{http_resource}()}, \code{\link{install_resource}()}, \code{\link{local_resource}()}, \code{\link{local_source_resource}()}, diff --git a/tests/testthat/test-convert-to-pkg.R b/tests/testthat/test-convert-to-pkg.R index c631651..e1ff430 100644 --- a/tests/testthat/test-convert-to-pkg.R +++ b/tests/testthat/test-convert-to-pkg.R @@ -1,36 +1,83 @@ -test_that("convert(from = character, to = class_pkg) can discover resources", { - expected <- simpleError("downloading ...") - class(expected) <- c("test_suite_signal", class(expected)) +test_that( + paste0( + "convert(, ) can discover repo resources from ", + "package names" + ), + { + expected <- simpleError("downloading ...") + class(expected) <- c("test_suite_signal", class(expected)) - # intercept download package call and instead of doing a slow download, just - # signal that we hit our download call - with_mocked_bindings( - available.packages = function(...) { - cbind( - Package = "fake.pkg", - Version = "1.0", - MD5sum = "abcdef", - Repository = "acme.org" - ) - }, - download.packages = function(...) { - signalCondition(expected) - }, - code = { - # specify a policy that will force pkg to attempt re-download - policy <- policy( - accepted_resources = list(class_source_archive_resource), - source_resources = list(class_repo_resource), - permissions = TRUE - ) + # intercept download package call and instead of doing a slow download, just + # signal that we hit our download call + with_mocked_bindings( + available.packages = function(...) { + cbind( + Package = "fake.pkg", + Version = "1.0", + MD5sum = "abcdef", + Repository = "acme.org" + ) + }, + download.packages = function(...) { + signalCondition(expected) + }, + code = { + # specify a policy that will force pkg to attempt re-download + policy <- policy( + accepted_resources = list(class_source_archive_resource), + source_resources = list(class_repo_resource), + permissions = TRUE + ) - expect_error( - pkg("fake.pkg", policy = policy), - class = class(expected)[[1L]] - ) - } - ) -}) + expect_error( + pkg("fake.pkg", policy = policy), + class = class(expected)[[1L]] + ) + } + ) + } +) + + +test_that( + paste0( + "convert(, ) can discover repo resources from ", + "package archive urls" + ), + { + expected <- simpleError("installing ...") + class(expected) <- c("test_suite_signal", class(expected)) + + # intercept download package call and instead of doing a slow download, just + # signal that we hit our download call + with_mocked_bindings( + install.packages = function(...) { + signalCondition(expected) + }, + download.file = function(...) { + NULL + }, + code = { + # use policy that will attempt to download & install http resource + policy <- policy( + accepted_resources = list(class_install_resource), + source_resources = list(class_source_archive_resource, http_resource), + permissions = TRUE + ) + + expect_error( + pkg("http://repo.com/src/contrib/fake.pkg.tar.gz", policy = policy), + class = class(expected)[[1L]] + ) + + expect_error( + pkg("https://repo.com/src/contrib/fake.pkg.tar.gz", policy = policy), + class = class(expected)[[1L]] + ) + } + ) + } +) test_that("convert(from = class_pkg, to = class_pkg)", { p <- random_pkg()