Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
359 lines (331 sloc) 12.1 KB
#' Updating Method
#'
#' Updating Method
#'
#' @param h.scope A signature object for method dispatch.
#' @param ... Further arguments.
#' @return \code{TRUE}.
#' @references \url{http://www.rappster.de/}
#' @references \url{http://http://rappster.wordpress.com/}
#' @example inst/examples/pathWindowsUpdate.R
setGeneric(
name="pathWindowsUpdate",
signature=c("h.scope"),
def=function(
h.scope,
...
){
standardGeneric("pathWindowsUpdate")
}
)
#' Updating Method
#'
#' Update Windows PATH.
#'
#' @param h.scope A \code{character} vector specifying the update scope:
#' \code{"r"} updates the R version based on the version that launched the
#' session that called this function; \code{"rtools"} updates the Rtools paths
#' given that you provide the path to your Rtools installation in arg
#' \code{path.rtools}.
#' @param h.relict A \code{character} vector specifying how to handle relicts
#' (old versions): \code{"keep"} or \code{"remove"}, should be self-explanatory.
#' @param h.pos A \code{character} vector specifying where to add new entries:
#' \code{"prepend"} or \code{"append"}, should be self-explanatory.
#' @param path.rtools A \code{character} scalar specifying the path to your Rtools
#' installation \emph{including} the version number (e.g. \code{C:\Rtools\2.14}).
#' @param do.32bit A \code{logical} scalar. If \code{TRUE} the path to the 32 bit
#' version of R is added (i.e. \code{"~/bin/i386"}); else the path to the 64 bit
#' version (i.e. \code{"~/bin"}).
#' @param do.ask A \code{logical} scalar. If \code{TRUE} the user is presented
#' the old PATH and the planned changes to PATH and can decided whether to update the path or
#' not; else user is not asked.
#' @param do.sort A \code{logical} scalar. If \code{TRUE}, the remaining part
#' of PATH (i.e. entries that have nothing to do with those being investigated)
#' is sorted in ascending order; else this part of PATH is left as found.
#' @param do.test A \code{logical} scalar. If \code{TRUE} a test PATH is called
#' in order to test the function without actually doing anything to PATH.
#' @param .do.verbose A \code{logical} scalar. If \code{TRUE} print additional
#' status messages; else not.
#' @param ... \code{ANY} further arguments.
#' @return A \code{character} scalar containing the new Windows PATH.
#' @author Janko Thyson \email{janko.thyson@@rappster.de}
#' @references \url{http://http://rappster.wordpress.com/}
#' @example inst/examples/pathWindowsUpdate.R
setMethod(
f="pathWindowsUpdate",
signature=signature(h.scope="character"),
definition=function(
h.scope=c("r", "rtools"),
h.relict=c("keep", "remove"),
h.pos=c("prepend", "append"),
path.rtools=character(),
do.32bit=TRUE,
do.ask=TRUE,
do.sort=FALSE,
do.test=FALSE,
.do.verbose=FALSE,
...
){
#---------------------------------------------------------------------------
# PREPROCESSING
#---------------------------------------------------------------------------
h.scope <- match.arg(
arg=h.scope,
choices=c("r", "rtools"),
several.ok=TRUE
)
h.relict <- match.arg(
arg=h.relict,
choices=c("keep", "remove")
)
h.pos <- match.arg(
arg=h.pos,
choices=c("prepend", "append")
)
if (do.test) {
options(warn=-1)
path.sys <- paste(c("C:/Junk/App", "C:/Program Files/ApplicationB",
"C:/Program Files/ApplicationA",
"C:/R/R-2.13.1/bin", "C:/R/R-2.14.0/bin",
"C:/Rtools/2.13/bin", "C:/Rtools/2.13/MinGW/bin",
"C:/Rtools/2.13/MinGW64/bin",
"C:/Rtools/2.14/bin", "C:/Rtools/2.14/MinGW/bin",
"C:/Rtools/2.14/MinGW64/bin"
), collapse=";")
path.sys <- normalizePath(path.sys)
path.r.home <- "C:\\R\\R-2.14.0"
r.version.1 <- "2.14.0"
} else {
path.sys <- Sys.getenv("PATH")
path.rhome <- R.home()
r.version.1 <- paste(R.version$major, R.version$minor, sep=".")
}
rgx.r <- "R-\\d*\\.\\d*\\.\\d*"
rgx.r.bin <- paste(rgx.r, "\\\\bin", sep="")
rgx.rtools <- "Rtools\\\\\\d*\\.\\d*"
rgx.rtools <- "Rtools\\\\\\d*\\.\\d*((\\\\bin)|(\\\\MinGW\\\\bin)|(\\\\MinGW64\\\\bin))"
# OLD PATH
path.0 <- unlist(strsplit(path.sys, ";"))[-1]
# Seems like the first entry in this vector is the *running* R
# distribution. It's not really in the path, just appears so!
# TODO: check
# Clean path
idx <- grep("/", path.0)
if (length(idx)) {
path.0 <- path.0[-idx]
}
idx <- which(path.0 == "")
if (length(idx)) {
path.0 <- path.0[-idx]
}
# /PREPROCESSING ----------
#---------------------------------------------------------------------------
# INNER FUNCTION
#---------------------------------------------------------------------------
pathWindowsUpdateInner <- function(
path.0,
path.add,
version.1,
rgx.relict,
rgx.relict.version,
do.ask=TRUE,
do.sort=FALSE,
do.test=FALSE,
.do.verbose=FALSE,
...
){
path.0.0 <- path.0
path.add <- normalizePath(path.add)
idx <- grep(rgx.relict, path.0, perl=TRUE)
if (length(idx)) {
path.r.relict <- path.0[idx]
path.0 <- path.0[-idx]
if (.do.verbose) {
msg <- c(
"The following versions are already contained in your PATH:\n",
paste(paste("*", path.r.relict), collapse="\n"), "\n",
"Further processing is based on arg 'h.relict' ..."
)
message(msg)
}
# Drop identical path
idx <- which(path.r.relict == path.add)
if (length(idx)) {
path.r.relict <- path.r.relict[-idx]
}
# Drop identical version
idx <- gregexpr(rgx.relict.version, path.r.relict)
if (length(idx)) {
version.0 <- sapply(seq(along=idx), function(x){
idx.this <- idx[[x]]
path.this <- path.r.relict[[x]]
out <- gsub("^[[:alpha:]]*\\\\", "", substr(path.this, start=idx.this,
stop=idx.this+attributes(idx.this)$match.length))
out <- unlist(strsplit(out, split="\\\\"))[1]
return(out)
})
idx <- which(version.0 == version.1)
if (length(idx)) {
path.r.relict <- path.r.relict[-idx]
}
}
if (h.relict == "remove") {
path.add <- path.add
if (.do.verbose) {
message("Removing old versions ...")
}
}
if (h.relict == "keep") {
path.add <- c(path.add, path.r.relict)
if (length(path.r.relict) & .do.verbose) {
message("Keeping old versions ...")
}
}
}
if (do.sort) {
path.0 <- sort(path.0)
}
# /
# NEW PATH
if (h.pos == "prepend") {
path.1 <- c(path.add, path.0)
}
if (h.pos == "append") {
path.1 <- c(path.0, path.add)
}
# /
# MESSAGE
if (.do.verbose) {
msg <- c(
"\n",
"#####################\n",
"# Old Windows PATH: #\n",
"#####################\n",
paste(path.0.0, collapse="\n"), "\n\n",
"#####################\n",
"# New Windows PATH: #\n",
"#####################\n",
paste(path.1, collapse="\n"), "\n"
)
message(msg)
}
# /
# IDENTICAL
out <- path.0
if (path.0.0 == path.1) {
if (.do.verbose) {
message("Paths are identical\n")
}
return(out)
}
# /
# DECISION
if (do.ask) {
decision <- tolower(select.list(choices=c("No", "Yes"),
title="Update PATH?"))
if (decision == "yes") {
path.1 <- paste(path.1, collapse=";")
if (.do.verbose) {
message("Updating Windows PATH ...\n")
}
out <- path.1
if (!do.test) {
system(paste("setx PATH \"", path.1, "\"", sep = ""))
}
}
if (decision == "no") {
if (.do.verbose) {
message("Windows PATH not updated\n")
}
}
} else {
path.1 <- paste(path.1, collapse=";")
if (.do.verbose) {
message("Updating Windows PATH ...\n")
}
out <- path.1
if (!do.test) {
system(paste("setx PATH \"", path.1, "\"", sep = ""))
}
}
# /
return(out)
}
# /INNER FUNCTION ----------
#---------------------------------------------------------------------------
# R
#---------------------------------------------------------------------------
if ("r" %in% h.scope) {
path.rhome.bin <- normalizePath(file.path(path.rhome, "bin"))
if (.do.verbose) {
message(paste("Checking Windows PATH with respect to R ", r.version.1,
" ...\n", sep=""))
}
if ( (shell("R --version") != 0) ||
!grepl(path.rhome, path.sys, fixed=TRUE)
) {
if (do.32bit) {
path.rhome.bin <- file.path(path.rhome.bin, "i386")
}
path.0 <- pathWindowsUpdateInner(
path.0=path.0,
path.add=path.rhome.bin,
version.1=r.version.1,
rgx.relict=rgx.r.bin,
rgx.relict.version=rgx.r,
do.ask=do.ask,
do.sort=do.sort,
do.test=do.test,
.do.verbose=.do.verbose
)
path.0 <- unlist(strsplit(path.0, split=";"))
} else {
message("Windows PATH is up to date\n")
}
}
# /R ----------
#---------------------------------------------------------------------------
# RTOOLS
#---------------------------------------------------------------------------
if ("rtools" %in% h.scope){
if (!length(path.rtools)) {
stop("Please specify path to your Rtools")
}
rtools.version.1 <- gsub("\\.0$", "", r.version.1)
if (.do.verbose) {
message(paste("Checking Windows PATH with respect to Rtools ",
rtools.version, " ...\n", sep=""))
}
# path.apps <- dirname(dirname(path.rhome))
rtools.version.0 <- basename(path.rtools)
if (rtools.version.1 != rtools.version.0) {
msg <- c(
"Non-matching version of Rtools:\n",
paste("* Version R: ", r.version.1), "\n",
paste("* Version Rtools matching: ", rtools.version.1), "\n",
paste("* Version Rtools specified:", rtools.version.0), "\n"
)
stop(msg)
}
path.rtools <- normalizePath(file.path(path.rtools,
c("bin", "MinGW/bin", "MinGW64/bin")), mustWork=FALSE)
path.0 <- pathWindowsUpdateInner(
path.0=path.0,
path.add=path.rtools,
version.1=rtools.version.1,
rgx.relict=rgx.rtools,
rgx.relict.version=rgx.rtools,
do.32bit=do.32bit,
do.ask=do.ask,
do.sort=do.sort,
do.test=do.test,
.do.verbose=.do.verbose
)
path.0 <- unlist(strsplit(path.0, split=";"))
}
# /RTOOLS ----------
options(warn=0)
out <- paste(path.0, collapse=";")
return(out)
}
)