R/manifestFromLib.R

In switchr: Installing, Managing, and Switching Between Distinct Sets of Installed Packages

##' @title libManifest
##' @description Create a Session- or PkgManifest for the contents of a switchr
##' library.
##' @param lib A SwitchrCtx object, or the name of a switchr library. Defaults
##' to the currently active switchr library.
##' @param record_versions Should the exact versions of installed packages be
##' recorded in the manifest (TRUE)
##' @param known_manifest An existing manifest, used when imputing
##' location information for packages not
##' installed via \code{\link{install_packages}}
##' @param repos A vector of traditional package repositories. Used when imputing
##' location information for packages not installed via
##' \code{\link{install_packages}}
##'
##' @param \dots currently unused
##' @docType methods
##' @rdname libManifest
##' @note The manifest generated by this function will not include
##' base packages, as they are part of R and not installable in the
##' traditional sense.
##' @examples
##' \dontshow{
##' intr <- interactive()
##' if(!intr){
##' oldlp <- .libPaths()
##' .libPaths(tail(oldlp, 1))
##' oldgi <- graceful_inet()
##' graceful_inet(TRUE)
##' }
##' }
##' if(interactive()) {
##'   man = libManifest()
##'   man
##' }
##' \dontshow{
##' if(!intr) {
##'   .libPaths(oldlp)
##'   graceful_inet(oldgi)
##' }
##' }
##' \dontrun{
##' man2 = libManifest("myotherlib")
##' man2
##' }
##' @export
##' @return a \code{SessionManifest} object containing version-specified
##' entries for all packages installed in the specified library path(s).
setGeneric("libManifest", function(lib = currentCompEnv(),
                                   record_versions = TRUE,
                                   known_manifest = makeManifest(dep_repos = repos),
                                   repos = defaultRepos(),
                                   ...)
           standardGeneric("libManifest"))



##' @rdname libManifest
##' @aliases libManifest,missing
setMethod("libManifest", "missing",
          function(lib,
                   record_versions = TRUE,
                   known_manifest = makeManifest(dep_repos = repos),
                   repos = defaultRepos(),
                   ...) {
              lib = currentCompEnv()
              libManifest(lib = lib, record_versions = record_versions,
                          known_manifest = known_manifest,
                          repos = repos, ...)
          })




##' @rdname libManifest
##' @aliases libManifest,character
setMethod("libManifest", "character",
          function(lib,
                   record_versions = TRUE,
                   known_manifest = makeManifest(dep_repos = repos),
                   repos = defaultRepos(),
                   ...) {
              lib = findCompEnv(name = lib)
              if(is.null(lib))
                  stop("No library with that name exists")
              libManifest(lib = lib, record_versions = record_versions,
                          known_manifest = known_manifest,
                          repos = repos, ...)
          })







##' @rdname libManifest
##' @aliases libManifest,SwitchrCtx

setMethod("libManifest", "SwitchrCtx",
          function(lib, record_versions, known_manifest, ...) {

              libp = full_libpaths(lib)
              dropfirst = length(list.files(list.dirs(libp[1])[1], pattern = "dummy_for_check", recursive=TRUE)) > 0
              if(dropfirst) {
                  message("Skipping libManifest logic because I am on the CRAN build system within a check command and it will fail")
                  return(PkgManifest())
              }

              instpkgs = installed.packages(libp,
                                            noCache=TRUE)[,"Package"]
              instpkgs = instpkgs[!duplicated(instpkgs)]
              instpkgs = instpkgs[!instpkgs %in% basepkgs]

              res = lapply(instpkgs,
                  function(x, fields) {
                      dcf =  tryCatch(read.dcf(system.file("DESCRIPTION",
                          package = x,
                          lib.loc = libp),
                          fields = fields), error = function(e) NULL)
                      if(!is.null(dcf))
                          dcf = dcf[,fields, drop=FALSE]
                      else {
                          dcf = data.frame(Package = character(),
                              Version = character(),
                              SourceType = character(),
                              SourceLocation = character(),
                              SourceBranch = character(),
                              SourceSubdir = character(),
                              stringsAsFactors = FALSE)

                          message("Package ", x, " seems to have gone missing since my installed.packages call 2 seconds ago. libpaths are ", paste(libp, collapse=" , "), "\n I think I am on the CRAN build system, some packages may be missing from the manifest.")
                      }
                      dcf
                  },
                  fields = c("Package", "Version", "SourceType",
                      "SourceLocation",
                      "SourceBranch",
                      "SourceSubdir"))
          res = res[sapply(res, function(x) nrow(x)>0)]
    instpkginfo = do.call(rbind, res)
    instpkgs  = instpkgs[instpkgs %in% instpkginfo[,"Package"]]
          if(nrow(instpkginfo) == 0)
              return(PkgManifest())
          mani = PkgManifest(name = instpkginfo[,"Package"],
                  type = instpkginfo[,"SourceType"],
                  url = instpkginfo[,"SourceLocation"],
                  branch = instpkginfo[,"SourceBranch"],
                  subdir = instpkginfo[,"SourceSubdir"],
                  dep_repos  = dep_repos(known_manifest))

              haveany = nrow(manifest_df(mani)) > 0
              if(haveany)
                  mani = .findThem(mani, known_manifest)
              if(record_versions && nrow(manifest_df(mani))) {
                  pkg_vers = data.frame(name = instpkgs,
                      version = instpkginfo[,"Version"],
                      stringsAsFactors = FALSE)
                  mani = SessionManifest(manifest = mani,
                      versions = pkg_vers)
              }
              mani
          })

.findThem = function(manifest, known) {
    df = manifest_df(manifest)
    nas = which(is.na(df$url))
    pkgs = df[nas, "name"]
    ##check known manifest
    known_inds = match(pkgs, manifest_df(known)$name)
    if(any(!is.na(known_inds))) {
        inds = which(!is.na(known_inds))
        known_inds = known_inds[!is.na(known_inds)]
        # gross :-/
        df[nas[inds],] = manifest_df(known)[known_inds,]
        pkgs = pkgs[-inds]
    }
    if(length(pkgs)) {
        rows = lapply(pkgs, .findIt, repos = dep_repos(manifest),
            avl = available.packages(contrib.url(dep_repos(manifest))))
        df[df$name %in% pkgs,] = do.call(rbind,rows)
    }
    manifest_df(manifest) = df
    manifest
}

.findIt = function(pkg, repos, avl = available.packages(contrib.url(repos))) {
    if(pkg == "switchr") {
        ret = ManifestRow(name = pkg,
            url = "http://github.com/gmbecker/switchr", type = "github",
            branch = "master")
        return(ret)
    } else

        ret = ManifestRow(name = pkg)
    avl = as.data.frame(avl,
        stringsAsFactors = FALSE)
    if(pkg %in% avl$Package) {
        ret$url = avl[pkg,"Repository"]
        ret$type = .detectType(ret$url)
        ret$branch = "trunk"
    }

    ret
}

.detectType = function(url) {
    if (grepl("bioconductor", url, ignore.case=TRUE))
        "bioc"
    else if(grepl("(cran|cloud.r-project.org)", url, ignore.case=TRUE))
        "CRAN"
    else
        "repository"
}

##' makeSeedMan
##'
##' @param x The object to generate a seeding manifest from, if missing, the
##' output from sessionInfo() is used.
##' @param known_manifest  A manifest containing known locations of package sources.
##' makeSeedMan will attempt to determine locations of packages listed in x using both
##' known_manifest and official repositories.
##' @param ... Currently unused.
##' @examples
##' man = makeSeedMan()
##' @export
##' @docType methods
##' @rdname makeSeedMan
##' @return a \code{SessionManifest} specifying a set of packages and their
##' specific versions.


setGeneric("makeSeedMan", function(x, known_manifest = PkgManifest(), ...) standardGeneric("makeSeedMan"))



##' @rdname makeSeedMan
##' @aliases makeSeedMan,missing
##' @importFrom utils capture.output sessionInfo
setMethod("makeSeedMan", "missing", function(x, known_manifest = PkgManifest(), ...) {
    print("missing method")
    print(defaultRepos())
              parsed = parseSessionInfoString(capture.output(print(sessionInfo())))
              makeSeedMan(parsed, known_manifest = known_manifest, ...)
})



##' @rdname makeSeedMan
##' @aliases makeSeedMan,sessionInfo
setMethod("makeSeedMan", "sessionInfo", function(x, known_manifest = PkgManifest(), ...) {
    print("sessionInfo method")
              parsed = parseSessionInfoString(capture.output(print(x)))
              makeSeedMan(parsed, known_manifest = known_manifest, ...)
})


##' @rdname makeSeedMan
##' @aliases makeSeedMan,parsedSessionInfo
setMethod("makeSeedMan", "parsedSessionInfo", function(x, known_manifest = PkgManifest(), ...) {
    print("parsedSessionInfo method")
    sinfopkginfo = rbind(x@attached, x@loaded)
    sinfopkginfo = sinfopkginfo[!sinfopkginfo[,"Package"] %in% basepkgs,]
    sinfopkginfo = as.data.frame(sinfopkginfo, stringsAsFactors = FALSE)
    names(sinfopkginfo) = c("name", "version")
    makeSeedMan(sinfopkginfo, known_manifest = known_manifest, ...)



})

##' @rdname makeSeedMan
##' @aliases makeSeedMan,data.frame
setMethod("makeSeedMan", "data.frame", function(x, known_manifest = PkgManifest(), ...) {
    ensureCRANmirror(1L)
    stopifnot(all(c("name", "version") %in% names(x)))
    print("data.frame method")
    print(known_manifest)
    x = x[!(x$name %in% basepkgs),]

    mani = PkgManifest(name = x[,"name"],
                       dep_repos  = dep_repos(known_manifest))

    haveany = nrow(manifest_df(mani)) > 0
    if(haveany)
        mani = .findThem(mani, known_manifest)
    if(nrow(manifest_df(mani))) {
        pkg_vers = data.frame(name = x[,"name"],
                              version = x[,"version"],
                              stringsAsFactors = FALSE)
        mani = SessionManifest(manifest = mani,
                               versions = pkg_vers)
    }
    mani
})