source("/u/sfs/R/sfs-env.R", local = TRUE) ##-> biofromR(), biocLibrary, R.maj.ver() .dir.exists <- function(x) is.character(x) && file.exists(x) && file.info(path.expand(x))$isdir IS.dir <- function(d) length(d) == 1 && .dir.exists(d) ftpCRAN <- "/u/ftp/CRAN" my.R.local <- RrootDir ## was "/usr/local/app/R/R_local" my.BioC <- "/usr/local/app/R/Bioconductor" stopl <- readLines(file.path(my.R.local, "src", "stop_list")) stopl <- stopl[ - (1:2) ] ## the ``header lines'' stopl <- stopl[ - grep("^#", stopl)] (stopl <- sub("\t.*", '', stopl))##-> now a nice vector of package names! (ftpURL <- paste("file:/", ftpCRAN, "src/contrib", sep="/")) (Rver.maj <- R.maj.ver()) ## was sub("\\.[0-9]$", "", ## was sub(" .*", '', sub("^R version ",'', R.version.string)))) (myLib <- file.path(my.R.local, if(basename(dirname(R.home())) == "r-devel") ## normal "library-R-devel" else "library")) ## "versioned library": ## "library-R-devel" else paste("library", Rver.maj, sep="-"))) myLib0 <- myLib ## This is needed when run without the usual SfS-profile options(repos = c(CRAN = "http://cran.ch.r-project.org", BioC="http://www.bioconductor.org", Omegahat="http://www.omegahat.org/R")) install.pkgs.SfS <- function(pkgs, lib= myLib0, repos = NULL, contriburl = ftpURL, destdir = file.path(my.R.local, "src"), ...) { install.packages(pkgs, lib=lib, repos=repos, contriburl=contriburl, destdir=destdir, ...) } ## Here, re-install all packages which ... ip <- installed.packages(lib = myLib0) (tipB <- table(ip[,"Built"])) ## 2010-07-16 : ## 2.10.0 2.10.1 2.11.0 2.11.1 2.4.0 2.5.0 2.6.0 2.6.1 2.7.0 2.7.1 2.7.2 ## 846 5 1089 445 7 2 8 8 12 2 7 ## 2.8.0 2.8.1 2.9.0 2.9.1 2.9.2 ## 7 11 16 13 9 ## 2011-01-03 : ## 2.10.0 2.10.1 2.11.0 2.11.1 2.12.0 2.12.1 2.4.0 2.5.0 2.6.0 2.6.1 2.7.0 ## 5 4 680 1404 388 62 7 2 7 8 12 ## 2.7.1 2.7.2 2.8.0 2.8.1 2.9.0 2.9.1 2.9.2 ## 2 4 7 10 13 13 7 builtP <- package_version(ip[,"Built"]) non.old <- "2.14.0" table(builtP < non.old) ## 2010-07-16 -- < "2.10.0" : ## FALSE TRUE ## 2385 102 str(old2 <- ip[builtP < non.old & !(ip[,"Package"] %in% stopl),]) ## still 100 ## Ok, which of these are still available, i.e. *NOT* orphaned or such? ap <- available.packages(ftpURL) range(old.is.avail <- match(ap[,"Package"], old2[,"Package"], nomatch = 0)) range(old.is.avai2 <- match(old2[,"Package"], ap[,"Package"], nomatch = 0)) if(FALSE) ## do *NOT* -- rather "*.from.sourceDir()" -- see below if(any(old.is.avail > 0)) { print(old2[old.is.avail, "Package"]) install.pkgs.SfS(old2[old.is.avail, "Package"]) } ## For those, *NOT* available, ## we try to re-install them from the ./src/ *directory* ## --> this is not possible with install.packages() -- rather we use part of that code install.pkgs.from.sourceDir <- function(pkgs, dir, lib, INSTALL_opts, verbose = TRUE) { stopifnot(file.exists(dir), file.info(dir)$isdir) cmd0 <- paste(file.path(R.home("bin"), "R"), "CMD INSTALL") libpath <- .libPaths() if (missing(lib) || is.null(lib)) { lib <- libpath[1] if (length(libpath) > 1) message(gettextf("Installing package(s) into %s\n(as %s is unspecified)", sQuote(lib), sQuote("lib")), domain = NA) } ok <- file.info(lib)$isdir & (file.access(lib, 2) == 0) if (length(lib) > 1 && any(!ok)) stop(sprintf(ngettext(sum(!ok), "'lib' element '%s' is not a writable directory", "'lib' elements '%s' are not writable directories"), paste(lib[!ok], collapse = ", ")), domain = NA) libpath <- libpath[!libpath %in% .Library] if (length(libpath)) { libpath <- paste(libpath, collapse = .Platform$path.sep) cmd0 <- paste(paste("R_LIBS", shQuote(libpath), sep = "="), cmd0) } if (!missing(INSTALL_opts)) cmd0 <- paste(cmd0, paste(INSTALL_opts, collapse = " ")) pkgs. <- file.path(dir, path.expand(pkgs)) for (pkg in pkgs.[sapply(pkgs., IS.dir)]) { cmd <- paste(cmd0, "-l", lib, pkg) if(verbose) { if(verbose >= 2) message(sprintf("Executing '%s'", cmd)) else message(sprintf("Trying to install '%s' ..", basename(pkg))) } if (system(cmd) > 0L) warning(sprintf("installation of package '%s' had non-zero exit status", basename(pkg))) } return(invisible()) } install.pkgs.from.sourceDir(old2[which(old.is.avai2 == 0), "Package"], dir = file.path(my.R.local, "src"), lib= myLib0, verbose=TRUE) ###--- Ok, now really look for NAMESPACE: is.dir <- function(...) .Internal(file.info(c(...)))[["isdir"]] ## NOTA BENE: run ## --------- ( cd /usr/local/app/R/R_local/src ; ./do-rm-empty-links ) ## before this stopifnot(file.exists(srcDir <- file.path(my.R.local,"src"))) ## cannot use list.dirs() as that is *necessarily* recursive (!) str(dd <- list.files(srcDir, full.names=TRUE)) ## chr [1:7164] "/usr/local64.sfs/app/R/R_local/src/00-pkg-find.R" ... ## !! ---- large directory ## now: chr [1:7047] "/usr/local/app/R/R_local/src/00-pkg-find.R" ... system.time(isDir <- is.dir(dd)) ## user system elapsed ## 0.073 0.765 51.299 === Current BUG in NFS-mounting /sfs/s/ ... ## ---- isDir1 <- isDir ## or system.time(isDir <- vapply(dd, is.dir, NA)) ## user system elapsed ## 0.186 0.725 17.521 stopifnot(all.equal(isDir1, isDir, check.attr=FALSE)) table(isDir) ## FALSE TRUE ## 3461 3580 ## Those are funny: -- non-existing? ---> see 'do-rm-empty-links' above ! dd[is.na(isDir)] str(dd2 <- basename(dd[isDir & !is.na(isDir)])) ## chr [1:3580] "aaMI" "abc" "abd" "abind" "abn" "AcceptanceSampling" ... ## this is slow -- again when NFS is slow: hasDESC <- sapply(dd2, function(d) file.exists(file.path(srcDir, d, "DESCRIPTION"))) table(hasDESC) ## FALSE TRUE ## 3 3538 str(Rdirs <- dd2[hasDESC]) ## chr [1:3577] "aaMI" "abc" "abd" "abind" "abn" "AcceptanceSampling" ... hasNAMESPACE <- sapply(Rdirs, function(d) file.exists(file.path(srcDir, d, "NAMESPACE"))) table(hasNAMESPACE) ## FALSE TRUE --- 2011-10-27 ## 1419 2158 ## FALSE TRUE --- 2011-10-10 ## 1454 2084 install.pkgs.from.sourceDir(Rdirs[ !hasNAMESPACE ], dir = srcDir, lib= myLib0, verbose=TRUE)