Function deletePackage added

DESCRIPTION

@@ -3,7 +3,8 @@ Date: 2018-06-22
 Version: 0.2.11.9000
 Authors@R: c(person("Microsoft Corporation", role="cph"), person("Andrie", "de
     Vries", role=c("aut", "cre", "cph"), email="[email protected]"),
-    person("Alex", "Chubaty", role="ctb", email="[email protected]"))
+    person("Alex", "Chubaty", role="ctb", email="[email protected]"),
+    person("Anton", "Antonov", role="ctb", email="[email protected]"))
 License: GPL-2
 Copyright: Microsoft Corporation, Andrie de Vries
 Title: Create a Mini Version of CRAN Containing Only Selected Packages

NAMESPACE

@@ -8,6 +8,7 @@ export(addPackage)
 export(addPackageListingGithub)
 export(basePkgs)
 export(checkVersions)
+export(deletePackage)
 export(getCranDescription)
 export(makeDepGraph)
 export(makeLibrary)

NEWS

@@ -1,8 +1,8 @@
 miniCRAN v0.2.11.9000 (Dev)
 ================
 
-New features: 
-* None
+New features:
+* Added `deletePackage` to remove packages and their dependencies (#81)
 
 Bug fixes:
 * Experimental support for mac.binary.el-capitan (#111)
@@ -18,7 +18,7 @@ Internal changes
 miniCRAN v0.2.11 (Release date: 2018-01-15)
 ================
 
-New features: 
+New features:
 * None
 
 Bug fixes:

R/addPackages.R

@@ -35,14 +35,14 @@ checkVersions <- function(pkgs = NULL, path = NULL, type = "source",
     }
     files <- unlist(files)
     pkgFiles <- grep("\\.(tar\\.gz|zip|tgz)$", basename(files), value = TRUE)
-    
+
     # identify duplicate packages and warn the user
     pkgs <- sapply(strsplit(files, "_"), "[[", 1)
     dupes <- pkgs[duplicated(pkgs)]
     if (length(dupes)) warning("Duplicate package(s): ", paste(dupes, collapse = ", "))
     file.path(pkgPath, pkgFiles)
   }
-  
+
   duplicatePkgs <- sapply(type, do_one, simplify = FALSE)
   names(duplicatePkgs) <- type
   duplicatePkgs
@@ -78,23 +78,23 @@ addPackage <- function(pkgs = NULL, path = NULL, repos = getOption("repos"),
     prev <- checkVersions(pkgs = pkgs, path = path, type = t, Rversion = Rversion)
     prev <- prev[[1]]
     prev.df <- getPkgVersFromFile(prev)
-    
+
     if (deps) pkgs <- pkgDep(pkgs, repos = repos, type = t, Rversion = Rversion)
-    
+
     makeRepo(pkgs = pkgs, path = path, repos = repos, type = t, Rversion = Rversion,
              download = TRUE, writePACKAGES = FALSE, quiet = quiet)
-    
+
     if (length(prev)) {
       curr <- suppressWarnings(
         checkVersions(pkgs = pkgs, path = path, type = t, Rversion = Rversion)
       )
       curr <- curr[[1]]
       curr.df <- getPkgVersFromFile(curr)
-        
+
       findPrevPackage <- function(x) {
-        grep(paste0("^", x), basename(prev)) 
+        grep(paste0("^", x), basename(prev))
         }
-      
+
       dupes <- with(curr.df, package[duplicated(package)])
       if (length(dupes)) {
         to_remove <- lapply(dupes, findPrevPackage)
@@ -154,14 +154,14 @@ addOldPackage <- function(pkgs = NULL, path = NULL, vers = NULL,
 
   pkgPath <- repoBinPath(path = path, type = type, Rversion = Rversion)
   if (!file.exists(pkgPath)) dir.create(pkgPath, recursive = TRUE)
-  
+
   do_one <- function(x) {
     result <- download.file(x, destfile = file.path(pkgPath, basename(x)),
                                    method = "auto", mode = "wb", quiet = quiet)
     if (result != 0) warning("error downloading file ", x)
   }
   sapply(oldPkgs, do_one)
-  if (writePACKAGES) invisible(updateRepoIndex(path = path, type = type, Rversion))
+  if (writePACKAGES) invisible(updateRepoIndex(path = path, type = type, Rversion = Rversion))
 }
 
 
@@ -200,15 +200,15 @@ addOldPackage <- function(pkgs = NULL, path = NULL, vers = NULL,
       x <- strsplit(f, "_")
       sapply(x, `[[`, 1)
     })
-    
+
     fv <- local({
       x <- strsplit(f, "_")
       x <- sapply(x, `[[`, 2)
       x <- strsplit(x, pattern)
       x <- sapply(x, `[[`, 1)
       as.numeric_version(x)
     })
-    
+
     fout <- sapply(fp, function(x) {
       ids.p <- which(fp %in% x)
 
@@ -319,7 +319,5 @@ addLocalPackage <- function(pkgs = NULL, pkgPath = NULL, path = NULL,
   })
 
   # write package index for each folder:
-  index <- updateRepoIndex(path = path, type = type, Rversion = Rversion)
-
-  invisible(index)
+  if (writePACKAGES) invisible(updateRepoIndex(path = path, type = type, Rversion = Rversion))
 }

R/deletePackages.R

@@ -0,0 +1,50 @@
+#' Delete packages from a miniCRAN repository.
+#' @inheritParams addPackage
+#' @param deps logical indicating whether the package reverse dependencies should be removed (default `TRUE`).
+#' @param ... arguments passed over to `tools::package_dependencies`: use `which`, `recursive`, `reverse`
+#' to specify what should happen to dependencies of removed packages
+#' @export
+#' @family update repo functions
+deletePackage <- function(pkgs = NULL, path = NULL,
+                          type = "source", Rversion = R.version,
+                          writePACKAGES = TRUE, deps = TRUE, ...) {
+  if (is.null(path) || is.null(pkgs)) stop("path and pkgs must both be specified.")
+
+  sapply(type, function(t) {
+    repoPath <- file.path(path, repoPrefix(t, Rversion))
+    db <- pkgAvail(repos = path, type = t, Rversion = Rversion)
+    purgePackage(pkgs, db, t, repoPath)
+
+    if (deps) {
+      d <- tools::package_dependencies(db = db, ...)
+      depends <- unique(unlist(lapply(pkgs, function(pkg) {
+        if (!is.null(d[[pkg]])) d[[pkg]] else character()
+      })))
+      l <- list(...)
+      if ('reverse' %in% names(l)) {
+        # Check for needed packages, which uses direct dependencies
+        l[['reverse']] <- FALSE
+        l[['db']] <- db
+        d <- do.call(tools::package_dependencies, l)
+      }
+      needed <- unique(unlist(d[!names(d) %in% c(pkgs, depends)]))
+
+      toRemoveDeps <- depends[!depends %in% needed]
+      if (length(toRemoveDeps)) {
+        purgePackage(toRemoveDeps, db, t, repoPath)
+      }
+    }
+  })
+
+  if (writePACKAGES) invisible(updateRepoIndex(path = path, type = type, Rversion = Rversion))
+}
+
+# given packages, reconstruct file names and remove these files
+purgePackage <- function(pkgs, db, type, repoPath) {
+  w <- which(db[, "Package"] %in% pkgs)
+
+  if (length(w)) {
+    toRemove <- paste0(db[w, "Package"], "_", db[w, "Version"], pkgFileExt(type))
+    file.remove(file.path(repoPath, toRemove))
+  }
+}

tests/testthat/helpers.R

@@ -61,18 +61,20 @@ mock_download_packages <- function(pkgs, destdir, available, type, ...) {
   t(downloads)
 }
 
-mock_write_packages <- function(dir, type = "source") {
+mock_write_packages <- function(dir, type = "source", db = NULL) {
   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 (is.null(db)) {
+    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")
@@ -100,18 +102,18 @@ mock_write_packages <- function(dir, type = "source") {
 
   pkgList_source <- pkgDep(pkgs, availPkgs = pdb_source, repos = MRAN,
                            type = "source", suggests = FALSE, Rversion = Rversion)
-  
+
   makeRepo(pkgList_source, path = path, repos = MRAN,
            type = "source",
            quiet = TRUE, Rversion = Rversion)
-  
+
   pkgList_win <- pkgDep(pkgs, availPkgs = pdb_win, repos = MRAN,
                         type = "win.binary",
                         suggests = FALSE, Rversion = Rversion)
   makeRepo(pkgList_win, path = path, repos = MRAN,
            type = "win.binary",
            quiet = TRUE, Rversion = Rversion)
-  
+
   pkgList_mac <- pkgDep(pkgs, availPkgs = pdb_mac, repos = MRAN,
                         type = "mac.binary",
                         suggests = FALSE, Rversion = Rversion)