Use mocking to speed up tests #107

DESCRIPTION

@@ -12,7 +12,7 @@ Description: Makes it possible to create an internally consistent
     subset. The user can then install packages from this repository directly,
     rather than from CRAN.  This is useful in production settings, e.g. server
     behind a firewall, or remote locations with slow (or zero) Internet access.
-Date: 2017-12-19
+Date: 2017-12-26
 Version: 0.2.11.9000
 URL: https://github.com/andrie/miniCRAN
 BugReports: https://github.com/andrie/miniCRAN/issues
@@ -26,7 +26,8 @@ Imports:
     tools,
     utils,
     XML,
-    igraph
+    igraph,
+    mockery
 Suggests:
     devtools,
     knitr,

NAMESPACE

@@ -32,9 +32,11 @@ importFrom(methods,is)
 importFrom(stats,reshape)
 importFrom(stats,setNames)
 importFrom(tools,write_PACKAGES)
+importFrom(utils,available.packages)
 importFrom(utils,chooseCRANmirror)
 importFrom(utils,compareVersion)
 importFrom(utils,download.file)
+importFrom(utils,download.packages)
 importFrom(utils,flush.console)
 importFrom(utils,installed.packages)
 importFrom(utils,select.list)

R/addPackages.R

@@ -186,13 +186,7 @@ addOldPackage <- function(pkgs = NULL, path = NULL, vers = NULL,
 #'
 .listFiles <- function(pkgs, path, type) {
   stopifnot(dir.exists(path))
-  pattern <- switch(type,
-                    mac.binary = ".tgz",
-                    mac.binary.leopard = ".tgz",
-                    mac.binary.mavericks = ".tgz",
-                    source = ".tar.gz",
-                    win.binary = ".zip",
-                    stop("Type ", type, "not recognised."))
+  pattern <- pkgFileExt(type)
 
   # get a list of all files in pkgPaths directory matching pattern
   f <- list.files(path, pattern = pattern)
@@ -223,11 +217,10 @@ addOldPackage <- function(pkgs = NULL, path = NULL, vers = NULL,
       id.v <- which(fv == max(fv[ids.p]))
 
       f[id.v]
-    }) %>% unique()
-
-    return(fout)
+    })
+    unique(fout)
   } else {
-    return(character())
+    character()
   }
 }
 
@@ -328,5 +321,5 @@ addLocalPackage <- function(pkgs = NULL, pkgPath = NULL, path = NULL,
   # write package index for each folder:
   index <- updateRepoIndex(path = path, type = type, Rversion = Rversion)
 
-  return(invisible(index))
+  invisible(index)
 }

R/github-functions.R

@@ -11,19 +11,18 @@ pkgFileExt <- function(type) {
 }
 
 
-
 getPkgVersFromFile <- function(file) {
   file <- grep("\\.(tar\\.gz|zip|tgz)$", basename(as.character(file)), value = TRUE)
   if (length(file)) {
     file <- sapply(strsplit(file, "\\.tar\\.gz"), "[[", 1)
     file <- sapply(strsplit(file, "\\.zip"), "[[", 1)
     file <- sapply(strsplit(file, "\\.tgz"), "[[", 1)
-    pkg <- sapply(strsplit(file, "_"), "[[", 1)
+    pkg  <- sapply(strsplit(file, "_"), "[[", 1)
     vers <- sapply(strsplit(file, "_"), "[[", 2)
     df <- data.frame(package = pkg, version = vers, stringsAsFactors = FALSE)
-    return(df[order(df$package),])
+    df[order(df$package),]
   } else {
-    return(NULL)
+    NULL
   }
 }
 

R/makeRepo.R

@@ -51,6 +51,8 @@
 #'
 #' @export
 #' @family update repo functions
+#' 
+#' @importFrom utils download.packages
 #'
 #' @example /inst/examples/example_makeRepo.R
 makeRepo <- function(pkgs, path, repos = getOption("repos"), type = "source",
@@ -59,10 +61,10 @@ makeRepo <- function(pkgs, path, repos = getOption("repos"), type = "source",
 
   downloaded <- lapply(type, function(t) {
     pkgPath <- repoBinPath(path = path, type = t, Rversion = Rversion)
-    if(!file.exists(pkgPath)) {
+    if (!file.exists(pkgPath)) {
       result <- dir.create(pkgPath, recursive = TRUE, showWarnings = FALSE)
-      if(result) {
-        if(!quiet) message("Created new folder: ", pkgPath)
+      if (result) {
+        if (!quiet) message("Created new folder: ", pkgPath)
       } else {
         stop("Unable to create repo path: ", pkgPath)
       }
@@ -71,7 +73,7 @@ makeRepo <- function(pkgs, path, repos = getOption("repos"), type = "source",
     pdb <- pkgAvail(repos = repos, type = t, Rversion = Rversion)
 
     if (download) {
-      utils::download.packages(pkgs, destdir = pkgPath, available = pdb, repos = repos,
+      download.packages(pkgs, destdir = pkgPath, available = pdb, repos = repos,
                                contriburl = contribUrl(repos, t, Rversion),
                                type = t, quiet = quiet)
     }
@@ -83,7 +85,7 @@ makeRepo <- function(pkgs, path, repos = getOption("repos"), type = "source",
     ## allow for more than one repo
     fromLocalRepos <- grepl("^file://", repos)
 
-    if(any(fromLocalRepos)){
+    if (any(fromLocalRepos)) {
       # need to copy files to correct folder
       if (sum(fromLocalRepos) > 1) 
         warning("More than one local repos provided. Only the first listed will be used.")
@@ -113,7 +115,7 @@ updateRepoIndex <- function(path, type = "source", Rversion = R.version) {
     tools::write_PACKAGES(dir = pkgPath, type = t)
   })
   names(n) <- type
-  return(n)
+  n
 }
 
 
@@ -125,11 +127,5 @@ updateRepoIndex <- function(path, type = "source", Rversion = R.version) {
 makeLibrary <- function(pkgs, path, type = "source"){
   .Deprecated("makeRepo")
   NULL
-  #   if(!file.exists(path)) stop("Download path does not exist")
-  #   wd <- getwd()
-  #   on.exit(setwd(wd))
-  #   setwd(normalizePath(path))
-  #   message(getwd())
-  #   download.packages(pkgs, destdir = path, type = type)
 }
 

R/mock-makeRepo.R

@@ -0,0 +1,53 @@
+# These functions mock downloading of packages, for fast testing purposes only
+
+
+#' @importFrom utils available.packages
+mock.download.packages <- function(pkgs, destdir, available, type, ...){
+  if (missing(available) || is.null(available)) available <- available.packages()
+  downloadFileName <- function(package, version, type){
+    paste0(package, "_", version, pkgFileExt(type))
+  }
+  versions <- setNames(available[pkgs, "Version"], pkgs)
+  downloads <- mapply(names(versions), versions,
+                      USE.NAMES = FALSE, 
+                      FUN = function(p, v){
+                        fn <- file.path(destdir, downloadFileName(p, v, type))
+                        writeLines("", fn)
+                        matrix(c(p, fn), ncol = 2)
+                      }
+  ) 
+  t(downloads)
+}
+
+mock.updateRepoIndex <- function(path, type = "source", Rversion = R.version){
+  do_one <- function(t) {
+    pkg_path <- repoBinPath(path = path, type = t, Rversion = Rversion)
+    pattern <- ".tgz$|.zip$|.tar.gz$"
+    if (grepl("mac.binary", t)) t <- "mac.binary"
+    ff <- list.files(pkg_path, 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 (np > 0L) {
+      db[!is.na(db) & (db == "")] <- NA_character_
+      con <- file(file.path(pkg_path, "PACKAGES"), "wt")
+      write.dcf(db, con)
+      close(con)
+      con <- gzfile(file.path(pkg_path, "PACKAGES.gz"), "wt")
+      write.dcf(db, con)
+      close(con)
+      rownames(db) <- db[, "Package"]
+      saveRDS(db, file.path(pkg_path, "PACKAGES.rds"), compress = "xz")
+    }
+    np
+  }
+  n <- sapply(type, do_one, USE.NAMES = TRUE, simplify = FALSE)
+  names(n) <- type
+  n
+}
+

R/pkgDep.R

@@ -162,8 +162,8 @@ contribUrl <- function (repos = getOption("repos"),
     type <- "source"
   if (type == "binary") 
     type <- .Platform$pkgType
-  if (is.null(repos)) 
-    return(NULL)
+  if (is.null(repos)) return(NULL)
+
   if ("@CRAN@" %in% repos && interactive()) {
     cat(gettext("--- Please select a CRAN mirror for use in this session ---"), 
         "\n", sep = "")

R/pkgDepTools.R

@@ -36,9 +36,8 @@ split_op_version <- function (x) {
 
 # @rdname pkgDepTools
 # @keywords internal
-split_dependencies <- function (x) {
-  if (!length(x)) 
-    return(list())
+split_dependencies <- function(x) {
+  if (!length(x)) return(list())
   x <- unlist(strsplit(x, ","))
   x <- sub("[[:space:]]+$", "", x)
   x <- unique(sub("^[[:space:]]*(.*)", "\\1", x))
@@ -54,13 +53,10 @@ split_dependencies <- function (x) {
 # @rdname pkgDepTools
 # @keywords internal
 cleanPkgField <- function(val) {
-  if (is.na(val))
-    return(character(0))
+  if (is.na(val)) return(character(0))
   val <- names(split_dependencies(val))
-  if (is.null(val))
-    return(character(0))
-  val <- val[! val %in% "R"]
-  if (length(val))
-    return(val)
-  return(character(0))
+  if (is.null(val)) return(character(0))
+  val <- val[!val %in% "R"]
+  if (length(val)) return(val)
+  character(0)
 }

R/updatePackages.R

@@ -118,10 +118,10 @@ updatePackages <- function(path = NULL, repos = getOption("repos"), method, ask
     }
     if (!is.null(subset)) {
       oldPkgs <- oldPkgs[rownames(oldPkgs) %in% subset, , drop = FALSE]
-      if (nrow(oldPkgs)==0) return(invisible())
+      if (nrow(oldPkgs) == 0) return(invisible())
     }
     update <- if (is.character(ask) && ask == "graphics") {
-      if (.Platform$OS.type ==" windows" || .Platform$GUI == "AQUA" ||
+      if (.Platform$OS.type == " windows" || .Platform$GUI == "AQUA" ||
           (capabilities("tcltk") && capabilities("X11"))) {
         k <- select.list(oldPkgs[, 1L], oldPkgs[, 1L], multiple = TRUE,
                          title = "Packages to be updated", graphics = TRUE)

inst/doc/miniCRAN-dependency-graph.R

@@ -18,3 +18,43 @@ dg <- makeDepGraph(tags, enhances = TRUE, availPkgs = cranJuly2014)
 set.seed(1)
 plot(dg, legendPosition = c(-1, -1), vertex.size = 10, cex = 0.7)
 
+## ----init----------------------------------------------------------------
+library("miniCRAN")
+
+## ----pkgdep--------------------------------------------------------------
+tags <- "chron"
+pkgDep(tags, availPkgs = cranJuly2014)
+
+## ----makeDepGraph, warning=FALSE-----------------------------------------
+dg <- makeDepGraph(tags, enhances = TRUE, availPkgs = cranJuly2014)
+set.seed(1)
+plot(dg, legendPosition = c(-1, 1), vertex.size = 20)
+
+## ----so-tags, warning=FALSE, fig.width=10, fig.height=10-----------------
+tags <- c("ggplot2", "data.table", "plyr", "knitr", "shiny", "xts", "lattice")
+pkgDep(tags, suggests = TRUE, enhances = FALSE, availPkgs = cranJuly2014)
+
+dg <- makeDepGraph(tags, enhances = TRUE, availPkgs = cranJuly2014)
+set.seed(1)
+plot(dg, legendPosition = c(-1, -1), vertex.size = 10, cex = 0.7)
+
+## ----init----------------------------------------------------------------
+library("miniCRAN")
+
+## ----pkgdep--------------------------------------------------------------
+tags <- "chron"
+pkgDep(tags, availPkgs = cranJuly2014)
+
+## ----makeDepGraph, warning=FALSE-----------------------------------------
+dg <- makeDepGraph(tags, enhances = TRUE, availPkgs = cranJuly2014)
+set.seed(1)
+plot(dg, legendPosition = c(-1, 1), vertex.size = 20)
+
+## ----so-tags, warning=FALSE, fig.width=10, fig.height=10-----------------
+tags <- c("ggplot2", "data.table", "plyr", "knitr", "shiny", "xts", "lattice")
+pkgDep(tags, suggests = TRUE, enhances = FALSE, availPkgs = cranJuly2014)
+
+dg <- makeDepGraph(tags, enhances = TRUE, availPkgs = cranJuly2014)
+set.seed(1)
+plot(dg, legendPosition = c(-1, -1), vertex.size = 10, cex = 0.7)
+

inst/doc/miniCRAN-dependency-graph.html

@@ -12,7 +12,7 @@
 
 <meta name="author" content="Andrie de Vries" />
 
-<meta name="date" content="2017-12-19" />
+<meta name="date" content="2017-12-26" />
 
 <title>Using miniCRAN to identify package dependencies</title>
 
@@ -70,7 +70,7 @@
 
 <h1 class="title toc-ignore">Using miniCRAN to identify package dependencies</h1>
 <h4 class="author"><em>Andrie de Vries</em></h4>
-<h4 class="date"><em>December 19, 2017</em></h4>
+<h4 class="date"><em>December 26, 2017</em></h4>