fix 'addLocalPackage' and add tests (#23)

R/addPackages.R

@@ -186,7 +186,7 @@ addOldPackage <- function(pkgs=NULL, path=NULL, vers=NULL,
   f <- list.files(path, pattern = pattern)
 
   # we only care about the subset matching pkgs
-  f <- sapply(pkgs, function(x) { grep(x, f, value = TRUE)} )
+  f <- sapply(pkgs, function(x) { grep(x, f, value = TRUE) })
 
   if (length(f)) {
     # if multiple versions present, always use latest
@@ -200,11 +200,16 @@ addOldPackage <- function(pkgs=NULL, path=NULL, vers=NULL,
       as.numeric_version()
 
     fout <- sapply(fp, function(x) {
-      ids <- which(fp %in% x)
-      paste0(x, "_", max(fv[ids]))
+      ids.p <- which(fp %in% x)
+
+      # numeric_version always returns version using '.' as separator,
+      #   even if the package uses '-', so we need to ensure either will work
+      id.v <- which(fv == max(fv[ids.p]))
+
+      f[id.v]
     }) %>% unique()
 
-    return(paste0(fout, pattern))
+    return(fout)
   } else {
     return(character())
   }
@@ -239,6 +244,8 @@ addOldPackage <- function(pkgs=NULL, path=NULL, vers=NULL,
 #' \dontrun{
 #'  addLocalPackage("myPackage", "path/to/my/prebuilt/package",
 #'                  "path/to/my/miniCRAN/repo")
+#'
+#'  ## not yet implemented:
 #'  addLocalPackage("myPackage", "path/to/my/package/sourcecode",
 #'                  "path/to/my/miniCRAN/repo", build=TRUE)
 #' }
@@ -248,10 +255,10 @@ addLocalPackage <- function(pkgs, pkgPath, path, type = "source",
                             deps = FALSE, quiet = FALSE, build = FALSE) {
   if (is.null(path) || is.null(pkgs)) stop("path, pkgs, and pkgPath must be specified.")
 
-  stopifnot(file.exists(file.path(pkgPath)))
+  stopifnot(dir.exists(file.path(pkgPath)))
 
   # build local package if needed
-  if (build) {
+  if (isTRUE(build)) {
     stop("Building local packages has not yet been implemented.")
     if (requireNamespace("devtools", quietly = TRUE)) {
       lapply(pkgs, function(x) {
@@ -264,12 +271,13 @@ addLocalPackage <- function(pkgs, pkgPath, path, type = "source",
 
   # get list of pre-built packages for each type, filter by pkgs to be added
   sapply(type, function(t) {
-    repoPath <- file.path(path, repoPrefix(t, version))
-    files <- .listFiles(path = pkgPath, type = t)
+    repoPath <- file.path(path, repoPrefix(t, Rversion))
+    if (!dir.exists(repoPath)) dir.create(repoPath, recursive = TRUE)
+    files <- .listFiles(pkgs = pkgs, path = pkgPath, type = t)
 
     # check for previous package version and omit if identical
-    prev <- checkVersions(pkgs)
-    same <- which(basename(prev) %in% files)
+    prev <- checkVersions(pkgs, path)
+    same <- which(basename(as.character(prev)) %in% files)
 
     if (length(same)) {
       files <- files[-same]
@@ -281,8 +289,13 @@ addLocalPackage <- function(pkgs, pkgPath, path, type = "source",
 
     # copy other packages to their respective folders
     lapply(files, function(x) {
-      paste("copying", x)
-      file.copy(from = file.path(pkgPath, x), to = file.path(repoPath, x))
+      f.src <- file.path(pkgPath, x)
+      f.dst <- file.path(repoPath, x)
+
+      file.exists(f.src)
+
+      if (!isTRUE(quiet)) message("copying ", x, "\n")
+      file.copy(from = f.src, to = f.dst)
       #system(paste0("chmod a-x ", repoPath, "/", x))
     })
 

R/makeRepo.R

@@ -56,7 +56,7 @@
 makeRepo <- function(pkgs, path, repos=getOption("repos"), type="source",
                      Rversion=R.version, download=TRUE, writePACKAGES=TRUE, quiet=FALSE) {
   if(!file.exists(path)) stop("Download path does not exist")
-  
+
   downloaded <- lapply(type, function(type) {
     pkgPath <- repoBinPath(path=path, type=type, Rversion=Rversion)
     if(!file.exists(pkgPath)) {
@@ -67,20 +67,20 @@ makeRepo <- function(pkgs, path, repos=getOption("repos"), type="source",
         stop("Unable to create repo path: ", pkgPath)
       }
     }
-    
+
     pdb <- pkgAvail(repos = repos, type=type, Rversion = Rversion)
-    
+
     if(download) {
       utils::download.packages(pkgs, destdir=pkgPath, available=pdb, repos=repos,
                                contriburl = contribUrl(repos, type, Rversion),
                                type=type, quiet=quiet)
     }
   })
-  
+
   if(download){
-    
+
     downloaded <- downloaded[[1]][, 2]
-    
+
     fromLocalRepos <- grepl("^file://", repos)
     if(fromLocalRepos){
       # need to copy files to correct folder
@@ -93,7 +93,7 @@ makeRepo <- function(pkgs, path, repos=getOption("repos"), type="source",
       downloaded <- newPath
     }
   }
-  
+
   if(writePACKAGES) updateRepoIndex(path=path, type=type, Rversion=Rversion)
   if(download) downloaded else character(0)
 }
@@ -103,11 +103,11 @@ makeRepo <- function(pkgs, path, repos=getOption("repos"), type="source",
 
 #' @rdname makeRepo
 #' @export
-updateRepoIndex <- function(path, type="source", Rversion=R.version) {
+updateRepoIndex <- function(path, type = "source", Rversion = R.version) {
   n <- lapply(type, function(type){
-    pkgPath <- repoBinPath(path=path, type=type, Rversion=Rversion)
-    if(grepl("mac.binary", type)) type <- "mac.binary"
-    tools::write_PACKAGES(dir=pkgPath, type=type)
+    pkgPath <- repoBinPath(path = path, type = type, Rversion = Rversion)
+    if (grepl("mac.binary", type)) type <- "mac.binary"
+    tools::write_PACKAGES(dir = pkgPath, type = type)
   })
   names(n) <- type
   return(n)

tests/testthat/test-3-makeRepo.R

@@ -29,9 +29,9 @@ for (pkg_type in names(types)) {
     prefix <- miniCRAN:::repoPrefix(pkg_type, Rversion = rvers)
     dir.create(repo_root, recursive = TRUE, showWarnings = FALSE)
 
-    ret <- makeRepo(pkgList, path = repo_root, repos = revolution, 
-             type = pkg_type, quiet = TRUE, Rversion = rvers)
-    
+    ret <- makeRepo(pkgList, path = repo_root, repos = revolution,
+                    type = pkg_type, quiet = TRUE, Rversion = rvers)
+
     expect_is(ret, "character")
     expect_equal(length(ret), length(pkgList))
 

tests/testthat/test-4-updateRepo.R

@@ -10,7 +10,7 @@ if (file.exists(repo_root)) unlink(repo_root, recursive = TRUE)
 dir.create(repo_root, recursive = TRUE, showWarnings = FALSE)
 
 revolution <- MRAN("2014-10-15")
-if(!miniCRAN:::is.online(revolution, tryHttp = FALSE)) {
+if (!miniCRAN:::is.online(revolution, tryHttp = FALSE)) {
   # Use http:// for older versions of R
   revolution <- sub("^https://", "http://", revolution)
 }
@@ -72,12 +72,58 @@ for (pkg_type in names(types)) {
 }
 
 
+# Add local packages to repo ----------------------------------------------------
+
+pkgsAddLocal <- c("MASS")
+
+for (pkg_type in names(types)) {
+
+  context(sprintf(" - Add local packages to repo (%s)", pkg_type))
+
+  test_that(sprintf("addLocalPackage copies %s files and rebuilds PACKAGES file", pkg_type), {
+
+    skip_on_cran()
+    skip_if_offline(revolution)
+
+    tmpdir <- file.path(tempdir(), "miniCRAN", "local", pkg_type)
+    dir.create(tmpdir, recursive = TRUE); on.exit(unlink(tmpdir, recursive = TRUE))
+
+    # get most recent version
+    res <- download.packages(pkgsAddLocal, destdir = tmpdir, type = pkg_type,
+                             contriburl = contribUrl(revolution, pkg_type, rvers))
+
+    # simulate older version also present in pkgPath directory
+    f <- res[, 2]
+    file.copy(from = f, to = file.path(tmpdir, "MASS_7.3-0.tar.gz"))
+    expect_true(
+      length(list.files(tmpdir)) == 2
+    )
+
+    prefix <- miniCRAN:::repoPrefix(pkg_type, Rversion = rvers)
+
+    addLocalPackage(pkgs = pkgsAddLocal, pkgPath = tmpdir, path = repo_root, type = pkg_type,
+                    quiet = TRUE, Rversion = rvers)
+
+    expect_true(
+      miniCRAN:::.checkForRepoFiles(repo_root, pkgsAddLocal, prefix)
+    )
+    expect_true(
+      file.exists(file.path(repo_root, prefix, "PACKAGES.gz"))
+    )
+    expect_true(
+      all(
+        pkgsAddLocal %in% pkgAvail(repo_root, type = pkg_type, Rversion = rvers)[, "Package"]
+      )
+    )
+  })
+}
+
 
 # Check for updates -------------------------------------------------------
 
 
 MRAN_mirror <- MRAN("2014-12-01")
-if(!miniCRAN:::is.online(MRAN_mirror, tryHttp = FALSE)) {
+if (!miniCRAN:::is.online(MRAN_mirror, tryHttp = FALSE)) {
   # Use http:// for older versions of R
   MRAN_mirror <- sub("^https://", "http://", revolution)
 }