Nothing
R/pkg_build.R
In rfTools: R-Forge Build and Check Tools
## Package Build Infrastructure for R-Forge
## Author: Stefan Theussl
## Constructor for R-Forge control files
rf_build_control <- function(path_to_pkg_src, path_to_pkg_log, path_to_pkg_root,
path_to_local_texmf, path_to_local_library,
path_to_local_pkg_libs, stoplist,
mail_domain_name_of_sender, mail_relay_server,
mail_programme = "mail",
path_to_check_dir = "",
cpu_time_limit = 600){
structure(list(cpu_time_limit = cpu_time_limit,
mail_domain_name_of_sender = mail_domain_name_of_sender,
mail_programme = mail_programme,
mail_relay_server = mail_relay_server,
path_to_check_dir = path_to_check_dir,
path_to_local_library = path_to_local_library,
path_to_local_pkg_libs = path_to_local_pkg_libs,
path_to_local_texmf = path_to_local_texmf,
path_to_pkg_log = path_to_pkg_log,
path_to_pkg_root = path_to_pkg_root,
path_to_pkg_src = path_to_pkg_src,
stoplist = stoplist),
class = "rf_build_control")
}
is.rf_build_control <- function(x)
inherits(x, "rf_build_control")
rf_takeover_prepared_build <- function(stmp, build_root, type = "src"){
stopifnot( type %in% c("src", "mac", "win") )
## take the oldest available for build
if(type == "src"){
btgz <- grep("^build_.*?.tar.gz$", dir(stmp), value = TRUE)
} else {
btgz <- grep("^SRC.build_.*?.tar.gz$", dir(stmp), value = TRUE)
}
## if no build to take up -> exit
if( any(is.na(btgz)) )
return(NULL)
if( !length(btgz) )
return(NULL)
check_tgz <- function(btgz){
## rename it to *.processing or create lock file .processing.<OStype>
ptgz <- switch(type,
"src" = paste(btgz, "processing", sep = "."),
"mac" = paste(btgz, "processing", "MAC", sep = "."),
"win" = paste(btgz, "processing", "WIN", sep = ".") )
## if given submission is already being processed exit and return NULL
if( file.exists(file.path(stmp, ptgz)) )
return( NULL )
## submission already processed
if( type == "mac" && file.exists(file.path(stmp, gsub("SRC.", "MAC.", btgz))) )
return( NULL )
if( type == "win" && file.exists(file.path(stmp, gsub("SRC.", "WIN.", btgz))) )
return( NULL )
ptgz
}
ptgz <- lapply( btgz, check_tgz)
nn <- !unlist(lapply(ptgz, is.null))
if (!any(nn))
return(NULL)
btgz <- btgz[nn][1]
ptgz <- unlist(ptgz[nn])[1]
if(type == "src"){
file.rename( file.path(stmp, btgz), file.path(stmp, ptgz) )
} else {
file.create( file.path(stmp, ptgz) )
}
## uncompress staging area
TAR <- Sys.getenv("TAR")
WINDOWS <- .Platform$OS.type == "windows"
if (!nzchar(TAR)) {
TAR <- if (WINDOWS)
"tar --no-same-owner --force-local"
else "internal"
}
if( type == "src" ){
res <- utils::untar( file.path(stmp, ptgz), compressed = "gzip", tar = TAR, exdir = build_root)
} else {
res <- utils::untar( file.path(stmp, btgz), compressed = "gzip", tar = TAR, exdir = build_root)
}
if (res) {
stop("unpackaging staging area failed.")
}
## src_dir
if( type == "src" ){
src_dir <- gsub( ".tar.gz.processing", "", ptgz )
} else {
src_dir <- gsub( "SRC.", "", gsub(".tar.gz", "", btgz) )
}
src_dir
}
## TODO LIST (there are more points in Uwe's functions):
## file URLs of local mirrors: contriburl = sprintf("file:///%s", dir)
## do not download from cran.r-project.org
## should we include a tmp directory
## if so a cleanup is necessary
## Clean /tmp dir
## system("rm -rf c:\\tmp\\*")
## this is where the work is done
## takes a control object containing control parameters, the platform,
## architecture, ... as arguments
rf_build_packages <- function(pkg_status,
platform = c("Linux", "Windows", "MacOSX"),
architecture = c("x86_32", "x86_64"),
rforge_url = "http://R-Forge.R-project.org",
cran_url = "http://CRAN.R-project.org",
bioc_url =
"http://bioconductor.org/packages/release/bioc",
bioc_data =
"http://bioconductor.org/packages/release/data/annotation",
bioc_experiment=
"http://bioconductor.org/packages/release/data/experiment",
omega_hat_url = "http://www.omegahat.net/R",
control = list(),
Ncpus = 1L){
if( !is.rf_build_control(control) )
stop("No R-Forge build control object given")
## INITIALIZATION
writeLines("Start build process ...")
## match arguments
## FIXME: automatically use info from .Platform?
platform <- match.arg(platform)
architecture <- match.arg(architecture)
maj.version <- paste(R.Version()$maj,
unlist(strsplit(R.Version()$min, "[.]"))[1], sep=".")
## x86_32 on x86_64 allowed but not the other way round
if((architecture=="x86_64") && (.Machine$sizeof.pointer == 4))
stop("Building x86_64 binaries not possible on an x86_32 architecture")
## check for necessary directories---create them if possible
path_to_pkg_src <- control$path_to_pkg_src
path_to_pkg_log <- control$path_to_pkg_log
path_to_pkg_root <- control$path_to_pkg_root
path_to_local_library <- control$path_to_local_library
path_to_local_pkg_libs <- control$path_to_local_pkg_libs
stoplist <- control$stoplist
## local package library
if(!check_directory(path_to_local_library, fix=TRUE))
stop(paste("There is no directory", path_to_local_library,"!"))
## R-Forge package sources
if(!check_directory(path_to_pkg_src))
stop("Directory", path_to_pkg_src, "missing!")
## test for build log dir and clean it
check_log_directory(path_to_pkg_log, type = "build")
## check if package root directory (the directory containing
## the src/contrib or bin/windows/contrib) exists.
if(!check_directory(path_to_pkg_root, fix=TRUE))
stop(paste("There is no directory", dir,"!"))
## local pkg libraries for forced R-Forge depends
if(!check_directory( path_to_local_pkg_libs, fix=TRUE))
stop(paste("There is no directory", dir,"!"))
## get current working directory -> set back at FINALIZATION step
old_wd <- getwd()
## PACKAGE SIGHTING
## STOP LIST: packages which should not be compiled
## BLACK_LIST: packages which cause severe problems (removed from R CMD build)
## TODO: blacklist hardcoded at the moment
blacklist <- c("RepitoolsExamples")
## FIXME: probably too strict at the moment. E.g., RWinEdt does not get build
## when checking packages the stoplist includes additional arguments to check
## process
if(file.exists(stoplist)){
check_args <- read.csv(stoplist, stringsAsFactors = FALSE)
}else check_args <- NULL
## for Linux builds we don't want to build vignettes when checkargs have:
no_install <- check_args[ grep("--install=no",
check_args[["check_args"]]), "Package" ]
fake_install <- check_args[ grep("--install=fake",
check_args[["check_args"]]), "Package" ]
no_vignettes <- check_args[ grep("--no-vignettes",
check_args[["check_args"]]), "Package" ]
## donotcompile <- no_install
donotcompile <- blacklist
if(platform %in% c("Windows", "MacOSX")){
donotcompile <- unique(c(donotcompile, no_install))
}
if( length(donotcompile) ){
for(pkg in donotcompile){
arch <- "all"
if(platform %in% c("Windows", "MacOSX")){
arch <- architecture
}
pkg_buildlog <- get_buildlog(path_to_pkg_log, pkg,
platform, architecture = arch)
write_stoplist_notification(pkg, pkg_buildlog, "build", std.out = TRUE)
}
}
## set up CONTRIB directory
## If we use a BINARY distribution like WINDOWS or MAC we have to append
## the major version of R to the contrib directory otherwise use /src/contrib
if(platform == "Windows"){
path_to_contrib_dir <- file.path(path_to_pkg_root, "bin", .Platform$OS.type,
"contrib", maj.version)
}else if(platform == "MacOSX"){
macosx_branch <- c(x86_64="leopard", x86_32="universal")
path_to_contrib_dir <- file.path(path_to_pkg_root, "bin", "macosx",
macosx_branch[architecture],
"contrib", maj.version)
}else {
## UNIX SOURCE directory (./src/contrib)
path_to_contrib_dir <- contrib.url(path_to_pkg_root, type = "source")
}
if(!check_directory(path_to_contrib_dir, fix=TRUE, recursive=TRUE))
stop(paste("There is no directory", path_to_contrib_dir,"!"))
if(platform != "Linux"){
## sources to be considered in dependency check
URL_pkg_sources <- contrib.url(sprintf("file:%s", path_to_pkg_root),
type = "source")
avail_src_pkgs <- utils::available.packages(URL_pkg_sources)
pkgs <- remove_excluded_pkgs(rownames(avail_src_pkgs), donotcompile)
} else {
## Packages exported from R-Forge's SVN repositories
pkgs_all <- utils::available.packages(contriburl =
sprintf("file://%s", path_to_pkg_src), filters = "duplicates")[, 1]
## Sort out packages that are on the exclude list
pkgs <- remove_excluded_pkgs(pkgs_all, donotcompile)
## sources to be considered in dependency check
URL_pkg_sources <- sprintf("file://%s", path_to_pkg_src)
}
## PACKAGE DB UPDATE
## FIXME: is it sufficient what we are doing here?
other_repositories <- NULL
if(platform == "Windows"){
## include Brian Ripley's Windows Repository
other_repositories <- "http://www.stats.ox.ac.uk/pub/RWin"
}
update_package_library(c(pkgs), URL_pkg_sources, c(cran_url,
c(bioc_url, bioc_data, bioc_experiment),
omega_hat_url,
other_repositories),
path_to_local_library, path_to_local_pkg_libs, platform, Ncpus = Ncpus, rforge_url = rforge_url)
##############################################################################
## LAST PREPARATION STEPS BEFORE PACKAGE BUILDING
##############################################################################
## change to directory where the sources of R-Forge are in
setwd(path_to_pkg_src)
## delete 00LOCK, sometimes this interrupted the build process ...
check_local_library(path_to_local_library)
## where is our R binary?
R <- file.path( R.home(), "bin", "R" )
if( platform == "Windows" )
R <- file.path(R.home(), "bin", "x64", "R")
## Set environment variables which are necessary for building
## (or creating vignettes)
Sys.setenv(R_LIBS = path_to_local_library)
## Set TEXMFLOCAL environment variables in case we have
## personalized style files (building vignettes)
path_to_local_texmf <- control$path_to_local_texmf
if(file.exists(path_to_local_texmf))
Sys.setenv(TEXMFLOCAL=path_to_local_texmf)
##############################################################################
## PACKAGE BUILDING
##############################################################################
## LINUX BUILDS ##############################################################
if(platform == "Linux"){
## We need a virtual framebuffer
pid <- start_virtual_X11_fb()
no_build_vignettes <- c(no_vignettes, no_install, fake_install)
build_src <- function(pkg, architecture, avail_src_pkgs, no_build_vignettes, path_to_pkg_log, pkg_status, platform, R){
## Prolog
pkg_buildlog <- rfTools:::get_buildlog(path_to_pkg_log, pkg, platform, architecture = "all")
rfTools:::write_prolog(pkg, pkg_buildlog, pkg_status,
type = "build", what = "tarball", std.out = TRUE)
build_args <- if( pkg %in% no_build_vignettes)
"--no-build-vignettes"
else
""
## timer start
proc_start <- proc.time()
## build tarball from sources
.build_tarball_from_sources_linux(pkg, R, pkg_buildlog, build_args)
## Epilog and timings
timing <- c(proc.time() - proc_start)["elapsed"]
write_epilog(pkg_buildlog, timing, std.out = TRUE)
timing
}
if(Ncpus > 1L){
timings <- parallel::mclapply(pkgs, FUN = build_src, architecture, avail_src_pkgs, no_build_vignettes, path_to_pkg_log, pkg_status, platform, R, mc.cores = Ncpus)
timings <- structure( unlist(timings), names = pkgs )
} else {
## Initialize timings
timings <- numeric(length(pkgs))
names(timings) <- pkgs
for(pkg in pkgs)
timings[pkg] <- build_src(pkg, architecture, avail_src_pkgs, no_build_vignettes, path_to_pkg_log, pkg_status, platform, R)
}
## Cleanup
close_virtual_X11_fb(pid)
}else{
## BINARIES ##########################################################
## Get additional build flags based on Uwe's lists
## merge-multiarch
mma_list <- character()
con <- tryCatch(url("http://developer.r-project.org/CRAN/QA/Uwe/make/config/MergeMultiarch", open = "r"), error = identity)
if(! inherits(con, "error")){
mma_list <- unique(c(mma_list, readLines(con)))
close(con)
}
## force-biarch
fb_list <- character()
con <- tryCatch(url("http://developer.r-project.org/CRAN/QA/Uwe/make/config/ForceBiarch", open = "r"), error = identity)
if(! inherits(con, "error")){
fb_list <- tryCatch( readLines(con), error = function(x) NA)
close(con)
}
## R-Forge (">=") dependencies installed to pkg_libs
pkg_libs <- NULL
if( file.exists(path_to_local_pkg_libs) )
pkg_libs <- list.files(path_to_local_pkg_libs)
## WINDOWS BUILDS ##########################################################
if(platform == "Windows"){
## Initialize timings
timings <- numeric(length(pkgs))
names(timings) <- pkgs
for( pkg in pkgs ){
## Prolog
pkg_buildlog <- get_buildlog(path_to_pkg_log, pkg, platform, architecture)
write_prolog(pkg, pkg_buildlog, pkg_status,
type = "build", what = "binary", std.out = TRUE)
## BUILD
## timer start
proc_start <- proc.time()
## get current package version (tarball, thus svn in pkg!)
pkg_version_src <- avail_src_pkgs[pkg, "Version"]
mergemultiarch <- FALSE
forcebiarch <- FALSE
build_in_pkglib <- FALSE
if(pkg %in% mma_list)
mergemultiarch <- TRUE
if(pkg %in% fb_list)
forcebiarch <- TRUE
if(pkg %in% pkg_libs)
build_in_pkglib <- TRUE
## now build the package from package tarball
.build_binary_from_tarball_win(pkg,
pkg_version_src,
path_to_pkg_root,
R,
pkg_buildlog,
pkg_libs = path_to_local_pkg_libs,
mergemultiarch = mergemultiarch,
forcebiarch = forcebiarch,
build_in_pkglib = build_in_pkglib
)
## save timing
timings[pkg] <- c(proc.time() - proc_start)["elapsed"]
## Epilog
write_epilog(pkg_buildlog, timings[pkg], std.out = TRUE)
}
## Cleanup
## delete 00LOCK, sometimes this interrupted the build process ...
check_local_library(path_to_local_library)
## MacOSX BUILDS ###########################################################
}else if(platform == "MacOSX"){
## We need a virtual framebuffer
pid <- start_virtual_X11_fb()
## BUILDING FROM PKG TARBALLS
build_bin_mac <- function(pkg, architecture, avail_src_pkgs, path_to_pkg_log, path_to_pkg_root, pkg_status, platform, R, path_to_local_pkg_libs, pkg_libs){
## Prolog
pkg_buildlog <- rfTools:::get_buildlog(path_to_pkg_log, pkg, platform, architecture)
rfTools:::write_prolog(pkg, pkg_buildlog, pkg_status,
type = "build", what = "binary", std.out = TRUE)
## timer start
proc_start <- proc.time()
mergemultiarch <- FALSE
forcebiarch <- FALSE
build_in_pkglib <- FALSE
if(pkg %in% mma_list)
mergemultiarch <- TRUE
if(pkg %in% fb_list)
forcebiarch <- TRUE
if(pkg %in% pkg_libs)
build_in_pkglib <- TRUE
## now build the package from package tarball
rfTools:::.build_binary_from_tarball_mac( pkg,
avail_src_pkgs[pkg, "Version"],
path_to_pkg_root,
R,
pkg_buildlog,
pkg_libs = path_to_local_pkg_libs,
mergemultiarch = mergemultiarch,
forcebiarch = forcebiarch,
build_in_pkglib = build_in_pkglib)
## Epilog and timings
timing <- c(proc.time() - proc_start)["elapsed"]
write_epilog(pkg_buildlog, timing, std.out = TRUE)
timing
}
if(Ncpus > 1L){
timings <- parallel::mclapply(pkgs, FUN = build_bin_mac, architecture, avail_src_pkgs, path_to_pkg_log, path_to_pkg_root, pkg_status, platform, R, path_to_local_pkg_libs, pkg_libs, mc.cores = Ncpus)
timings <- structure( unlist(timings), names = pkgs )
} else {
## Initialize timings
timings <- numeric(length(pkgs))
names(timings) <- pkgs
for(pkg in pkgs)
timings[pkg] <- build_bin_mac(pkg, architecture, avail_src_pkgs, path_to_pkg_log, path_to_pkg_root, pkg_status, platform, R, path_to_local_pkg_libs, pkg_libs)
}
## Cleanup: close framebuffer
close_virtual_X11_fb(pid)
} else stop(paste("Strange platform: ", platform, "! I'm confused ...",
sep = ""))
}
## FINAL STEPS
writeLines("Send email to R-Forge maintainer and cleanup ...")
## provide built packages in corresponding contrib dir
pkgs_provided <- provide_packages_in_contrib(path_to_pkg_src,
path_to_contrib_dir, platform)
## send email to R-Forge maintainer which packages successfully were built
## FIXME: make a log file for later examination
#notify_admins(pkgs_provided, donotcompile, email, platform, control,
# about = "build", timings = timings)
## go back to old working directory
setwd(old_wd)
writeLines("Done.")
invisible(TRUE)
}
## OS: Linux (would also work on other POSIX systems?)
## input: uncompressed package sources (the exported pkg directories)
## output: compressed package sources <package_name>_<version>.tar.gz
## FIXME: currently sources and resulting tarball are in the current working dir
## Changelog 2011-04-28: --compact-vignettes --resave-data=best added to save disk space
.build_tarball_from_sources_linux <- function(pkg, R, pkg_buildlog, build_args = ""){
files <- Sys.glob(c(file.path(pkg, "data", "*.rda"), file.path(pkg, "data", "*.RData"), file.path(pkg, "R", "sysdata.rda")))
rdas <- tools::checkRdaFiles(files)
if(!all(rdas$compress %in% c("bzip2", "xz")))
build_args <- sprintf("--resave-data=best %s", build_args)
system(paste(R, "CMD build --compact-vignettes", build_args, pkg,
">>", pkg_buildlog, "2>&1"))
pkg_version <- get_package_version_from_sources(pkg)
invisible(paste(pkg, "_", pkg_version, ".tar.gz", sep = ""))
}
.copy_tarball_from_repository <- function(pkg, pkg_root, pkg_src,
pkg_version, pkg_buildlog){
cat("Package up to date. Not building ...\n", file = pkg_buildlog,
append = TRUE)
file.copy(file.path(pkg_root, paste(pkg, "_", pkg_version, ".tar.gz",
sep = "")), pkg_src, overwrite = TRUE)
}
.copy_binary_from_repository <- function(pkg, pkg_root, pkg_src,
pkg_version, pkg_buildlog){
cat("Package up to date. Not building ...\n", file = pkg_buildlog,
append = TRUE)
## FIXME: is there an easier way to retrieve the file suffix?
filesuffix <- ifelse( .Platform$OS.type == "unix", ".tgz", ".zip")
file.copy(file.path(pkg_root, paste(pkg, "_", pkg_version, filesuffix,
sep = "")), pkg_src, overwrite = TRUE)
}
## OS: Windows
## input: package tarball (<package_name>_<version>.tar.gz)
## output: compressed package binary <package_name>_<version>.zip
## FIXME: currently sources and resulting tarball are in the current working dir
.build_binary_from_tarball_win <- function(pkg, pkg_version, path_to_pkg_tarballs, R, pkg_buildlog, pkg_libs, mergemultiarch = FALSE, forcebiarch = FALSE, build_in_pkglib = FALSE){
Rbuild <- paste(R, "CMD", "INSTALL --build")
if( mergemultiarch )
Rbuild <- paste(Rbuild, "--merge-multiarch")
if( forcebiarch )
Rbuild <- paste(Rbuild, "--force-biarch")
if( build_in_pkglib )
Rbuild <- paste(Rbuild, sprintf("--library=%s", file.path(pkg_libs, pkg)))
shell(paste(Rbuild,
file.path(path_to_pkg_tarballs, "src", "contrib",
paste(pkg, "_", pkg_version, ".tar.gz", sep = "")),
">>", pkg_buildlog, "2>&1"), invisible = TRUE, shell = "cmd")
invisible(paste(pkg, "_", pkg_version, ".zip", sep = ""))
}
## OS: Mac OS X
## input: package tarball (<package_name>_<version>.tar.gz)
## output: compressed package binary <package_name>_<version>.tgz
## FIXME: currently sources and resulting tarball are in the current working dir
.build_binary_from_tarball_mac <- function(pkg, pkg_version, path_to_pkg_tarballs, R, pkg_buildlog, pkg_libs, mergemultiarch = FALSE, forcebiarch = FALSE, build_in_pkglib = FALSE){
Rbuild <- paste(R, "CMD", "INSTALL --build")
if( mergemultiarch )
Rbuild <- paste(Rbuild, "--merge-multiarch")
if( forcebiarch )
Rbuild <- paste(Rbuild, "--force-biarch")
if( build_in_pkglib )
Rbuild <- paste(Rbuild, sprintf("--library=%s", file.path(pkg_libs, pkg)))
system(paste(Rbuild,
file.path(path_to_pkg_tarballs, "src", "contrib",
paste(pkg, "_", pkg_version, ".tar.gz", sep = "")),
">>", pkg_buildlog, "2>&1"), invisible = TRUE)
## FIXME: still needed?
## make temporary directory
## tmpdir <- .make <- tmp <- directory()
## re-link dynlibs (see http://cran.r-project.org/bin/macosx/RMacOSX-FAQ.html#Building-universal-package)
#minor_version <- paste( R.Version()$maj, unlist(strsplit(R.Version()$min, "[.]"))[1], sep="." )
## gfortran
#system( sprintf("for lib in `ls %s/%s/libs/*/*.so`; do install_name_tool -change /usr/local/lib/libgfortran.2.dylib /Library/Frameworks/R.framework/Versions/%s/Resources/lib/libgfortran.2.dylib $lib ; done", tmpdir, pkg, minor_version) )
## gcc
#system( sprintf("for lib in `ls %s/%s/libs/*/*.so`; do install_name_tool -change /usr/local/lib/libgcc_s.1.dylib /Library/Frameworks/R.framework/Versions/%s/Resources/lib/libgcc_s.1.dylib $lib ; done", tmpdir, pkg, minor_version) )
#pkg_binary <- .make_universal_mac_binary(pkg, pkg_version, pkg_buildlog, tmpdir)
## Cleanup
#.cleanup_mac(tmpdir)
##
#invisible(pkg_binary)
invisible(paste(pkg, "_", pkg_version, ".tgz", sep = ""))
}
## update package repository
## OLD way:
## When using a binary distribution (Windows, Mac) we don't need to
## install every package from source, we keep a complete local CRAN-
## install updated
update_package_library <- function(pkgs, path_to_pkg_src, repository_url, lib, pkg_libs, platform, rforge_url = "http://R-Forge.R-project.org", ...){
writeLines(sprintf("Updating package library %s ...", lib))
if((platform == "Linux") | (platform == "MacOSX")){
## Start a virtual framebuffer X server and use this for DISPLAY so that
## we can run package tcltk and friends.
pid <- start_virtual_X11_fb()
}
## first update all installed packages if necessary
## debug cat(sprintf("Arguments to update.packages(): lib = %s, repos = %s, ask = FALSE, checkBuilt = TRUE", lib, paste(repository_url, collapse = ", ")))
if(platform == "Windows"){
update.packages(lib.loc = lib, repos = repository_url, ask = FALSE, checkBuilt = TRUE, type="win.binary", ...)
}else{
update.packages(lib.loc = lib, repos = repository_url, ask = FALSE, checkBuilt = TRUE, ...)
}
writeLines("Done.")
writeLines("Resolve dependency structure ...")
## pkg list and dependency structure
pkgs_dep <- resolve_dependency_structure(pkgs, repository_url, path_to_pkg_src)
## packages installed in library
pkgs_installed <- installed.packages(lib.loc = lib)
## update packages installed from R-Forge and not available from the other standard repositories
avail_repos <- available.packages(contriburl = contrib.url(repository_url))
avail_rforge <- available.packages( contriburl = contrib.url(rforge_url) )
if(length(avail_rforge)){
rf_only <- rownames(pkgs_installed)[rownames(pkgs_installed) %in% avail_rforge[,1][!(avail_rforge[,1] %in% unique(avail_repos[,1]))]]
if(length(rf_only))
update.packages(lib.loc = lib, repos = rforge_url, ask = FALSE, checkBuilt = TRUE, oldPkgs=rf_only, ...)
}
## Temporarily All packages are installed
## install those packages which are only available from R-Forge, the rest
## should be installed from CRAN or other repositories
## TODO: considering the install order
pkgs_to_install <- setdiff(pkgs_dep[["ALL"]], rownames(pkgs_installed))
pkgs_to_install <- pkgs_to_install[pkgs_to_install %in% unique(avail_repos[,1])]
pkgs_to_install_rforge <- setdiff(pkgs_dep[["R_FORGE"]], unique(c(pkgs_to_install, rownames(pkgs_installed))))
writeLines("Done.")
if(length(pkgs_to_install)){
writeLines("Install missing packages from third party repositories ...")
if(platform == "Windows"){
install.packages(pkgs = as.character(na.omit(pkgs_to_install)), lib = lib, contriburl = contrib.url(repository_url, type = "binary"), ...)
} else {
install.packages(pkgs = as.character(na.omit(pkgs_to_install)), lib = lib, contriburl = contrib.url(repository_url), ...)
}
writeLines("Done.")
}
if(length(pkgs_to_install_rforge)){
writeLines("Install missing packages from R-Forge ...")
install.packages(pkgs_to_install_rforge, lib = lib, contriburl = contrib.url(rforge_url, type = "source"), type = "source", ...)
writeLines("Done.")
}
## If dependencies on pkgs hosted on CRAN *and* on R-Forge are to be
## resolved requiring a higher version number (flagged as >= in
## Depends, Imports, or Suggests in the DESCRIPTION file) than what
## is available on CRAN we create a new packages library including
## the corresponding package(s) from R-Forge.
forced_deps <- .pkgs_forced_rforge_depends( available.packages(contriburl = path_to_pkg_src), avail_repos, avail_rforge )
.make_pkg_libs( forced_deps, pkg_libs, path_to_pkg_src, repository_url, rforge_url, lib )
if((platform == "Linux") | (platform == "MacOSX")){
## Close the virtual framebuffer X server
close_virtual_X11_fb(pid)
}
writeLines("Done.")
}
## this function resolves the dependency structure of source pkgs and returns a list
## containing ALL packages, packages hosted on other repositories and the install order
## of ALL packages.
## Additionally suggested packages are included, as they are probably needed when
## building package vignettes
resolve_dependency_structure <- function(pkgs, repository_url, path_to_pkg_src, rforge_url = "http://download.r-forge.r-project.org"){
## look out for available packages
avail_repos <- available.packages(contriburl =
contrib.url(repository_url))
avail_rforge <- available.packages(contriburl = contrib.url(rforge_url))
avail_batch <- available.packages(contriburl = path_to_pkg_src)
avail <- rbind(avail_batch, avail_rforge, avail_repos)
## What packages do we need from external repository
pkgs <- pkgs[pkgs %in% rownames(avail_batch)]
pkgs_suggested <- resolve_suggests(pkgs, avail)
pkgs_suggested <- pkgs_suggested[pkgs_suggested %in% rownames(avail)]
pkgs_to_resolve_deps <- unique(c(pkgs, pkgs_suggested))
pkgs_all <- resolve_dependencies(pkgs_to_resolve_deps, avail)
pkgs_repos <- setdiff(pkgs_all, pkgs)
pkgs_rforge <- setdiff(pkgs_all, rownames(avail_repos))
## FIXME: what to do with packages hosted on both R-Forge and other repos ...
DL <- utils:::.make_dependency_list(pkgs_all, avail)
pkgs_install_order <- utils:::.find_install_order(pkgs_all, DL)
## return a vector with packages and install order
list(ALL = pkgs_all, REPOS = pkgs_repos, R_FORGE = pkgs_rforge, INSTALL_ORDER = pkgs_install_order)
}
.make_tmp_directory <- function(where = "."){
dirname <- paste(sample(c(letters, 0:9), 10, replace = TRUE), collapse = "")
check_directory(file.path(where, dirname), fix = TRUE)
dirname
}
## simple check if there is an src directory
.check_whether_package_contains_code_to_compile <- function(pkg, dir = "."){
if(!file.exists(file.path(dir, pkg)))
warning(paste("Package", pkg, "does not exist in", dir, "!"))
file.exists(file.path(dir, pkg, "src"))
}
## check if package has a Makefile or a configure script,
## necessary for building mac packages -> Do we have to set 'arch=' variable?
.check_whether_package_code_contains_makefile_or_configure <- function(pkg, dir = "."){
if(!file.exists(file.path(dir, pkg)))
warning(paste("Package", pkg, "does not exist in", dir, "!"))
files <- c("Makefile", "configure")
files_to_test <- c(file.path(dir, pkg, files), file.path(dir, pkg, "src", files))
any(file.exists(files_to_test))
}
## checks if there is an installed package in the given path and builds the .tgz
.make_universal_mac_binary <- function(pkg, pkg_version, pkg_buildlog, dir = "."){
if(file.exists(file.path(dir, pkg, "DESCRIPTION"))){
system(paste("tar czvf", paste(pkg, "_", pkg_version, ".tgz", sep = ""),
"-C", dir, pkg,
">>", pkg_buildlog, "2>&1"))
return(paste(pkg, "_", pkg_version, ".tgz", sep = ""))
}
NA
}
.cleanup_mac <- function(dir){
if( file.exists( file.path(".", dir)) )
system( paste("rm -rf", file.path(".", dir)) )
}
get_package_version_from_sources <- function(pkg, library = ".")
sapply(pkg, .get_package_version_from_sources, library)
.get_package_version_from_sources <- function(pkg, library){
suppressWarnings(pkg_version <- tryCatch(packageDescription(pkg, lib.loc = library)$Version, error = identity))
if(inherits(pkg_version, "error") | is.null(pkg_version)){
warning(paste("Could not retrieve version number from package", pkg, ". Setting to 0L!"))
pkg_version <- "0.0"
}
pkg_version
}
## Function definition of version ordering functions
## given two version number, this function returns the order of them
version_order <- function(x){
if(!is.character(x))
stop("A version number has to be of type character!")
if(! length(x) == 2)
warning("More than 2 version numbers detected: The order is calculated only from the first 2 elements in the vector!")
## coerce to numeric version
y <- numeric_version(x[1])
z <- numeric_version(x[2])
if(y <= z){
return(c(1,2))
} else
return(c(2,1))
}
## resolve dependencies helper
resolve_dependencies <- function(pkgs, available){
pkgs_all <- pkgs
pkgs_old <- NULL
while(!(length(pkgs_old)==length(pkgs_all))){
pkgs_old <- pkgs_all
DL <- unlist(utils:::.make_dependency_list(pkgs_all, available))
#browser()
pkgs_all <- unique(c(pkgs_all,DL))
pkgs_all <- pkgs_all[pkgs_all %in% available[,1]]
}
pkgs_all
}
.make_suggests_list <- function(pkgs, available){
if (!length(pkgs))
return(NULL)
if (is.null(available))
stop(gettextf("'%s' must be supplied", available), domain = NA)
info <- available[pkgs, "Suggests", drop = FALSE]
x <- apply(info, 1, utils:::.clean_up_dependencies)
if (length(pkgs) == 1) {
x <- list(as.vector(x))
names(x) <- pkgs
}
## bundles are defunct in 2.11 ...
bundles <- tryCatch(utils:::.find_bundles(available), error = identity)
if(! inherits(bundles, "error") ){
x <- lapply(x, function(x) if (length(x)) {
for (bundle in names(bundles)) x[x %in% bundles[[bundle]]] <- bundle
x <- x[!x %in% c("R", "NA")]
unique(x)
}
else x)
}
x
}
resolve_suggests <- function(pkgs, available){
pkgs_suggested <- unlist(.make_suggests_list(pkgs,available))
pkgs_suggested
}
## remove certain pkgs from a pkg list
remove_excluded_pkgs <- function(pkgs, to_remove){
excluded <- sapply(pkgs, "[", 1) %in% to_remove
pkgs[!excluded]
}
## checks if directory exists---if not: creates it if desired
check_directory <- function(dir, fix = FALSE, ...){
out <- TRUE
if(!file.exists(dir)){
out <- FALSE
if(fix){
dir.create(dir, ...)
if(file.exists(dir))
return(TRUE)
}
}
out
}
## check, if packages can be installed to local library
check_local_library <- function(lib){
## look, if library is locked
lock <- file.path(lib, "00LOCK")
if(file.exists(lock))
system(paste("rm -rf", lock))
}
## check, if packages can be installed to local library
## TODO: rotate (gzip and copy to backup location) old logs
## to keep track of history
check_log_directory <- function(dir, type = c("build", "check")){
type <- match.arg(type)
if(!check_directory(dir, fix=TRUE))
stop(paste("There is no directory", dir, "!"))
old_wd <- getwd()
setwd(dir)
if(type == "build"){
suffix <- "buildlog.txt"
}else {
suffix <- "checklog.txt"
}
files <- list.files(dir, pattern = suffix)
file.remove(files)
setwd(old_wd)
}
## Start a virtual framebuffer X server and use this for DISPLAY so that
## we can run package tcltk and friends. We use a random PID
## as the server number so that the checks for different flavors
## get different servers.
start_virtual_X11_fb <- function(){
## FIXME: if /usr/bin/X11 exists -> then setting path not necessary
Sys.setenv(PATH=paste(Sys.getenv("PATH"), ":/usr/bin/X11", sep=""))
xvfb_screen <- floor(runif(1,1000,9999))
system(paste("Xvfb :", xvfb_screen, " -screen 0 1280x1024x24 &", sep=""))
pid <- as.integer(system(paste("ps auxw | grep \"Xvfb :", xvfb_screen,
"\" | grep -v grep | awk '{ print $2 }'", sep=""), intern = TRUE))
Sys.setenv(DISPLAY=paste(":", xvfb_screen, sep = ""))
pid
}
close_virtual_X11_fb <- function(pid){
system(paste("kill -9", pid))
Sys.unsetenv("DISPLAY")
}
provide_packages_in_contrib <- function(build_dir, contrib_dir, platform){
file_types <- c(Linux = ".tar.gz", MacOSX = ".tgz", Windows = ".zip")
file_type <- file_types[platform]
pkg_types <- c(Linux = "source", MacOSX = "mac.binary", Windows = "win.binary")
pkg_type <- pkg_types[platform]
## Hard coding fields (we are indexing by number, so hard-coding important here!)
## R-Forge repository offers additional "Revision" field.
fields <- c(tools:::.get_standard_repository_db_fields(), "Repository", "Repository/Project", "Repository/R-Forge/Revision", "Repository/R-Forge/DateTimeStamp")
## Remember old working directory
old_dir <- file_path_as_absolute(getwd())
setwd(build_dir)
## first delete old packages
system(sprintf("rm -f %s", file.path(contrib_dir, sprintf("*%s", file_type))))
files <- dir()
files <- files[grep(sprintf("%s$", file_type), files)]
for(i in files){
## copy package to contrib directory
file.copy(i, contrib_dir, overwrite = TRUE)
## delete package from build directory
system(paste("rm -f", i))
}
## remove old PACKAGES file
setwd(contrib_dir)
system(paste("rm -f PACKAGES*"))
## now find out which packages have old versions DEPRECATED! -> to be removed
tmp <- dir()
splitted <- strsplit(tmp, "_")
packages <- sapply(splitted, "[", 1)
if(length(packages)){
ind <- 1L:length(packages)
versno <- unlist(strsplit(sapply(splitted, "[", 2), file_type))
duplicated_pkgs <- duplicated(packages)
if(any(duplicated_pkgs)){
## look for duplicated packages and remove older version
for(i in packages[duplicated_pkgs]){
ind_package_to_remove <- ind[packages==i][version_order(versno[packages==i])[1]]
system(paste("rm -f", tmp[ind_package_to_remove]))
}
}
}
## Write a new PACKAGES and PACKAGES.gz file
write_PACKAGES(dir = contrib_dir, fields = fields, type = pkg_type)
## back to old directory
setwd(old_dir)
unique(packages)
}
## compute dependencies on packages double hosted on CRAN (primary
## repository for resolving deps) and R-Forge. Returns those packages
## in the batch of packages scheduled for building/checking which are
## forced to be installed from R-Forge. The list elements are the
## corresponding R-Forge dependencies.
.pkgs_forced_rforge_depends <- function( avail_batch, avail_repos, avail_rforge,
fieldstocheck = c("Depends", "Imports", "Suggests") ){
pkg_info <- lapply( rownames(avail_batch),
function(pkg) tools:::.split_description(na.omit(avail_batch[pkg,])) )
dep_info <- lapply( pkg_info, function(info) unlist(lapply(fieldstocheck, function(field)
if(length(info[[field]]))
lapply(info[[field]], function(x)
if(length(x$op))
if(x$op %in% c(">=", ">")) x$version)), recursive = FALSE) )
names(dep_info) <- rownames(avail_batch)
true_deps <- lapply(dep_info, .check_if_rforge_version_needed, avail_repos = avail_repos, avail_rforge = avail_rforge )
notnull <- unlist(lapply( true_deps, function(x) length(x) > 0 ))
true_deps[notnull]
}
.check_if_rforge_version_needed <- function( x, avail_repos, avail_rforge ){
out <- unlist(lapply(names(x), function(dep) {
if(length(x[[dep]])){
if(dep %in% rownames(avail_repos))
return(tryCatch(x[[dep]] > avail_repos[dep, "Version"], error = function(x) TRUE) && tryCatch(x[[dep]] <= avail_rforge[dep, "Version"], error = function(x) FALSE))
else
FALSE
} else
FALSE }))
if(length(out))
return(names(x)[out])
NULL
}
.make_pkg_libs <- function( x, pkg_libs, path_to_pkg_src, repository_url, rforge_url, lib, ...){
lapply( names(x), function(pkg) {
dir.create( file.path(pkg_libs, pkg), showWarnings = FALSE )
pkgs_dep <- resolve_dependency_structure( pkg, repository_url, path_to_pkg_src )
for(dep in pkgs_dep[["ALL"]])
file.symlink( file.path(lib, dep), file.path(pkg_libs, pkg, dep) )
for(fdep in x[[pkg]]){
file.remove(file.path(pkg_libs, pkg, fdep))
install.packages(pkgs = fdep, lib = file.path(pkg_libs, pkg), contriburl = contrib.url(rforge_url), ...)
}
} )
invisible(TRUE)
}
Try the rfTools package in your browser
Any scripts or data that you put into this service are public.
rfTools documentation built on May 2, 2019, 6:10 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
## Package Build Infrastructure for R-Forge
## Author: Stefan Theussl
## Constructor for R-Forge control files
rf_build_control <- function(path_to_pkg_src, path_to_pkg_log, path_to_pkg_root,
path_to_local_texmf, path_to_local_library,
path_to_local_pkg_libs, stoplist,
mail_domain_name_of_sender, mail_relay_server,
mail_programme = "mail",
path_to_check_dir = "",
cpu_time_limit = 600){
structure(list(cpu_time_limit = cpu_time_limit,
mail_domain_name_of_sender = mail_domain_name_of_sender,
mail_programme = mail_programme,
mail_relay_server = mail_relay_server,
path_to_check_dir = path_to_check_dir,
path_to_local_library = path_to_local_library,
path_to_local_pkg_libs = path_to_local_pkg_libs,
path_to_local_texmf = path_to_local_texmf,
path_to_pkg_log = path_to_pkg_log,
path_to_pkg_root = path_to_pkg_root,
path_to_pkg_src = path_to_pkg_src,
stoplist = stoplist),
class = "rf_build_control")
}
is.rf_build_control <- function(x)
inherits(x, "rf_build_control")
rf_takeover_prepared_build <- function(stmp, build_root, type = "src"){
stopifnot( type %in% c("src", "mac", "win") )
## take the oldest available for build
if(type == "src"){
btgz <- grep("^build_.*?.tar.gz$", dir(stmp), value = TRUE)
} else {
btgz <- grep("^SRC.build_.*?.tar.gz$", dir(stmp), value = TRUE)
}
## if no build to take up -> exit
if( any(is.na(btgz)) )
return(NULL)
if( !length(btgz) )
return(NULL)
check_tgz <- function(btgz){
## rename it to *.processing or create lock file .processing.<OStype>
ptgz <- switch(type,
"src" = paste(btgz, "processing", sep = "."),
"mac" = paste(btgz, "processing", "MAC", sep = "."),
"win" = paste(btgz, "processing", "WIN", sep = ".") )
## if given submission is already being processed exit and return NULL
if( file.exists(file.path(stmp, ptgz)) )
return( NULL )
## submission already processed
if( type == "mac" && file.exists(file.path(stmp, gsub("SRC.", "MAC.", btgz))) )
return( NULL )
if( type == "win" && file.exists(file.path(stmp, gsub("SRC.", "WIN.", btgz))) )
return( NULL )
ptgz
}
ptgz <- lapply( btgz, check_tgz)
nn <- !unlist(lapply(ptgz, is.null))
if (!any(nn))
return(NULL)
btgz <- btgz[nn][1]
ptgz <- unlist(ptgz[nn])[1]
if(type == "src"){
file.rename( file.path(stmp, btgz), file.path(stmp, ptgz) )
} else {
file.create( file.path(stmp, ptgz) )
}
## uncompress staging area
TAR <- Sys.getenv("TAR")
WINDOWS <- .Platform$OS.type == "windows"
if (!nzchar(TAR)) {
TAR <- if (WINDOWS)
"tar --no-same-owner --force-local"
else "internal"
}
if( type == "src" ){
res <- utils::untar( file.path(stmp, ptgz), compressed = "gzip", tar = TAR, exdir = build_root)
} else {
res <- utils::untar( file.path(stmp, btgz), compressed = "gzip", tar = TAR, exdir = build_root)
}
if (res) {
stop("unpackaging staging area failed.")
}
## src_dir
if( type == "src" ){
src_dir <- gsub( ".tar.gz.processing", "", ptgz )
} else {
src_dir <- gsub( "SRC.", "", gsub(".tar.gz", "", btgz) )
}
src_dir
}
## TODO LIST (there are more points in Uwe's functions):
## file URLs of local mirrors: contriburl = sprintf("file:///%s", dir)
## do not download from cran.r-project.org
## should we include a tmp directory
## if so a cleanup is necessary
## Clean /tmp dir
## system("rm -rf c:\\tmp\\*")
## this is where the work is done
## takes a control object containing control parameters, the platform,
## architecture, ... as arguments
rf_build_packages <- function(pkg_status,
platform = c("Linux", "Windows", "MacOSX"),
architecture = c("x86_32", "x86_64"),
rforge_url = "http://R-Forge.R-project.org",
cran_url = "http://CRAN.R-project.org",
bioc_url =
"http://bioconductor.org/packages/release/bioc",
bioc_data =
"http://bioconductor.org/packages/release/data/annotation",
bioc_experiment=
"http://bioconductor.org/packages/release/data/experiment",
omega_hat_url = "http://www.omegahat.net/R",
control = list(),
Ncpus = 1L){
if( !is.rf_build_control(control) )
stop("No R-Forge build control object given")
## INITIALIZATION
writeLines("Start build process ...")
## match arguments
## FIXME: automatically use info from .Platform?
platform <- match.arg(platform)
architecture <- match.arg(architecture)
maj.version <- paste(R.Version()$maj,
unlist(strsplit(R.Version()$min, "[.]"))[1], sep=".")
## x86_32 on x86_64 allowed but not the other way round
if((architecture=="x86_64") && (.Machine$sizeof.pointer == 4))
stop("Building x86_64 binaries not possible on an x86_32 architecture")
## check for necessary directories---create them if possible
path_to_pkg_src <- control$path_to_pkg_src
path_to_pkg_log <- control$path_to_pkg_log
path_to_pkg_root <- control$path_to_pkg_root
path_to_local_library <- control$path_to_local_library
path_to_local_pkg_libs <- control$path_to_local_pkg_libs
stoplist <- control$stoplist
## local package library
if(!check_directory(path_to_local_library, fix=TRUE))
stop(paste("There is no directory", path_to_local_library,"!"))
## R-Forge package sources
if(!check_directory(path_to_pkg_src))
stop("Directory", path_to_pkg_src, "missing!")
## test for build log dir and clean it
check_log_directory(path_to_pkg_log, type = "build")
## check if package root directory (the directory containing
## the src/contrib or bin/windows/contrib) exists.
if(!check_directory(path_to_pkg_root, fix=TRUE))
stop(paste("There is no directory", dir,"!"))
## local pkg libraries for forced R-Forge depends
if(!check_directory( path_to_local_pkg_libs, fix=TRUE))
stop(paste("There is no directory", dir,"!"))
## get current working directory -> set back at FINALIZATION step
old_wd <- getwd()
## PACKAGE SIGHTING
## STOP LIST: packages which should not be compiled
## BLACK_LIST: packages which cause severe problems (removed from R CMD build)
## TODO: blacklist hardcoded at the moment
blacklist <- c("RepitoolsExamples")
## FIXME: probably too strict at the moment. E.g., RWinEdt does not get build
## when checking packages the stoplist includes additional arguments to check
## process
if(file.exists(stoplist)){
check_args <- read.csv(stoplist, stringsAsFactors = FALSE)
}else check_args <- NULL
## for Linux builds we don't want to build vignettes when checkargs have:
no_install <- check_args[ grep("--install=no",
check_args[["check_args"]]), "Package" ]
fake_install <- check_args[ grep("--install=fake",
check_args[["check_args"]]), "Package" ]
no_vignettes <- check_args[ grep("--no-vignettes",
check_args[["check_args"]]), "Package" ]
## donotcompile <- no_install
donotcompile <- blacklist
if(platform %in% c("Windows", "MacOSX")){
donotcompile <- unique(c(donotcompile, no_install))
}
if( length(donotcompile) ){
for(pkg in donotcompile){
arch <- "all"
if(platform %in% c("Windows", "MacOSX")){
arch <- architecture
}
pkg_buildlog <- get_buildlog(path_to_pkg_log, pkg,
platform, architecture = arch)
write_stoplist_notification(pkg, pkg_buildlog, "build", std.out = TRUE)
}
}
## set up CONTRIB directory
## If we use a BINARY distribution like WINDOWS or MAC we have to append
## the major version of R to the contrib directory otherwise use /src/contrib
if(platform == "Windows"){
path_to_contrib_dir <- file.path(path_to_pkg_root, "bin", .Platform$OS.type,
"contrib", maj.version)
}else if(platform == "MacOSX"){
macosx_branch <- c(x86_64="leopard", x86_32="universal")
path_to_contrib_dir <- file.path(path_to_pkg_root, "bin", "macosx",
macosx_branch[architecture],
"contrib", maj.version)
}else {
## UNIX SOURCE directory (./src/contrib)
path_to_contrib_dir <- contrib.url(path_to_pkg_root, type = "source")
}
if(!check_directory(path_to_contrib_dir, fix=TRUE, recursive=TRUE))
stop(paste("There is no directory", path_to_contrib_dir,"!"))
if(platform != "Linux"){
## sources to be considered in dependency check
URL_pkg_sources <- contrib.url(sprintf("file:%s", path_to_pkg_root),
type = "source")
avail_src_pkgs <- utils::available.packages(URL_pkg_sources)
pkgs <- remove_excluded_pkgs(rownames(avail_src_pkgs), donotcompile)
} else {
## Packages exported from R-Forge's SVN repositories
pkgs_all <- utils::available.packages(contriburl =
sprintf("file://%s", path_to_pkg_src), filters = "duplicates")[, 1]
## Sort out packages that are on the exclude list
pkgs <- remove_excluded_pkgs(pkgs_all, donotcompile)
## sources to be considered in dependency check
URL_pkg_sources <- sprintf("file://%s", path_to_pkg_src)
}
## PACKAGE DB UPDATE
## FIXME: is it sufficient what we are doing here?
other_repositories <- NULL
if(platform == "Windows"){
## include Brian Ripley's Windows Repository
other_repositories <- "http://www.stats.ox.ac.uk/pub/RWin"
}
update_package_library(c(pkgs), URL_pkg_sources, c(cran_url,
c(bioc_url, bioc_data, bioc_experiment),
omega_hat_url,
other_repositories),
path_to_local_library, path_to_local_pkg_libs, platform, Ncpus = Ncpus, rforge_url = rforge_url)
##############################################################################
## LAST PREPARATION STEPS BEFORE PACKAGE BUILDING
##############################################################################
## change to directory where the sources of R-Forge are in
setwd(path_to_pkg_src)
## delete 00LOCK, sometimes this interrupted the build process ...
check_local_library(path_to_local_library)
## where is our R binary?
R <- file.path( R.home(), "bin", "R" )
if( platform == "Windows" )
R <- file.path(R.home(), "bin", "x64", "R")
## Set environment variables which are necessary for building
## (or creating vignettes)
Sys.setenv(R_LIBS = path_to_local_library)
## Set TEXMFLOCAL environment variables in case we have
## personalized style files (building vignettes)
path_to_local_texmf <- control$path_to_local_texmf
if(file.exists(path_to_local_texmf))
Sys.setenv(TEXMFLOCAL=path_to_local_texmf)
##############################################################################
## PACKAGE BUILDING
##############################################################################
## LINUX BUILDS ##############################################################
if(platform == "Linux"){
## We need a virtual framebuffer
pid <- start_virtual_X11_fb()
no_build_vignettes <- c(no_vignettes, no_install, fake_install)
build_src <- function(pkg, architecture, avail_src_pkgs, no_build_vignettes, path_to_pkg_log, pkg_status, platform, R){
## Prolog
pkg_buildlog <- rfTools:::get_buildlog(path_to_pkg_log, pkg, platform, architecture = "all")
rfTools:::write_prolog(pkg, pkg_buildlog, pkg_status,
type = "build", what = "tarball", std.out = TRUE)
build_args <- if( pkg %in% no_build_vignettes)
"--no-build-vignettes"
else
""
## timer start
proc_start <- proc.time()
## build tarball from sources
.build_tarball_from_sources_linux(pkg, R, pkg_buildlog, build_args)
## Epilog and timings
timing <- c(proc.time() - proc_start)["elapsed"]
write_epilog(pkg_buildlog, timing, std.out = TRUE)
timing
}
if(Ncpus > 1L){
timings <- parallel::mclapply(pkgs, FUN = build_src, architecture, avail_src_pkgs, no_build_vignettes, path_to_pkg_log, pkg_status, platform, R, mc.cores = Ncpus)
timings <- structure( unlist(timings), names = pkgs )
} else {
## Initialize timings
timings <- numeric(length(pkgs))
names(timings) <- pkgs
for(pkg in pkgs)
timings[pkg] <- build_src(pkg, architecture, avail_src_pkgs, no_build_vignettes, path_to_pkg_log, pkg_status, platform, R)
}
## Cleanup
close_virtual_X11_fb(pid)
}else{
## BINARIES ##########################################################
## Get additional build flags based on Uwe's lists
## merge-multiarch
mma_list <- character()
con <- tryCatch(url("http://developer.r-project.org/CRAN/QA/Uwe/make/config/MergeMultiarch", open = "r"), error = identity)
if(! inherits(con, "error")){
mma_list <- unique(c(mma_list, readLines(con)))
close(con)
}
## force-biarch
fb_list <- character()
con <- tryCatch(url("http://developer.r-project.org/CRAN/QA/Uwe/make/config/ForceBiarch", open = "r"), error = identity)
if(! inherits(con, "error")){
fb_list <- tryCatch( readLines(con), error = function(x) NA)
close(con)
}
## R-Forge (">=") dependencies installed to pkg_libs
pkg_libs <- NULL
if( file.exists(path_to_local_pkg_libs) )
pkg_libs <- list.files(path_to_local_pkg_libs)
## WINDOWS BUILDS ##########################################################
if(platform == "Windows"){
## Initialize timings
timings <- numeric(length(pkgs))
names(timings) <- pkgs
for( pkg in pkgs ){
## Prolog
pkg_buildlog <- get_buildlog(path_to_pkg_log, pkg, platform, architecture)
write_prolog(pkg, pkg_buildlog, pkg_status,
type = "build", what = "binary", std.out = TRUE)
## BUILD
## timer start
proc_start <- proc.time()
## get current package version (tarball, thus svn in pkg!)
pkg_version_src <- avail_src_pkgs[pkg, "Version"]
mergemultiarch <- FALSE
forcebiarch <- FALSE
build_in_pkglib <- FALSE
if(pkg %in% mma_list)
mergemultiarch <- TRUE
if(pkg %in% fb_list)
forcebiarch <- TRUE
if(pkg %in% pkg_libs)
build_in_pkglib <- TRUE
## now build the package from package tarball
.build_binary_from_tarball_win(pkg,
pkg_version_src,
path_to_pkg_root,
R,
pkg_buildlog,
pkg_libs = path_to_local_pkg_libs,
mergemultiarch = mergemultiarch,
forcebiarch = forcebiarch,
build_in_pkglib = build_in_pkglib
)
## save timing
timings[pkg] <- c(proc.time() - proc_start)["elapsed"]
## Epilog
write_epilog(pkg_buildlog, timings[pkg], std.out = TRUE)
}
## Cleanup
## delete 00LOCK, sometimes this interrupted the build process ...
check_local_library(path_to_local_library)
## MacOSX BUILDS ###########################################################
}else if(platform == "MacOSX"){
## We need a virtual framebuffer
pid <- start_virtual_X11_fb()
## BUILDING FROM PKG TARBALLS
build_bin_mac <- function(pkg, architecture, avail_src_pkgs, path_to_pkg_log, path_to_pkg_root, pkg_status, platform, R, path_to_local_pkg_libs, pkg_libs){
## Prolog
pkg_buildlog <- rfTools:::get_buildlog(path_to_pkg_log, pkg, platform, architecture)
rfTools:::write_prolog(pkg, pkg_buildlog, pkg_status,
type = "build", what = "binary", std.out = TRUE)
## timer start
proc_start <- proc.time()
mergemultiarch <- FALSE
forcebiarch <- FALSE
build_in_pkglib <- FALSE
if(pkg %in% mma_list)
mergemultiarch <- TRUE
if(pkg %in% fb_list)
forcebiarch <- TRUE
if(pkg %in% pkg_libs)
build_in_pkglib <- TRUE
## now build the package from package tarball
rfTools:::.build_binary_from_tarball_mac( pkg,
avail_src_pkgs[pkg, "Version"],
path_to_pkg_root,
R,
pkg_buildlog,
pkg_libs = path_to_local_pkg_libs,
mergemultiarch = mergemultiarch,
forcebiarch = forcebiarch,
build_in_pkglib = build_in_pkglib)
## Epilog and timings
timing <- c(proc.time() - proc_start)["elapsed"]
write_epilog(pkg_buildlog, timing, std.out = TRUE)
timing
}
if(Ncpus > 1L){
timings <- parallel::mclapply(pkgs, FUN = build_bin_mac, architecture, avail_src_pkgs, path_to_pkg_log, path_to_pkg_root, pkg_status, platform, R, path_to_local_pkg_libs, pkg_libs, mc.cores = Ncpus)
timings <- structure( unlist(timings), names = pkgs )
} else {
## Initialize timings
timings <- numeric(length(pkgs))
names(timings) <- pkgs
for(pkg in pkgs)
timings[pkg] <- build_bin_mac(pkg, architecture, avail_src_pkgs, path_to_pkg_log, path_to_pkg_root, pkg_status, platform, R, path_to_local_pkg_libs, pkg_libs)
}
## Cleanup: close framebuffer
close_virtual_X11_fb(pid)
} else stop(paste("Strange platform: ", platform, "! I'm confused ...",
sep = ""))
}
## FINAL STEPS
writeLines("Send email to R-Forge maintainer and cleanup ...")
## provide built packages in corresponding contrib dir
pkgs_provided <- provide_packages_in_contrib(path_to_pkg_src,
path_to_contrib_dir, platform)
## send email to R-Forge maintainer which packages successfully were built
## FIXME: make a log file for later examination
#notify_admins(pkgs_provided, donotcompile, email, platform, control,
# about = "build", timings = timings)
## go back to old working directory
setwd(old_wd)
writeLines("Done.")
invisible(TRUE)
}
## OS: Linux (would also work on other POSIX systems?)
## input: uncompressed package sources (the exported pkg directories)
## output: compressed package sources <package_name>_<version>.tar.gz
## FIXME: currently sources and resulting tarball are in the current working dir
## Changelog 2011-04-28: --compact-vignettes --resave-data=best added to save disk space
.build_tarball_from_sources_linux <- function(pkg, R, pkg_buildlog, build_args = ""){
files <- Sys.glob(c(file.path(pkg, "data", "*.rda"), file.path(pkg, "data", "*.RData"), file.path(pkg, "R", "sysdata.rda")))
rdas <- tools::checkRdaFiles(files)
if(!all(rdas$compress %in% c("bzip2", "xz")))
build_args <- sprintf("--resave-data=best %s", build_args)
system(paste(R, "CMD build --compact-vignettes", build_args, pkg,
">>", pkg_buildlog, "2>&1"))
pkg_version <- get_package_version_from_sources(pkg)
invisible(paste(pkg, "_", pkg_version, ".tar.gz", sep = ""))
}
.copy_tarball_from_repository <- function(pkg, pkg_root, pkg_src,
pkg_version, pkg_buildlog){
cat("Package up to date. Not building ...\n", file = pkg_buildlog,
append = TRUE)
file.copy(file.path(pkg_root, paste(pkg, "_", pkg_version, ".tar.gz",
sep = "")), pkg_src, overwrite = TRUE)
}
.copy_binary_from_repository <- function(pkg, pkg_root, pkg_src,
pkg_version, pkg_buildlog){
cat("Package up to date. Not building ...\n", file = pkg_buildlog,
append = TRUE)
## FIXME: is there an easier way to retrieve the file suffix?
filesuffix <- ifelse( .Platform$OS.type == "unix", ".tgz", ".zip")
file.copy(file.path(pkg_root, paste(pkg, "_", pkg_version, filesuffix,
sep = "")), pkg_src, overwrite = TRUE)
}
## OS: Windows
## input: package tarball (<package_name>_<version>.tar.gz)
## output: compressed package binary <package_name>_<version>.zip
## FIXME: currently sources and resulting tarball are in the current working dir
.build_binary_from_tarball_win <- function(pkg, pkg_version, path_to_pkg_tarballs, R, pkg_buildlog, pkg_libs, mergemultiarch = FALSE, forcebiarch = FALSE, build_in_pkglib = FALSE){
Rbuild <- paste(R, "CMD", "INSTALL --build")
if( mergemultiarch )
Rbuild <- paste(Rbuild, "--merge-multiarch")
if( forcebiarch )
Rbuild <- paste(Rbuild, "--force-biarch")
if( build_in_pkglib )
Rbuild <- paste(Rbuild, sprintf("--library=%s", file.path(pkg_libs, pkg)))
shell(paste(Rbuild,
file.path(path_to_pkg_tarballs, "src", "contrib",
paste(pkg, "_", pkg_version, ".tar.gz", sep = "")),
">>", pkg_buildlog, "2>&1"), invisible = TRUE, shell = "cmd")
invisible(paste(pkg, "_", pkg_version, ".zip", sep = ""))
}
## OS: Mac OS X
## input: package tarball (<package_name>_<version>.tar.gz)
## output: compressed package binary <package_name>_<version>.tgz
## FIXME: currently sources and resulting tarball are in the current working dir
.build_binary_from_tarball_mac <- function(pkg, pkg_version, path_to_pkg_tarballs, R, pkg_buildlog, pkg_libs, mergemultiarch = FALSE, forcebiarch = FALSE, build_in_pkglib = FALSE){
Rbuild <- paste(R, "CMD", "INSTALL --build")
if( mergemultiarch )
Rbuild <- paste(Rbuild, "--merge-multiarch")
if( forcebiarch )
Rbuild <- paste(Rbuild, "--force-biarch")
if( build_in_pkglib )
Rbuild <- paste(Rbuild, sprintf("--library=%s", file.path(pkg_libs, pkg)))
system(paste(Rbuild,
file.path(path_to_pkg_tarballs, "src", "contrib",
paste(pkg, "_", pkg_version, ".tar.gz", sep = "")),
">>", pkg_buildlog, "2>&1"), invisible = TRUE)
## FIXME: still needed?
## make temporary directory
## tmpdir <- .make <- tmp <- directory()
## re-link dynlibs (see http://cran.r-project.org/bin/macosx/RMacOSX-FAQ.html#Building-universal-package)
#minor_version <- paste( R.Version()$maj, unlist(strsplit(R.Version()$min, "[.]"))[1], sep="." )
## gfortran
#system( sprintf("for lib in `ls %s/%s/libs/*/*.so`; do install_name_tool -change /usr/local/lib/libgfortran.2.dylib /Library/Frameworks/R.framework/Versions/%s/Resources/lib/libgfortran.2.dylib $lib ; done", tmpdir, pkg, minor_version) )
## gcc
#system( sprintf("for lib in `ls %s/%s/libs/*/*.so`; do install_name_tool -change /usr/local/lib/libgcc_s.1.dylib /Library/Frameworks/R.framework/Versions/%s/Resources/lib/libgcc_s.1.dylib $lib ; done", tmpdir, pkg, minor_version) )
#pkg_binary <- .make_universal_mac_binary(pkg, pkg_version, pkg_buildlog, tmpdir)
## Cleanup
#.cleanup_mac(tmpdir)
##
#invisible(pkg_binary)
invisible(paste(pkg, "_", pkg_version, ".tgz", sep = ""))
}
## update package repository
## OLD way:
## When using a binary distribution (Windows, Mac) we don't need to
## install every package from source, we keep a complete local CRAN-
## install updated
update_package_library <- function(pkgs, path_to_pkg_src, repository_url, lib, pkg_libs, platform, rforge_url = "http://R-Forge.R-project.org", ...){
writeLines(sprintf("Updating package library %s ...", lib))
if((platform == "Linux") | (platform == "MacOSX")){
## Start a virtual framebuffer X server and use this for DISPLAY so that
## we can run package tcltk and friends.
pid <- start_virtual_X11_fb()
}
## first update all installed packages if necessary
## debug cat(sprintf("Arguments to update.packages(): lib = %s, repos = %s, ask = FALSE, checkBuilt = TRUE", lib, paste(repository_url, collapse = ", ")))
if(platform == "Windows"){
update.packages(lib.loc = lib, repos = repository_url, ask = FALSE, checkBuilt = TRUE, type="win.binary", ...)
}else{
update.packages(lib.loc = lib, repos = repository_url, ask = FALSE, checkBuilt = TRUE, ...)
}
writeLines("Done.")
writeLines("Resolve dependency structure ...")
## pkg list and dependency structure
pkgs_dep <- resolve_dependency_structure(pkgs, repository_url, path_to_pkg_src)
## packages installed in library
pkgs_installed <- installed.packages(lib.loc = lib)
## update packages installed from R-Forge and not available from the other standard repositories
avail_repos <- available.packages(contriburl = contrib.url(repository_url))
avail_rforge <- available.packages( contriburl = contrib.url(rforge_url) )
if(length(avail_rforge)){
rf_only <- rownames(pkgs_installed)[rownames(pkgs_installed) %in% avail_rforge[,1][!(avail_rforge[,1] %in% unique(avail_repos[,1]))]]
if(length(rf_only))
update.packages(lib.loc = lib, repos = rforge_url, ask = FALSE, checkBuilt = TRUE, oldPkgs=rf_only, ...)
}
## Temporarily All packages are installed
## install those packages which are only available from R-Forge, the rest
## should be installed from CRAN or other repositories
## TODO: considering the install order
pkgs_to_install <- setdiff(pkgs_dep[["ALL"]], rownames(pkgs_installed))
pkgs_to_install <- pkgs_to_install[pkgs_to_install %in% unique(avail_repos[,1])]
pkgs_to_install_rforge <- setdiff(pkgs_dep[["R_FORGE"]], unique(c(pkgs_to_install, rownames(pkgs_installed))))
writeLines("Done.")
if(length(pkgs_to_install)){
writeLines("Install missing packages from third party repositories ...")
if(platform == "Windows"){
install.packages(pkgs = as.character(na.omit(pkgs_to_install)), lib = lib, contriburl = contrib.url(repository_url, type = "binary"), ...)
} else {
install.packages(pkgs = as.character(na.omit(pkgs_to_install)), lib = lib, contriburl = contrib.url(repository_url), ...)
}
writeLines("Done.")
}
if(length(pkgs_to_install_rforge)){
writeLines("Install missing packages from R-Forge ...")
install.packages(pkgs_to_install_rforge, lib = lib, contriburl = contrib.url(rforge_url, type = "source"), type = "source", ...)
writeLines("Done.")
}
## If dependencies on pkgs hosted on CRAN *and* on R-Forge are to be
## resolved requiring a higher version number (flagged as >= in
## Depends, Imports, or Suggests in the DESCRIPTION file) than what
## is available on CRAN we create a new packages library including
## the corresponding package(s) from R-Forge.
forced_deps <- .pkgs_forced_rforge_depends( available.packages(contriburl = path_to_pkg_src), avail_repos, avail_rforge )
.make_pkg_libs( forced_deps, pkg_libs, path_to_pkg_src, repository_url, rforge_url, lib )
if((platform == "Linux") | (platform == "MacOSX")){
## Close the virtual framebuffer X server
close_virtual_X11_fb(pid)
}
writeLines("Done.")
}
## this function resolves the dependency structure of source pkgs and returns a list
## containing ALL packages, packages hosted on other repositories and the install order
## of ALL packages.
## Additionally suggested packages are included, as they are probably needed when
## building package vignettes
resolve_dependency_structure <- function(pkgs, repository_url, path_to_pkg_src, rforge_url = "http://download.r-forge.r-project.org"){
## look out for available packages
avail_repos <- available.packages(contriburl =
contrib.url(repository_url))
avail_rforge <- available.packages(contriburl = contrib.url(rforge_url))
avail_batch <- available.packages(contriburl = path_to_pkg_src)
avail <- rbind(avail_batch, avail_rforge, avail_repos)
## What packages do we need from external repository
pkgs <- pkgs[pkgs %in% rownames(avail_batch)]
pkgs_suggested <- resolve_suggests(pkgs, avail)
pkgs_suggested <- pkgs_suggested[pkgs_suggested %in% rownames(avail)]
pkgs_to_resolve_deps <- unique(c(pkgs, pkgs_suggested))
pkgs_all <- resolve_dependencies(pkgs_to_resolve_deps, avail)
pkgs_repos <- setdiff(pkgs_all, pkgs)
pkgs_rforge <- setdiff(pkgs_all, rownames(avail_repos))
## FIXME: what to do with packages hosted on both R-Forge and other repos ...
DL <- utils:::.make_dependency_list(pkgs_all, avail)
pkgs_install_order <- utils:::.find_install_order(pkgs_all, DL)
## return a vector with packages and install order
list(ALL = pkgs_all, REPOS = pkgs_repos, R_FORGE = pkgs_rforge, INSTALL_ORDER = pkgs_install_order)
}
.make_tmp_directory <- function(where = "."){
dirname <- paste(sample(c(letters, 0:9), 10, replace = TRUE), collapse = "")
check_directory(file.path(where, dirname), fix = TRUE)
dirname
}
## simple check if there is an src directory
.check_whether_package_contains_code_to_compile <- function(pkg, dir = "."){
if(!file.exists(file.path(dir, pkg)))
warning(paste("Package", pkg, "does not exist in", dir, "!"))
file.exists(file.path(dir, pkg, "src"))
}
## check if package has a Makefile or a configure script,
## necessary for building mac packages -> Do we have to set 'arch=' variable?
.check_whether_package_code_contains_makefile_or_configure <- function(pkg, dir = "."){
if(!file.exists(file.path(dir, pkg)))
warning(paste("Package", pkg, "does not exist in", dir, "!"))
files <- c("Makefile", "configure")
files_to_test <- c(file.path(dir, pkg, files), file.path(dir, pkg, "src", files))
any(file.exists(files_to_test))
}
## checks if there is an installed package in the given path and builds the .tgz
.make_universal_mac_binary <- function(pkg, pkg_version, pkg_buildlog, dir = "."){
if(file.exists(file.path(dir, pkg, "DESCRIPTION"))){
system(paste("tar czvf", paste(pkg, "_", pkg_version, ".tgz", sep = ""),
"-C", dir, pkg,
">>", pkg_buildlog, "2>&1"))
return(paste(pkg, "_", pkg_version, ".tgz", sep = ""))
}
NA
}
.cleanup_mac <- function(dir){
if( file.exists( file.path(".", dir)) )
system( paste("rm -rf", file.path(".", dir)) )
}
get_package_version_from_sources <- function(pkg, library = ".")
sapply(pkg, .get_package_version_from_sources, library)
.get_package_version_from_sources <- function(pkg, library){
suppressWarnings(pkg_version <- tryCatch(packageDescription(pkg, lib.loc = library)$Version, error = identity))
if(inherits(pkg_version, "error") | is.null(pkg_version)){
warning(paste("Could not retrieve version number from package", pkg, ". Setting to 0L!"))
pkg_version <- "0.0"
}
pkg_version
}
## Function definition of version ordering functions
## given two version number, this function returns the order of them
version_order <- function(x){
if(!is.character(x))
stop("A version number has to be of type character!")
if(! length(x) == 2)
warning("More than 2 version numbers detected: The order is calculated only from the first 2 elements in the vector!")
## coerce to numeric version
y <- numeric_version(x[1])
z <- numeric_version(x[2])
if(y <= z){
return(c(1,2))
} else
return(c(2,1))
}
## resolve dependencies helper
resolve_dependencies <- function(pkgs, available){
pkgs_all <- pkgs
pkgs_old <- NULL
while(!(length(pkgs_old)==length(pkgs_all))){
pkgs_old <- pkgs_all
DL <- unlist(utils:::.make_dependency_list(pkgs_all, available))
#browser()
pkgs_all <- unique(c(pkgs_all,DL))
pkgs_all <- pkgs_all[pkgs_all %in% available[,1]]
}
pkgs_all
}
.make_suggests_list <- function(pkgs, available){
if (!length(pkgs))
return(NULL)
if (is.null(available))
stop(gettextf("'%s' must be supplied", available), domain = NA)
info <- available[pkgs, "Suggests", drop = FALSE]
x <- apply(info, 1, utils:::.clean_up_dependencies)
if (length(pkgs) == 1) {
x <- list(as.vector(x))
names(x) <- pkgs
}
## bundles are defunct in 2.11 ...
bundles <- tryCatch(utils:::.find_bundles(available), error = identity)
if(! inherits(bundles, "error") ){
x <- lapply(x, function(x) if (length(x)) {
for (bundle in names(bundles)) x[x %in% bundles[[bundle]]] <- bundle
x <- x[!x %in% c("R", "NA")]
unique(x)
}
else x)
}
x
}
resolve_suggests <- function(pkgs, available){
pkgs_suggested <- unlist(.make_suggests_list(pkgs,available))
pkgs_suggested
}
## remove certain pkgs from a pkg list
remove_excluded_pkgs <- function(pkgs, to_remove){
excluded <- sapply(pkgs, "[", 1) %in% to_remove
pkgs[!excluded]
}
## checks if directory exists---if not: creates it if desired
check_directory <- function(dir, fix = FALSE, ...){
out <- TRUE
if(!file.exists(dir)){
out <- FALSE
if(fix){
dir.create(dir, ...)
if(file.exists(dir))
return(TRUE)
}
}
out
}
## check, if packages can be installed to local library
check_local_library <- function(lib){
## look, if library is locked
lock <- file.path(lib, "00LOCK")
if(file.exists(lock))
system(paste("rm -rf", lock))
}
## check, if packages can be installed to local library
## TODO: rotate (gzip and copy to backup location) old logs
## to keep track of history
check_log_directory <- function(dir, type = c("build", "check")){
type <- match.arg(type)
if(!check_directory(dir, fix=TRUE))
stop(paste("There is no directory", dir, "!"))
old_wd <- getwd()
setwd(dir)
if(type == "build"){
suffix <- "buildlog.txt"
}else {
suffix <- "checklog.txt"
}
files <- list.files(dir, pattern = suffix)
file.remove(files)
setwd(old_wd)
}
## Start a virtual framebuffer X server and use this for DISPLAY so that
## we can run package tcltk and friends. We use a random PID
## as the server number so that the checks for different flavors
## get different servers.
start_virtual_X11_fb <- function(){
## FIXME: if /usr/bin/X11 exists -> then setting path not necessary
Sys.setenv(PATH=paste(Sys.getenv("PATH"), ":/usr/bin/X11", sep=""))
xvfb_screen <- floor(runif(1,1000,9999))
system(paste("Xvfb :", xvfb_screen, " -screen 0 1280x1024x24 &", sep=""))
pid <- as.integer(system(paste("ps auxw | grep \"Xvfb :", xvfb_screen,
"\" | grep -v grep | awk '{ print $2 }'", sep=""), intern = TRUE))
Sys.setenv(DISPLAY=paste(":", xvfb_screen, sep = ""))
pid
}
close_virtual_X11_fb <- function(pid){
system(paste("kill -9", pid))
Sys.unsetenv("DISPLAY")
}
provide_packages_in_contrib <- function(build_dir, contrib_dir, platform){
file_types <- c(Linux = ".tar.gz", MacOSX = ".tgz", Windows = ".zip")
file_type <- file_types[platform]
pkg_types <- c(Linux = "source", MacOSX = "mac.binary", Windows = "win.binary")
pkg_type <- pkg_types[platform]
## Hard coding fields (we are indexing by number, so hard-coding important here!)
## R-Forge repository offers additional "Revision" field.
fields <- c(tools:::.get_standard_repository_db_fields(), "Repository", "Repository/Project", "Repository/R-Forge/Revision", "Repository/R-Forge/DateTimeStamp")
## Remember old working directory
old_dir <- file_path_as_absolute(getwd())
setwd(build_dir)
## first delete old packages
system(sprintf("rm -f %s", file.path(contrib_dir, sprintf("*%s", file_type))))
files <- dir()
files <- files[grep(sprintf("%s$", file_type), files)]
for(i in files){
## copy package to contrib directory
file.copy(i, contrib_dir, overwrite = TRUE)
## delete package from build directory
system(paste("rm -f", i))
}
## remove old PACKAGES file
setwd(contrib_dir)
system(paste("rm -f PACKAGES*"))
## now find out which packages have old versions DEPRECATED! -> to be removed
tmp <- dir()
splitted <- strsplit(tmp, "_")
packages <- sapply(splitted, "[", 1)
if(length(packages)){
ind <- 1L:length(packages)
versno <- unlist(strsplit(sapply(splitted, "[", 2), file_type))
duplicated_pkgs <- duplicated(packages)
if(any(duplicated_pkgs)){
## look for duplicated packages and remove older version
for(i in packages[duplicated_pkgs]){
ind_package_to_remove <- ind[packages==i][version_order(versno[packages==i])[1]]
system(paste("rm -f", tmp[ind_package_to_remove]))
}
}
}
## Write a new PACKAGES and PACKAGES.gz file
write_PACKAGES(dir = contrib_dir, fields = fields, type = pkg_type)
## back to old directory
setwd(old_dir)
unique(packages)
}
## compute dependencies on packages double hosted on CRAN (primary
## repository for resolving deps) and R-Forge. Returns those packages
## in the batch of packages scheduled for building/checking which are
## forced to be installed from R-Forge. The list elements are the
## corresponding R-Forge dependencies.
.pkgs_forced_rforge_depends <- function( avail_batch, avail_repos, avail_rforge,
fieldstocheck = c("Depends", "Imports", "Suggests") ){
pkg_info <- lapply( rownames(avail_batch),
function(pkg) tools:::.split_description(na.omit(avail_batch[pkg,])) )
dep_info <- lapply( pkg_info, function(info) unlist(lapply(fieldstocheck, function(field)
if(length(info[[field]]))
lapply(info[[field]], function(x)
if(length(x$op))
if(x$op %in% c(">=", ">")) x$version)), recursive = FALSE) )
names(dep_info) <- rownames(avail_batch)
true_deps <- lapply(dep_info, .check_if_rforge_version_needed, avail_repos = avail_repos, avail_rforge = avail_rforge )
notnull <- unlist(lapply( true_deps, function(x) length(x) > 0 ))
true_deps[notnull]
}
.check_if_rforge_version_needed <- function( x, avail_repos, avail_rforge ){
out <- unlist(lapply(names(x), function(dep) {
if(length(x[[dep]])){
if(dep %in% rownames(avail_repos))
return(tryCatch(x[[dep]] > avail_repos[dep, "Version"], error = function(x) TRUE) && tryCatch(x[[dep]] <= avail_rforge[dep, "Version"], error = function(x) FALSE))
else
FALSE
} else
FALSE }))
if(length(out))
return(names(x)[out])
NULL
}
.make_pkg_libs <- function( x, pkg_libs, path_to_pkg_src, repository_url, rforge_url, lib, ...){
lapply( names(x), function(pkg) {
dir.create( file.path(pkg_libs, pkg), showWarnings = FALSE )
pkgs_dep <- resolve_dependency_structure( pkg, repository_url, path_to_pkg_src )
for(dep in pkgs_dep[["ALL"]])
file.symlink( file.path(lib, dep), file.path(pkg_libs, pkg, dep) )
for(fdep in x[[pkg]]){
file.remove(file.path(pkg_libs, pkg, fdep))
install.packages(pkgs = fdep, lib = file.path(pkg_libs, pkg), contriburl = contrib.url(rforge_url), ...)
}
} )
invisible(TRUE)
}
Try the rfTools package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.