Handle available packages filters

R/install-version.R

@@ -103,13 +103,38 @@ download_version <- function(package, version = NULL,
 
 download_version_url <- function(package, version, repos, type) {
 
+  filters <- getOption("available_packages_filters")
+  if (is.null(filters)) {
+    filters <- c("R_version", "OS_type", "subarch")
+  } else {
+    filters <- setdiff(filters, "duplicates")
+  }
+
   contriburl <- contrib.url(repos, type)
-  available <- available.packages(contriburl)
+  available <- available.packages(contriburl, filters = filters)
 
   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], ]
+    the_package <- row.names(available) == package
+    if (is.null(version)) {
+      available <- available[the_package, , drop = FALSE]
+      # Sort by version if there are duplicates
+      for (i in seq_len(nrow(available) - 1L)) {
+        j <- i + 1L
+        if (compareVersion(available[i, "Version"], available[j, "Version"]) > 0) {
+          available[c(i, j), ] <- available[c(j, i), ]
+        }
+      }
+      row <- available[nrow(available), ]
+    } else {
+      the_version <- available[, "Version"] == version
+      available <- available[the_package & the_version, , drop = FALSE]
+      if (nrow(available) > 0) {
+        row <- available[1L, ]
+      } else {
+        row <- NULL
+      }
+    }
+    if (!is.null(row)) {
       return(paste0(
         row[["Repository"]],
         "/",

tests/testthat/test-install-version.R

@@ -127,6 +127,108 @@ test_that("install_version for archived packages", {
   )
 })
 
+test_that("install_version with specific version on duplicating repository", {
+
+  skip_on_cran()
+  skip_if_offline()
+
+  Sys.unsetenv("R_TESTS")
+
+  # path to install
+  lib <- tempfile()
+  setup(dir.create(lib))
+  teardown(unlink(lib, recursive = TRUE))
+
+  # path to local repository
+  local_cran <- tempfile("testdir")
+  contrib <- file.path(local_cran, "src", "contrib")
+  setup(dir.create(contrib, recursive = TRUE))
+  teardown(unlink(local_cran, recursive = TRUE))
+
+  # create local repository
+  download_rstudioapi <- function(version) {
+    filename <- sprintf("rstudioapi_%s.tar.gz", version)
+    url <- sprintf("https://cloud.r-project.org/src/contrib/Archive/rstudioapi/%s", filename)
+    destfile <- file.path(contrib, filename)
+    download.file(url, destfile = destfile)
+  }
+  download_rstudioapi("0.1")
+  download_rstudioapi("0.10")
+  download_rstudioapi("0.3.1")
+  download_rstudioapi("0.5")
+  tools::write_PACKAGES(contrib, latestOnly = FALSE)
+
+  # set CRAN mirror
+  repos <- getOption("repos")
+  if (length(repos) == 0) repos <- character()
+  repos[repos == "@CRAN@"] <-
+    if (.Platform$OS.type == "windows") {
+      sprintf("file:///%s", gsub("\\\\", "/", local_cran))
+    } else {
+      sprintf("file://%s", local_cran)
+    }
+
+  # run test
+  install_version("rstudioapi", lib = lib, repos = repos, quiet = TRUE)
+  expect_silent(packageDescription("rstudioapi", lib.loc = lib))
+  desc <- packageDescription("rstudioapi", lib.loc = lib)
+  expect_equal(desc$Version, "0.10")
+  expect_null(desc$RemoteType)
+  expect_null(desc$RemoteSubdir)
+  expect_null(desc$RemoteUrl)
+})
+
+test_that("install_version latest version on duplicating repository", {
+
+  skip_on_cran()
+  skip_if_offline()
+
+  Sys.unsetenv("R_TESTS")
+
+  # path to install
+  lib <- tempfile()
+  setup(dir.create(lib))
+  teardown(unlink(lib, recursive = TRUE))
+
+  # path to local repository
+  local_cran <- tempfile("testdir")
+  contrib <- file.path(local_cran, "src", "contrib")
+  setup(dir.create(contrib, recursive = TRUE))
+  teardown(unlink(local_cran, recursive = TRUE))
+
+  # create local repository
+  download_rstudioapi <- function(version) {
+    filename <- sprintf("rstudioapi_%s.tar.gz", version)
+    url <- sprintf("https://cloud.r-project.org/src/contrib/Archive/rstudioapi/%s", filename)
+    destfile <- file.path(contrib, filename)
+    download.file(url, destfile = destfile)
+  }
+  download_rstudioapi("0.1")
+  download_rstudioapi("0.10")
+  download_rstudioapi("0.3.1")
+  download_rstudioapi("0.5")
+  tools::write_PACKAGES(contrib, latestOnly = FALSE)
+
+  # set CRAN mirror
+  repos <- getOption("repos")
+  if (length(repos) == 0) repos <- character()
+  repos[repos == "@CRAN@"] <-
+    if (.Platform$OS.type == "windows") {
+      sprintf("file:///%s", gsub("\\\\", "/", local_cran))
+    } else {
+      sprintf("file://%s", local_cran)
+    }
+
+  # run test
+  install_version("rstudioapi", "0.3.1", lib = lib, repos = repos, quiet = TRUE)
+  expect_silent(packageDescription("rstudioapi", lib.loc = lib))
+  desc <- packageDescription("rstudioapi", lib.loc = lib)
+  expect_equal(desc$Version, "0.3.1")
+  expect_null(desc$RemoteType)
+  expect_null(desc$RemoteSubdir)
+  expect_null(desc$RemoteUrl)
+})
+
 test_that("install_version for other types fails", {
   expect_error(
     install_version("igraph0", type = "binary"),