Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Feature/dev packages #78

Open
wants to merge 7 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,8 @@ Imports:
utils
Suggests:
MASS,
testthat
testthat,
devtools
LazyData: yes
ByteCompile: yes
Version: 1.6
4 changes: 3 additions & 1 deletion R/Packages.R
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,9 @@
addRegistryPackages = function(reg, packages) {
checkRegistry(reg)
assertCharacter(packages, any.missing = FALSE)
packages = setNames(lapply(packages, function(pkg) list(version = packageVersion(pkg))), packages)
# load packages (this forces source packages to be loaded)
packages <- requirePackages(packages, stop = TRUE, suppress.warnings = TRUE, default.method = "attach")
packages = setNames(lapply(packages, function(pkg) list(version = packageVersion(pkg))), names(packages))
p = c(reg$packages, packages)
p = p[unique(names(p))]
reg$packages = p
Expand Down
26 changes: 23 additions & 3 deletions R/Registry.R
Original file line number Diff line number Diff line change
@@ -1,3 +1,19 @@
# internal overloading wrapper for BBmisc::requirePackages
requirePackages <- function(pkg, ...){

sapply(pkg, function(pkgname, ...){
# pre-load source packages
if( grepl("^[~./\\]", pkgname) ){
a <- devtools::load_all(pkgname, reset = FALSE) # reset = FALSE is very important
pkgname <- packageName(a$env)
}
# standard require
BBmisc::requirePackages(pkgname, ...)
pkgname
}, ...)

}

makeRegistryInternal = function(id, file.dir, sharding, work.dir,
multiple.result.files, seed, packages, src.dirs, src.files) {

Expand All @@ -20,7 +36,7 @@ makeRegistryInternal = function(id, file.dir, sharding, work.dir,

assertCharacter(packages, any.missing = FALSE)
packages = union(packages, "BatchJobs")
requirePackages(packages, stop = TRUE, suppress.warnings = TRUE, default.method = "attach")
packages <- requirePackages(packages, stop = TRUE, suppress.warnings = TRUE, default.method = "attach")

assertCharacter(src.dirs, any.missing = FALSE)
src.dirs = sanitizePath(src.dirs, make.absolute = FALSE)
Expand All @@ -42,7 +58,7 @@ makeRegistryInternal = function(id, file.dir, sharding, work.dir,
checkDir(getExportDir(file.dir), create = TRUE, check.empty = TRUE)
sourceRegistryFilesInternal(work.dir, src.dirs, src.files)

packages = setNames(lapply(packages, function(pkg) list(version = packageVersion(pkg))), packages)
packages = setNames(lapply(packages, function(pkg) list(version = packageVersion(pkg))), names(packages))

setClasses(list(
id = id,
Expand Down Expand Up @@ -95,13 +111,17 @@ makeRegistryInternal = function(id, file.dir, sharding, work.dir,
#' Default is a random number from 1 to \code{.Machine$integer.max/2}.
#' @param packages [\code{character}]\cr
#' Packages that will always be loaded on each node.
#' Path to source package directories may also be specified (strings starting with
#' a \code{.}, \code{/} , \code{~} or \code{\\} are considered package directory specifications).
#' Default is \code{character(0)}.
#' @param src.dirs [\code{character}]\cr
#' Directories containing R scripts
#' Directories containing R scripts or source packages
#' to be sourced on registry load (both on slave and master).
#' Files not matching the pattern \dQuote{\\.[Rr]$} are ignored.
#' Useful if you have many helper functions that are needed during the execution of your jobs.
#' These files should only contain function definitions and no executable code.
#' Source package directory must contain a valid DESCRIPTION file and are loaded with
#' \code{\link[devtools]{load_all}}.
#' Default is \code{character(0)}.
#' @param src.files [\code{character}]\cr
#' R scripts files
Expand Down
21 changes: 20 additions & 1 deletion R/sourceRegistryFiles.R
Original file line number Diff line number Diff line change
Expand Up @@ -23,12 +23,31 @@ sourceRegistryFilesInternal = function(work.dir, dirs, files, envir = .GlobalEnv
if (length(w))
stopf("Files to source not found, e.g. %s", files[w])

w = !isPathFromRoot(dirs)
w = !isPathFromRoot(dirs) & !grepl("^~", dirs)
dirs[w] = file.path(work.dir, dirs[w])
w = which.first(!isDirectory(dirs))
if (length(w))
stopf("Directories to source not found, e.g. %s", dirs[w])

# detect source package directories
if( length(dirs) ){
wpkg <- which(sapply(file.path(dirs, 'DESCRIPTION'), file.exists))
if( length(wpkg) ){
# setup temporary directory to hold package loading script
tmpdir <- tempfile('BatchJobs_load_all_')
dir.create(tmpdir)
on.exit( unlink(tmpdir, recursive = TRUE) )
# generate loading scripts
lapply(dirs[wpkg], function(d){
cat(sprintf("# load source package\ndevtools::load_all('%s', reset = TRUE)\n", d)
, file = tempfile(paste0(basename(d), '_'), tmpdir, fileext = ".R"))
})
# remove directory from list and add temporary load_all directory
dirs <- c(dirs[-wpkg], tmpdir)
}
}
##

lapply(c(getRScripts(dirs), files), sys.source, envir = envir)
invisible(TRUE)
}
Expand Down