getMilan <- function(getAllDeps=FALSE, destdir, force=TRUE, versForce=TRUE, method="auto") {

getMilanVersion <- "1.0.1" writeLines(paste("Running getMilan version ",getMilanVersion,"....\n", "If you encounter problems, first make sure that\n", "you are running the latest version of getMilan()\n", "which can be found at:", "www.bioconductor.org/workshops/Milan/getMilan.R", "\n\n", "Please direct any concerns or questions to", " bioconductor@stat.math.ethz.ch.\n",sep=""))

## Stifle the "connected to www.... garbage output curNetOpt <- getOption("internet.info") on.exit(options(internet.info=curNetOpt), add=TRUE) options(internet.info=3)

## First check to make sure they have HTTP capability. If they do ## not, there is no point to this exercise. http <- as.logical(capabilities(what="http/ftp")) if (http == FALSE) { stop(paste("Your R is not currently configured to allow HTTP", "\nconnections, which is required for getMilan to", "work properly.")) }

biocURL <- url("http://www.bioconductor.org/main.html") options(show.error.messages=FALSE) test <- try(readLines(biocURL)[1]) options(show.error.messages=TRUE) if (inherits(test,"try-error")) stop(paste("Your R can not connect to the Bioconductor", "website, which is required for getBioc to", "work properly. The most likely cause of this", "is the internet configuration of R"))

## Get the destination directory if (missing(destdir)) { lP <- .libPaths() if (length(lP) == 1) destdir <- lP else { dDval <- menu(lP, title="Please select an installation directory:") if (dDval == 0) stop("No installation directory selected") else destdir <- lP[dDval] } } if (length(destdir) > 1) stop("Invalid destdir parameter, must be of length 1")

if (file.access(destdir,mode=0) < 0) stop(paste("Directory",destdir,"does not seem to exist.\n", "Please check your destdir parameter and try again."))

if (file.access(destdir,mode=2) < 0) stop(paste("You do not have write access to",destdir, "\nPlease check your permissions or provide", "a different destdir parameter"))

PLATFORM <- .Platform$OS.type

packs <- "Milan"

print("Installing reposTools ...") temp <- updateRepostools(PLATFORM, destdir, method=method) temp <- eval(deparse(library(reposTools)))

curOps <- getOption("repositories2") on.exit(options(repositories2=curOps), add=TRUE) optReps <- curOps[c("CRAN","BIOCRel1.2","BIOCData","BIOCCourses")] options(repositories2=optReps)

## Get Repository entries from Bioconductor urlPath <- switch(PLATFORM, "unix"="/Source", "/Win32") bioCRepURL <- getReposURL("release",urlPath) bioCEntries <- getReposEntry(bioCRepURL)

syncLocalLibList(.libPaths()) out <- install.packages2(packs, bioCEntries, lib=destdir, type = ifelse(PLATFORM == "unix", "Source", "Win32"), versForce=versForce, recurse=FALSE, getAllDeps=getAllDeps, method=method, force=force, searchOptions=TRUE) print(out)

HarrelOut <- paste("You will also need the packages", " Hmisc and Design, which can be downloaded\n", "at the URL", "'http://hesweb1.med.virginia.edu/biostat/s/", "library/r/'\n\n",sep="") cat(HarrelOut) }

updateRepostools <- function(platform, destdir=NULL, method="auto") {

repository <- getPkgDisc("release") pkgNames <- checkLibs(repository)

for(i in pkgNames){ sourceUrl <- getDLURL(i, repository, platform) ## Get the package file name for reposTools fileName <- getFileName(sourceUrl, destdir) ## Try the connection first before downloading options(show.error.messages = FALSE) tryMe <- try(url(sourceUrl, "r")) options(show.error.messages = TRUE)

if(inherits(tryMe, "try-error")){ if(i == "reposTools" || i == "Biobase"){ stop(paste("Could not get the required package -", i)) }else{ message <- c(message, paste("Failed to get package", i)) } }else{ ## Close the connection for checking close(tryMe) ## Download and install download.file(sourceUrl, fileName, mode = getMode(platform), quiet = TRUE, method=method) installPack(platform, fileName) if (!(i %in% installed.packages()[,"Package"])) stop(paste("Failed to install package",i)) unlink(fileName) } } return(message) }

## Returns the mode that is going to be used to call download.file ## depending on the platform getMode <- function(platform){ switch(platform, "unix" = return("w"), "windows" = return("wb"), stop(paste(platform,"is not currently supported"))) }

## Installs a given package installPack <- function(platform, fileName, destdir=NULL){ if(platform == "unix"){ cmd <- paste(file.path(R.home(), "bin", "R"), "CMD INSTALL") if (!is.null(destdir)) cmd <- paste(cmd, "-l", destdir) cmd <- paste(cmd, fileName) system(cmd) }else{ if(platform == "windows"){ zip.unpack(fileName, .libPaths()[1]) }else{ stop(paste(platform,"is not currently supported")) } } }

## Returns the surce url for a given package getDLURL <- function(pakName, rep, platform){ temp <- rep[rep[, "Package"] == pakName] names(temp) <- colnames(rep) switch(platform, "unix" = return(temp[names(temp) == "SourceURL"]), "windows" = return(temp[names(temp) == "WIN32URL"]), stop(paste(platform,"is not currently supported"))) }

## Returns the description file (PACKAGE) that contains the name, ## version number, url, ... of Bioconductor packages. getPkgDisc <- function (relLevel){ URL <- getReposURL(relLevel,"/PACKAGES") con <- url(URL) options(show.error.messages = FALSE) tryMe <- try(read.dcf(con)) options(show.error.messages = TRUE)

if(inherits(tryMe, "try-error")) stop(paste("The url:",URL, "does not seem to have a valid PACKAGES file."))

close(con) return(tryMe) }

## Returns the url for some files that are needed to perform the ## functions. name is added to teh end of the URL getReposURL <- function(relLevel, name=""){ URL <- switch(relLevel, "devel"= paste("http://www.bioconductor.org/", "repository/devel/package", name, sep =""), "release"=paste("http://www.bioconductor.org/", "repository/release1.2", "/package",name,sep=""), "release1.1"= paste("http://www.bioconductor.org/", "repository/release1.1", "/package", name, sep =""), "release1.0"= paste("http://www.bioconductor.org/", "repository/release1.0", "/package", name, sep =""), "contrib"=paste("http://www.bioconductor.org/", "contrib/pkgs/Repos", name, sep=""), character())

URL }

## Returns the file name with the destination path (if any) attached getFileName <- function(url, destdir){ temp <- unlist(strsplit(url, "/")) if(is.null(destdir)) return(temp[length(temp)]) else return(file.path(destdir, temp[length(temp)])) }

## getBioC has to check to see if "reposTools" and "Biobase" have ## already been loaded and generates a message if any has. checkLibs <- function(repos){ toCheck <- repos[,"Package"] pkgVers <- repos[,"Version"]

bad <- character() toGet <- character()

for (i in 1:nrow(repos)) { ## First get package version ## !!! Not yet using VersionNumber classes here ## !!! bootstrapping issue as this comes from reposTools ## !!! use compareVersion for now if (toCheck[i] %in% installed.packages()[,"Package"]) { curVers <- package.description(toCheck[i],fields="Version") if (compareVersion(curVers,pkgVers[i]) < 0) bad <- c(bad, toCheck[i]) } else toGet <- c(toGet,toCheck[i]) }

if (length(bad) > 0) { ## Now find out which of the outdated packages are loaded curEnv <- search() searchNames <- paste("package", bad, sep = ":") loaded <- bad[searchNames %in% curEnv]

if (length(loaded > 0)) { error <- paste("\nThe following packages are out of date and currently", " loaded in your R session:\n\t", paste(loaded,collapse=", "), "\nIf you would like to continue, please either", " detach these packages or restart\nyour R session", " before running getBioC.",sep="") stop(error) } } ## return the packages that need updating return(c(toGet,bad)) }