r-lib · jimhester · Jul 10, 2020 · Dec 14, 2018 · Feb 28, 2019 · Feb 28, 2019
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -9,6 +9,7 @@ Authors@R: c(
     person("RStudio", role = "cph"),
     person("Martin", "Morgan", role = "aut"),
     person("Dan", "Tenenbaum", role = "aut"),
+    person("Ken", "Williams", , "kenahoo@gmail.com", role = "ctb"),
     person("Mango Solutions", role = "cph")
     )
 Description: Download and install R packages stored in 'GitHub', 'GitLab', 

diff --git a/NEWS.md b/NEWS.md
@@ -47,6 +47,14 @@
 * `install_version()` now errors with a more informative message when `type` is
   not 'source' (#323)
 
+* `install_version()` now keeps searching subsequent repositories for the
+  requested version, rather than failing if the version it finds in an early
+  repository is unsuitable.
+
+* `install_version()` now understands specifications like '>= 1.0' or
+  '>= 1.12.0, < 1.14' to install the first version of the package it can
+  find that satisfies the criteria.
+
 * Bioc `remote_sha()` now always returns a character result (#379)
 
 * Fix API call for private repositories in `install_gitlab` 

diff --git a/R/install-version.R b/R/install-version.R
@@ -1,22 +1,41 @@
 
-#' Install specified version of a CRAN package.
+#' Install specific version of a package.
 #'
-#' If you are installing an package that contains compiled code, you will
-#' need to have an R development environment installed.  You can check
-#' if you do by running `devtools::has_devel` (you need the
-#' `devtools` package for this).
+#' This function knows how to look in multiple CRAN-like package repositories, and in their
+#' \code{archive} directories, in order to find specific versions of the requested package.
+#'
+#' The repositories are searched in the order specified by the \code{repos} argument.  This enables
+#' teams to maintain multiple in-house repositories with different policies - for instance, one repo
+#' for development snapshots and one for official releases.  A common setup would be to first search
+#' the official release repo, then the dev snapshot repo, then a public CRAN mirror.
+#'
+#' Older versions of packages on CRAN are usually only available in source form.  If your requested
+#' package contains compiled code, you will need to have an R development environment installed. You
+#' can check if you do by running `devtools::has_devel` (you need the `devtools` package for this).
 #'
 #' @export
 #' @family package installation
-#' @param package package name
-#' @param version If the specified version is NULL or the same as the most
-#'   recent version of the package, this function simply calls
-#'   [utils::install.packages()]. Otherwise, it looks at the list of
-#'   archived source tarballs and tries to install an older version instead.
+#' @param package Name of the package to install.
+#' @param version Version of the package to install.  Can either be a string giving the exact
+#'   version required, or a specification in the same format as the parenthesized expressions used
+#'   in package dependencies (see \code{\link{parse_deps}} and/or
+#'   \url{https://cran.r-project.org/doc/manuals/r-release/R-exts.html#Package-Dependencies}).
 #' @param ... Other arguments passed on to [utils::install.packages()].
 #' @inheritParams utils::install.packages
 #' @inheritParams install_github
-#' @author Jeremy Stephens
+#' @author Jeremy Stephens and Ken Williams
+#' @examples
+#' \dontrun{
+#' install_version('devtools', '1.11.0')
+#' install_version('devtools', '>= 1.12.0, < 1.14')
+#'
+#' ## Specify search order (e.g. in ~/.Rprofile)
+#' options(repos=c(prod = 'http://mycompany.example.com/r-repo',
+#'                 dev  = 'http://mycompany.example.com/r-repo-dev',
+#'                 CRAN = 'https://cran.revolutionanalytics.com'))
+#' install_version('mypackage', '1.15')        # finds in 'prod'
+#' install_version('mypackage', '1.16-39487')  # finds in 'dev'
+#' }
 #' @importFrom utils available.packages contrib.url install.packages
 
 install_version <- function(package, version = NULL,
@@ -30,6 +49,11 @@ install_version <- function(package, version = NULL,
                             type = "source",
                             ...) {
 
+  # TODO would it make sense to vectorize this, e.g. `install_version(c("foo", "bar"), c("1.1", "2.2"))`?
+  if (length(package) < 1) return()
+  if (length(package) > 1)
+    stop("install_version() must be called with a single 'package' argument - multiple packages given")
+
   if (!identical(type, "source")) {
     stop("`type` must be 'source' for `install_version()`", call. = FALSE)
   }
@@ -58,28 +82,82 @@ install_version <- function(package, version = NULL,
   invisible(res)
 }
 
-package_find_repo <- function(package, repos) {
-  for (repo in repos) {
-    if (length(repos) > 1)
-      message("Trying ", repo)
-
-    archive <-
-      tryCatch({
-        con <- gzcon(url(sprintf("%s/src/contrib/Meta/archive.rds", repo), "rb"))
-        on.exit(close(con))
-        readRDS(con)
-      },
-      warning = function(e) list(),
-      error = function(e) list())
-
-    info <- archive[[package]]
-    if (!is.null(info)) {
-      info$repo <- repo
-      return(info)
-    }
+#' @param tarball_name character vector of files or paths from which to extract version numbers
+#' @return versions extracted, or `NULL` when extraction fails
+version_from_tarball <- function(tarball_name) {
+  package_ver_regex <- paste0(".+_(", .standard_regexps()$valid_package_version, ")\\.tar\\.gz$")
+  ifelse(grepl(package_ver_regex, tarball_name), sub(package_ver_regex, "\\1", tarball_name), NULL)
+}
+
+#' @param to_check version as a string or `package_version` object
+#' @inheritParams version_criteria
+#' @return TRUE if version 'to.check' satisfies all version criteria 'criteria'
+version_satisfies_criteria <- function(to_check, criteria) {
+  to_check <- package_version(to_check)
+  result <- apply(version_criteria(criteria), 1, function(r) {
+    if(is.na(r['compare'])) TRUE
+    else get(r['compare'], mode='function')(to_check, r['version'])
+  })
+  all(result)
+}
+
+#' @param pkg package name
+#' @inheritParams version_criteria
+#' @return TRUE if `pkg` is already installed, and its version satisfies all criteria `criteria`
+package_installed <- function(pkg, criteria) {
+  v <- suppressWarnings(packageDescription(pkg, fields = "Version"))
+  !is.na(v) && version_satisfies_criteria(v, criteria)
+}
+
+#' @param criteria character vector expressing criteria for some version to satisfy.  Options include:
+#' \begin{itemize}
+#'   \item `NULL` or `NA`, indicating that the package must be present, but need not satisfy any
+#'   particular version
+#'   \item An exact version required, as a string, e.g. `"0.1.13"`
+#'   \item A comparison operator and a version, e.g. `">= 0.1.12"`
+#'   \item Several criteria to satisfy, as a comma-separated string, e.g. `">= 1.12.0, < 1.14"`
+#'   \item Several criteria to satisfy, as elements of a character vector, e.g. `c(">= 1.12.0", "< 1.14")`
+#' \end{itemize}
+#' @return `data.frame` with columns `compare` and `version` expressing the criteria
+version_criteria <- function(criteria) {
+  if (is.character(criteria) && length(criteria) == 1)
+    criteria <- strsplit(criteria, ',')[[1]]
+
+  numeric_ver <- .standard_regexps()$valid_numeric_version
+
+  package <- "p"  # dummy package name, required by parse_deps()
+
+  spec <- if(is.null(criteria) || is.na(criteria)) package else
+    ifelse(grepl(paste0("^", numeric_ver, "$"), criteria),
+           paste0(package, "(== ", criteria, ")"),
+           paste0(package, "(", criteria, ")"))
+
+  parse_deps(paste(spec, collapse=", "))[c("compare", "version")]
+}
+
+# Find a given package record in the `archive.rds` file of a repository
+package_find_archives <- function(package, repo, verbose=FALSE) {
+
+  if (verbose)
+    message("Trying ", repo)
+
+  # TODO it would be nice to cache these downloaded files like `available.packages` does
+  archive <-
+    tryCatch({
+      con <- gzcon(url(sprintf("%s/src/contrib/Meta/archive.rds", repo), "rb"))
+      on.exit(close(con))
+      readRDS(con)
+    },
+    warning = function(e) list(),
+    error = function(e) list())
+
+  info <- archive[[package]]
+  if (!is.null(info)) {
+    info$repo <- repo
+    return(info)
   }
 
-  stop(sprintf("couldn't find package '%s'", package))
+  NULL
 }
 
 
@@ -101,39 +179,53 @@ download_version <- function(package, version = NULL,
   download(path = tempfile(), url = url)
 }
 
-download_version_url <- function(package, version, repos, type) {
+download_version_url <- function(package, version, repos, type, available, verbose=length(repos) > 1) {
+
+  ## TODO should we do for(r in repos) { for (t in c('published','archive')) {...}}, or
+  ## for (t in c('published','archive')) { for(r in repos) {...}} ? Right now it's the latter.  It
+  ## only matters if required version is satisfied by both an early repo in archive/ and a late repo
+
+  if (missing(available)) {
+    contriburl <- contrib.url(repos, type)
+    available <- available.packages(contriburl, filters = c("R_version", "OS_type", "subarch"))
+  }
 
-  contriburl <- contrib.url(repos, type)
-  available <- available.packages(contriburl)
+  package_exists <- FALSE
 
-  if (package %in% row.names(available)) {
-    current.version <- available[package, 'Version']
-    if (is.null(version) || version == current.version) {
-      row <- available[which(rownames(available) == package)[1], ]
+  # available.packages() returns a matrix with entries in the same order as the repositories in
+  # `repos`, so the first packages we encounter should be preferred.
+  for (ix in which(available[, "Package"] == package)) {
+    package_exists <- TRUE
+    row <- available[ix, ]
+    if (version_satisfies_criteria(row["Version"], version)) {
       return(paste0(
-        row[["Repository"]],
+        row["Repository"],
         "/",
-        row[["Package"]],
+        row["Package"],
         "_",
-        row[["Version"]],
+        row["Version"],
         ".tar.gz"
       ))
     }
   }
 
-  info <- package_find_repo(package, repos)
-
-  if (is.null(version)) {
-    # Grab the latest one: only happens if pulled from CRAN
-    package.path <- row.names(info)[nrow(info)]
-  } else {
-    package.path <- paste(package, "/", package, "_", version, ".tar.gz",
-      sep = "")
-    if (!(package.path %in% row.names(info))) {
-      stop(sprintf("version '%s' is invalid for package '%s'", version,
-        package))
+  for (repo in repos) {
+    info <- package_find_archives(package, repo, verbose=verbose)
+    if (is.null(info))
+      next
+
+    package_exists <- TRUE
+
+    for (i in rev(seq_len(nrow(info)))) {
+      package_path <- row.names(info)[i]
+      if (version_satisfies_criteria(version_from_tarball(package_path), version)) {
+        return(paste(repo, "src/contrib/Archive/", package_path, sep = ""))
+      }
     }
   }
 
-  paste(info$repo[1L], "/src/contrib/Archive/", package.path, sep = "")
+  if (!package_exists)
+    stop(sprintf("couldn't find package '%s'", package))
+
+  stop(sprintf("version '%s' is invalid for package '%s'", version, package))
 }
diff --git a/man/download_version.Rd b/man/download_version.Rd
diff --git a/man/install_version.Rd b/man/install_version.Rd