R/BiocFileCache-class.R
In Bioconductor/BiocFileCache: Manage Files Across Sessions
Defines functions
BiocFileCache
Documented in
BiocFileCache
#' @import methods
#' @import httr
#' @importFrom utils tar zip untar unzip
#' @importFrom dplyr mutate
#' @importFrom tools R_user_dir
.BiocFileCacheBase = setClass(
"BiocFileCacheBase",
slots=c(cache="character")
)
.BiocFileCacheReadOnly = setClass(
"BiocFileCacheReadOnly",
contains="BiocFileCacheBase",
slots=c(rid="character")
)
.BiocFileCache = setClass(
"BiocFileCache",
contains="BiocFileCacheBase"
)
#' BiocFileCache class
#'
#' This class represents the location of files stored on disk. Use the
#' return value to add and retrieve files that persist across
#' sessions.
#'
#' @details The package defines 'BiocFileCache', 'BiocFileCacheBase' and
#' 'BiocFileCacheReadOnly' classes.
#'
#' Slots unique to 'BiocFileCache' and related classes:
#' \itemize{
#' \item{'cache': }{character(1) on-disk location (directory path) of the
#' cache}
#' \item{'rid': }{character() of unique rids in the cache. }
#' }
#'
#' The cache creates an RSQLite database to keep track of local and remote
#' resources. Each item located in the database will have the following
#' information:
#' \itemize{
#' \item{'rid': }{resource id. Autogenerated. This is a unique identifier
#' automatically generated when a resource is added to the cache}
#' \item{'rname': }{resource name. This is given by the user when a
#' resource is added to the cache. It does not have to be unique
#' and can be updated at anytime. We recommend descriptive key
#' words and identifers.}
#' \item{'create_time': }{The date and time a resource is added to the cache.}
#' \item{'access_time': }{The date and time a resource is utilized
#' within the cache. The access time is updated when the resource
#' is updated or accessed}
#' \item{'rpath': }{resource path. This is the path to the local
#' (on-disk) file}
#' \item{'rtype': }{resource type. Either "relative", "local", or
#' "web", indicating if the resource has a remote origin}
#' \item{'fpath': }{If rtype is "web", this is the link to the
#' remote resource. It will be utilized to download or update the
#' remote data}
#' \item{'last_modified_time': }{For a remote resource, the
#' last_modified (if available) information for the local copy of
#' the data. This information is checked against the remote
#' resource to determine if the local copy is stale and needs to
#' be updated}
#' }
#'
#' All functions have a quick implementation where if the BiocFileCache object
#' is not passed as an argument, the function uses default 'BiocFileCache()' for
#' implementation. e.g 'bfcinfo()' can be used instead of
#' 'bfcinfo(BiocFileCache())'. The only function this is not available for is
#' 'bfcmeta()<-'; The BiocFileCache object must be defined as a varaible and
#' passed as an argument. See vignette("BiocFileCache") for more details.
#'
#' @param cache character(1) On-disk location (directory path) of
#' cache. For default location see
#' \code{\link[tools]{R_user_dir}}.
#' @param ask logical(1) Ask before creating, updating, overwriting,
#' or removing cache or local file locations.
#' @return For 'BiocFileCache': a \code{BiocFileCache} instance.
#' @examples
#' # bfc <- BiocFileCache() # global cache
#' # bfc
#' bfc0 <- BiocFileCache(tempfile()) # temporary catch for examples
#' @name BiocFileCache-class
#' @aliases BiocFileCache
#' @export BiocFileCache
BiocFileCache <-
function(cache=getBFCOption("CACHE"), ask = interactive())
{
stopifnot(
is.character(cache), length(cache) == 1L, !is.na(cache),
is.logical(ask), length(ask) == 1L, !is.na(ask)
)
if (!file.exists(cache)) {
ans <- !ask
if (ask && !.biocfilecache_flags$get_create_asked()) {
ans <- .util_ask(cache, "\n does not exist, create directory?")
.biocfilecache_flags$set_create_asked()
}
if (ans) {
dir.create(cache, recursive=TRUE)
} else {
cache <- file.path(tempdir(), "BiocFileCache")
if (!file.exists(cache)) {
message("using temporary cache ", cache)
dir.create(cache, recursive=TRUE)
}
}
}
bfc <- .BiocFileCache(cache=cache)
.sql_create_db(bfc)
bfc
}
#' @export
setGeneric("bfccache",
function(x) standardGeneric("bfccache")
)
#' @describeIn BiocFileCache Get the location of the on-disk cache.
#' @param x A \code{BiocFileCache} instance or, if missing, the result
#' of \code{BiocFileCache()}.
#' @return For 'bfccache': character(1) location of the directory
#' containing the cache.
#' @examples
#' bfccache(bfc0)
#' @aliases bfccache
#' @exportMethod bfccache
setMethod("bfccache", "BiocFileCacheBase", function(x) x@cache)
#' @rdname BiocFileCache-class
#' @aliases bfccache,missing-method
#' @exportMethod bfccache
setMethod("bfccache", "missing", function(x) bfccache(BiocFileCache()))
#' @describeIn BiocFileCache Get the number of objects in the file
#' cache.
#' @return For 'length': integer(1) Number of objects in the file
#' cache.
#' @examples
#' length(bfc0)
#' @importFrom stats setNames
#' @exportMethod length
setMethod("length", "BiocFileCacheBase", function(x) length(bfcrid(x)))
#' @rdname BiocFileCache-class
#' @aliases bfcrid
#' @export
setGeneric("bfcrid", function(x) standardGeneric("bfcrid"))
#' @rdname BiocFileCache-class
#' @aliases bfcrid,missing-method
#' @exportMethod bfcrid
setMethod("bfcrid", "missing", function(x) bfcrid(BiocFileCache()))
#' @describeIn BiocFileCache Get the rids of the object.
#' @aliases bfcrid,BiocFileCacheReadOnly-method
#' @exportMethod bfcrid
setMethod("bfcrid", "BiocFileCacheReadOnly", function(x) x@rid)
#' @rdname BiocFileCache-class
#' @aliases bfcrid,BiocFileCache-method
#' @exportMethod bfcrid
setMethod("bfcrid", "BiocFileCache", function(x) .get_all_rids(x))
#' @describeIn BiocFileCache Subset a BiocFileCache object.
#' @param drop Ignored.
#' @return For '[': A subset of the BiocFileCache object.
#' @exportMethod [
setMethod("[", c("BiocFileCache", "character", "missing"),
function(x, i, j, ..., drop=TRUE)
{
stopifnot(all(i %in% bfcrid(x)))
stopifnot(identical(unname(drop), TRUE))
.BiocFileCacheReadOnly(x, rid=as.character(i))
})
#' @rdname BiocFileCache-class
#' @aliases [,BiocFileCacheReadOnly,character,missing-method
#' @exportMethod [
setMethod("[", c("BiocFileCacheReadOnly", "character", "missing"),
function(x, i, j, ..., drop=TRUE)
{
stopifnot(all(i %in% bfcrid(x)))
stopifnot(identical(unname(drop), TRUE))
initialize(x, rid=as.character(i))
})
#' @rdname BiocFileCache-class
#' @aliases [,BiocFileCache,missing,missing-method
#' @exportMethod [
setMethod("[", c("BiocFileCache", "missing", "missing"),
function(x, i, j, ..., drop=TRUE)
{
stopifnot(identical(unname(drop), TRUE))
.BiocFileCacheReadOnly(x, rid=bfcrid(x))
})
#' @rdname BiocFileCache-class
#' @aliases [,BiocFileCacheReadOnly,missing,missing-method
#' @exportMethod [
setMethod("[", c("BiocFileCacheReadOnly", "missing", "missing"),
function(x, i, j, ..., drop=TRUE)
{
x # no-op
})
#' @describeIn BiocFileCache Get a file path for select resources from
#' the cache.
#' @param i character() 'rid' identifiers.
#' @param j Ignored.
#' @return For '[[': named character(1) rpath for the given resource
#' in the cache.
#' @exportMethod [[
setMethod("[[", c("BiocFileCacheBase", "character", "missing"),
function(x, i, j)
{
stopifnot(length(i) == 1L, i %in% bfcrid(x))
.sql_get_rpath(x, i)
})
#' @describeIn BiocFileCache Set the file path of selected resources
#' from the cache.
#' @param value character(1) Replacement file path.
#' @return For '[[<-': Updated BiocFileCache, invisibly.
#' @exportMethod [[<-
setReplaceMethod("[[", c("BiocFileCache", "character", "missing", "character"),
function(x, i, j, ..., value)
{
stopifnot(length(i) == 1L, length(value) == 1L)
stopifnot(file.exists(value))
.sql_set_time(x, i)
.sql_set_rpath(x, i, value)
rtype <- unname(.sql_get_rtype(x, i))
if (identical(rtype, "relative") || identical(rtype, "web")) {
warning("updating rpath, changing rtype to 'local'")
.sql_set_rtype(x, i, "local")
}
x
})
#' @export
setGeneric("bfcnew",
function(x, rname, rtype=c("relative", "local"), ext=NA_character_,
fname=c("unique", "exact"))
standardGeneric("bfcnew"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcnew,missing-method
#' @exportMethod bfcnew
setMethod("bfcnew", "missing",
function(x, rname, rtype=c("relative", "local"), ext=NA_character_,
fname=c("unique", "exact"))
{
bfcnew(x=BiocFileCache(), rname=rname, rtype=rtype, ext=ext, fname=fname)
})
#' @describeIn BiocFileCache Add a resource to the database
#' @param rname character(1) Name of object in file cache. For
#' 'bfcupdate' a character vector of replacement rnames.
#' @param ext character(1) A file extension to add to the local
#' copy of the file (e.g., \sQuote{sqlite}, \sQuote{txt},
#' \sQuote{tar.gz}).
#' @param fname character(1). Options are \sQuote{unique} or
#' \sQuote{exact}. \sQuote{unique} provides each bfc resource with a unique
#' identifier when storing the file, allowing resources with the same name
#' to be stored in the cache. \sQuote{exact} uses the exact file name of the
#' resource; only one of foo/my.txt and bar/my.txt could be stored. Default
#' is \sQuote{unique}.
#' @return For 'bfcnew': named character(1), the path to save your
#' object / file. The name of the return value is the unique rid
#' for the resource.
#' @examples
#' path <- bfcnew(bfc0, "NewResource")
#' path
#' @aliases bfcnew
#' @exportMethod bfcnew
setMethod("bfcnew", "BiocFileCache",
function(x, rname, rtype=c("relative", "local"), ext=NA_character_,
fname=c("unique", "exact"))
{
stopifnot(
is.character(rname), length(rname) > 0L, !any(is.na(rname)),
is.character(ext), length(ext) > 0L
)
rtype <- match.arg(rtype)
fname <- match.arg(fname)
.sql_add_resource(x, rname, rtype, NA_character_, ext, fname)
})
#' @export
setGeneric("bfcadd",
function(
x, rname, fpath = rname, rtype=c("auto", "relative", "local", "web"),
action=c("copy", "move", "asis"), proxy="",
download=TRUE, config=list(), ext=NA_character_,
fname=c("unique", "exact"),...
) standardGeneric("bfcadd"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcadd,missing-method
#' @exportMethod bfcadd
setMethod("bfcadd", "missing",
function(
x, rname, fpath = rname, rtype=c("auto", "relative", "local", "web"),
action=c("copy", "move", "asis"), proxy="",
download=TRUE, config=list(), ext=NA_character_,
fname=c("unique", "exact"), ...
)
{
bfcadd(x=BiocFileCache(), rname=rname, fpath=fpath, rtype=rtype,
action=action, proxy=proxy, download=download, config=config,
ext=ext, fname=fname,...)
})
#' @describeIn BiocFileCache Add an existing resource to the database
#' @param fpath For bfcadd(), character(1) path to current file
#' location or remote web resource. If none is given, the rname is
#' assumed to also be the path location. For bfcupdate()
#' character() vector of replacement web resources.
#' @param rtype character(1) 'local', 'relative', or 'web' indicating
#' if the resource is a local file, a relative path in the cache,
#' or a web resource. For \code{bfcnew}: local or relative are
#' only options. For \code{bfcadd}, the default 'auto' creates
#' relative or web paths, based on the path prefix.
#' @param action character(1) How to handle the file: create a
#' \code{copy} of \code{fpath} in the cache directory; \code{move}
#' the file to the cache directory; or \code{asis} leave the file
#' in current location but save the path in the cache. If 'rtype
#' == "relative"', action can not be "asis".
#' @param proxy character(1) (Optional) proxy server.
#' @param download logical(1) If \code{rtype=web}, should remote
#' resource be downloaded locally immediately.
#' @param config list() passed as config argument in \code{httr::GET}
#' @param ... For 'bfcadd', 'bfcupdate' and 'bfcdownload': Additional
#' arguments passed to internal download functions for use with
#' \code{httr::GET}. For 'bfcrpaths': Additional arguments passed
#' to 'bfcadd', or \code{exact} passed to 'bfcquery'. For
#' 'bfcquery': Additional arguments passed to \code{grepl}. For
#' 'exportbfc': Additional arguments to the selected outputMethod
#' function. See \code{utils::tar} or \code{utils::zip} for more
#' information. For 'importbfc': Additional arguments to the
#' selected archiveMethod function. See \code{utils::untar} or
#' \code{utils::unzip} for more information.
#' @return For 'bfcadd': named character(1), the path to save your
#' object / file. The name of the character is the unique rid for
#' the resource.
#' @examples
#' fl1 <- tempfile(); file.create(fl1)
#' bfcadd(bfc0, "Test1", fl1) # copy
#' fl2 <- tempfile(); file.create(fl2)
#' bfcadd(bfc0, "Test2", fl2, action="move") # move
#' fl3 <- tempfile(); file.create(fl3)
#' add3 <- bfcadd(bfc0, "Test3", fl3, rtype="local", action="asis") # reference
#' rid3 <- names(add3)
#'
#' bfc0
#' file.exists(fl1) # TRUE
#' file.exists(fl2) # FALSE
#' file.exists(fl3) # TRUE
#'
#' # add a remote resource
#' url <- "http://httpbin.org/get"
#' bfcadd(bfc0, "TestWeb", fpath=url)
#' @aliases bfcadd
#' @exportMethod bfcadd
setMethod("bfcadd", "BiocFileCache",
function(
x, rname, fpath = rname,
rtype = c("auto", "relative", "local", "web"),
action = c("copy", "move", "asis"),
proxy = "", download = TRUE, config = list(), ext=NA_character_,
fname=c("unique", "exact"),...)
{
stopifnot(
is.character(rname), length(rname) > 0L, !any(is.na(rname)),
is.character(fpath), length(fpath) > 0L, !any(is.na(fpath))
)
stopifnot(all(action %in% c("copy", "move", "asis")),
all(rtype %in% c("auto", "relative", "local", "web")))
if (missing(rtype)) rtype <- match.arg(rtype)
if (missing(action)) action <- match.arg(action)
stopifnot((length(action) == 1) || (length(action) == length(fpath)))
stopifnot((length(rtype) == 1) || (length(rtype) == length(fpath)))
if (length(action) == 1) action = rep(action, length(fpath))
if (length(rtype) == 1) rtype = rep(rtype, length(fpath))
rtype <- .util_standardize_rtype(rtype, fpath, action)
stopifnot(all(rtype == "web" | file.exists(fpath)))
fname <- match.arg(fname)
rpath <- .sql_add_resource(x, rname, rtype, fpath, ext, fname)
rid <- names(rpath)
for(i in seq_along(rpath)){
if (rtype[i] %in% c("local", "relative")) {
switch(
action[i],
copy = file.copy(fpath[i], rpath[i]),
move = file.rename(fpath[i], rpath[i]),
asis = {
.sql_set_rpath(x, rid[i], fpath[i])
rpath[i] <- bfcrpath(x, rids = rid[i])
}
)
} else if (download) { # rtype == "web"
.util_download(x, rid[i], proxy, config, "bfcadd()", ...)
}
}
rpath
})
#' @export
setGeneric("bfcinfo",
function(x, rids) standardGeneric("bfcinfo"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcinfo,missing-method
#' @exportMethod bfcinfo
setMethod("bfcinfo", "missing",
function(x, rids)
{
bfcinfo(x=BiocFileCache(), rids=rids)
})
#' @describeIn BiocFileCache list resources in database
#' @param rids character() Vector of rids.
#' @return For 'bfcinfo': A \code{bfc_tbl} of current resources in the
#' database.
#' @examples
#' bfcinfo(bfc0)
#' @aliases bfcinfo
#' @exportMethod bfcinfo
setMethod("bfcinfo", "BiocFileCacheBase",
function(x, rids)
{
if (missing(rids))
rids <- bfcrid(x)
stopifnot(all(rids %in% bfcrid(x)))
tbl <- .sql_get_resource_table(x, rids)
tbl <- mutate(tbl, rpath = unname(bfcrpath(x, rids=rids)))
class(tbl) <- c("tbl_bfc", class(tbl))
tbl
})
setOldClass("tbl_bfc")
#' @describeIn BiocFileCache Get the rids of the object
#' @exportMethod bfcrid
setMethod("bfcrid", "tbl_bfc", function(x) .get_tbl_rid(x))
#' @export
setGeneric("bfcpath",
function(x, rids) standardGeneric("bfcpath"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcpath,missing-method
#' @exportMethod bfcpath
setMethod("bfcpath", "missing",
function(x, rids)
{
bfcpath(x=BiocFileCache(), rids=rids)
})
#' @describeIn BiocFileCache display rpaths of resource.
#' @return For 'bfcpath': the file path location to load
#' @examples
#' bfcpath(bfc0, rid3)
#' @aliases bfcpath
#' @exportMethod bfcpath
setMethod("bfcpath", "BiocFileCacheBase",
function(x, rids)
{
if (missing(rids))
rids <- bfcrid(x)
stopifnot(length(rids) > 0L, all(rids %in% bfcrid(x)))
path <- .sql_get_rpath(x, rids)
path
})
#' @export
setGeneric("bfcrpath",
function(x, rnames, ..., rids, exact = TRUE) standardGeneric("bfcrpath"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcrpath,missing-method
#' @exportMethod bfcrpath
setMethod("bfcrpath", "missing",
function(x, rnames, ..., rids, exact = TRUE)
{
bfcrpath(x=BiocFileCache(), rnames=rnames, ..., rids=rids, exact=exact)
})
#' @describeIn BiocFileCache display rpath of resource. If 'rnames' is
#' in the cache the path is returned, if it is not it will try to
#' add it to the cache with 'bfcadd'
#' @param rnames character() to match against rnames. Each element of
#' \code{rnames} must match exactly one record. Use \code{exact =
#' FALSE} to use regular expression matching.
#' @return For 'bfcrpath': The local file path location to load.
#' @examples
#' bfcrpath(bfc0, rids = rid3)
#' @aliases bfcrpath
#' @exportMethod bfcrpath
setMethod("bfcrpath", "BiocFileCacheBase",
function(x, rnames, ..., rids, exact = TRUE)
{
if (!missing(rnames) && !missing(rids))
stop("specify either 'rnames' or 'rids' not both.")
update_time_and_path <- function(x, i) {
.sql_get_rpath(x, i)
}
add_or_return_rname <- function(x, rname, ..., exact) {
res <- bfcrid(bfcquery(x, rname, field="rname", exact = exact))
if (length(res) == 0L) {
## obtain an exclusive lock to add 'rname'
id <- "add_or_return_rname"
locfile_path <- file.path(bfccache(x), id)
locfile <- .lock2(locfile_path, exclusive = TRUE)
tryCatch({
## need to re-check that the resource is still needed,
## now that we have the exclusive lock
res <- bfcrid(bfcquery(x, rname, field="rname", exact = exact))
if (length(res) == 0L) {
message("adding rname '", rname, "'")
names(bfcadd(x, rname, ...))
} else {
names(update_time_and_path(x, res))
}
}, error=function(e) {
warning(
"\ntrying to add rname '", rname, "' produced error:",
"\n ", conditionMessage(e)
)
NA_character_
}, finally = function() {
.unlock2(locfile_path)
})
} else if (length(res) == 1L) {
names(update_time_and_path(x, res))
} else {
warning("'rnames' ",
if (exact) "exact" else "regular expression",
" pattern",
"\n '", rname, "'",
"\n is not unique; use 'bfcquery()' to see matches.")
NA_character_
}
}
if (missing(rids))
rids <- bfcrid(x)
if (!missing(rnames)) {
rids0 <- vapply(
rnames, add_or_return_rname, character(1), x=x, ..., exact = exact
)
if (anyNA(rids0)) {
rmdx <- setdiff(bfcrid(x), rids)
if (length(rmdx) > 0L)
bfcremove(x, rmdx)
stop("not all 'rnames' found or unique.")
}
bfcrpath(x, rids = rids0)
} else {
stopifnot(all(rids %in% bfcrid(x)))
update_time_and_path(x, rids)
}
})
#' @export
setGeneric("bfcupdate",
function(x, rids, ...) standardGeneric("bfcupdate"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcupdate,missing-method
#' @exportMethod bfcupdate
setMethod("bfcupdate", "missing",
function(x, rids, ...)
{
bfcupdate(x=BiocFileCache(), rids=rids, ...)
})
#' @describeIn BiocFileCache Update a resource in the cache
#' @param rpath character() vector of replacement rpaths.
#' @return For 'bfcupdate': an updated \code{BiocFileCache} object,
#' invisibly.
#' @examples
#' bfcupdate(bfc0, rid3, rpath=fl3, rname="NewRname")
#' bfc0[[rid3]] = fl1
#' bfcupdate(bfc0, "BFC5", fpath="http://google.com")
#' @aliases bfcupdate
#' @exportMethod bfcupdate
setMethod("bfcupdate", "BiocFileCache",
function(x, rids, ..., rname=NULL, rpath=NULL, fpath=NULL,
proxy="", config=list(), ask=TRUE)
{
stopifnot(!missing(rids), all(rids %in% bfcrid(x)))
stopifnot(
is.null(rname) || (length(rids) == length(rname)),
is.null(rpath) || (length(rids) == length(rpath)),
is.null(fpath) || (length(rids) == length(fpath))
)
stopifnot(
is.null(rname) || is.character(rname),
is.null(rpath) || is.character(rpath),
is.null(fpath) || is.character(fpath)
)
if(is.null(rname) && is.null(rpath) && is.null(fpath)) {
stop("bfcupdate() has nothing to update.",
"\n Please set rname, rpath, or fpath",
call.=FALSE)
}
info <- NULL
for (i in seq_along(rids)) {
.sql_set_time(x, rids[i])
if (!is.null(rname)) {
.sql_set_rname(x, rids[i], rname[i])
}
if (!is.null(rpath)) {
if (!file.exists(rpath[i]))
stop(
"bfcupdate() failed",
"\n rid: ", rids[i],
"\n rpath: ", sQuote(rpath[i]),
"\n reason: rpath does not exist.",
call.=FALSE
)
.sql_set_rpath(x, rids[i], rpath[i])
rtype <- unname(.sql_get_rtype(x, rids[i]))
if (identical(rtype, "relative") || identical(rtype, "web")) {
warning("updating rpath, changing rtype to 'local'")
.sql_set_rtype(x, rids[i], "local")
}
}
if (!is.null(fpath)) {
if (.sql_get_rtype(x, rids[i]) != "web")
stop("bfcupdate() failed",
"\n rid: ", rids[i],
"\n reason: resource rtype is not 'web'",
call.=FALSE)
if (ask) {
doit <- .util_ask(
"Setting a new remote path results in immediate\n",
" download and overwriting of existing file.\n",
" Continue?"
)
} else {
doit <- TRUE
}
if (doit) {
.util_download_and_rename(
x, rids[i], proxy, config, "bfcupdate()", fpath[i], ...
)
.sql_set_fpath(x, rids[i], fpath[i])
}
}
}
invisible(x)
})
#' @rdname BiocFileCache-class
#' @export
setGeneric("bfcmeta<-",
function(x, name, ..., value)
standardGeneric("bfcmeta<-"),
signature = "x"
)
#' @describeIn BiocFileCache add meta data table in database
#' @param name character(1) name of metadata table.
#' @return For 'bfcmeta': updated BiocFileCache, invisibly
#' @examples
#' meta = data.frame(list(rid = paste("BFC",seq_len(bfccount(bfc0)), sep=""),
#' num=seq(bfccount(bfc0),1,-1),
#' data=c(paste("Letter",
#' letters[seq_len(bfccount(bfc0))]))),
#' stringsAsFactors=FALSE)
#' bfcmeta(bfc0, name="resourcedata") <- meta
#' @aliases bfcmeta<-
#' @exportMethod bfcmeta<-
setReplaceMethod("bfcmeta", "BiocFileCacheBase",
function(x, name, ..., value)
{
stopifnot("rid" %in% colnames(value))
rids <- value$rid
stopifnot(all(rids %in% bfcrid(x)))
stopifnot(is.character(name), length(name) == 1L, !is.na(name))
if (name %in% .RESERVED$TABLES)
stop(
"'", name, "' cannot be added; reserved table names: ",
paste(sQuote(.RESERVED$TABLES), collapse=", ")
)
if (any(colnames(value) %in% .RESERVED$COLUMNS))
stop(
"'value' (metadata) cannot contain colnames ",
paste(sQuote(.RESERVED$COLUMNS), collapse= ", ")
)
.sql_meta_gets(x, name, value, ...)
x
})
#' @export
setGeneric("bfcmetaremove",
function(x, name, ...) standardGeneric("bfcmetaremove"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcmetaremove,missing-method
#' @exportMethod bfcmetaremove
setMethod("bfcmetaremove", "missing",
function(x, name, ...)
{
bfcmetaremove(x=BiocFileCache(), name=name, ...)
})
#' @describeIn BiocFileCache remove meta data table in database
#' @return For 'bfcmetaremove': updated BiocFileCache, invisibly
#' @examples
#' \dontrun{bfcmetaremove(bfc0, "resourcedata")}
#' @aliases bfcmetaremove
#' @exportMethod bfcmetaremove
setMethod("bfcmetaremove", "BiocFileCacheBase",
function(x, name, ...)
{
stopifnot(
!missing(name), is.character(name), length(name) == 1L, !is.na(name)
)
if (name %in% .RESERVED$TABLES)
stop("reserved table '", name, "' cannot be removed")
.sql_meta_remove(x, name, ...)
invisible(x)
})
#' @export
setGeneric("bfcmetalist",
function(x) standardGeneric("bfcmetalist"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcmetalist,missing-method
#' @exportMethod bfcmetalist
setMethod("bfcmetalist", "missing",
function(x)
{
bfcmetalist(x=BiocFileCache())
})
#' @describeIn BiocFileCache retrieve listing of metadata tables
#' @return For 'bfcmetalist': returns a character() of all metadata tables
#' currently in the database. If no metadata tables are available returns
#' character(0)
#' @examples
#' bfcmetalist(bfc0)
#' @aliases bfcmetalist
#' @exportMethod bfcmetalist
setMethod("bfcmetalist", "BiocFileCacheBase",
function(x)
{
.sql_meta_list(x)
})
#' @export
setGeneric("bfcmeta",
function(x, name, ...) standardGeneric("bfcmeta"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcmeta,missing-method
#' @exportMethod bfcmeta
setMethod("bfcmeta", "missing",
function(x, name, ...)
{
bfcmeta(x=BiocFileCache(), name=name, ...)
})
#' @describeIn BiocFileCache retrieve metadata table
#' @return For 'bfcmeta': returns a data.frame representation of database
#' table
#' @examples
#' tbl = bfcmeta(bfc0, "resourcedata")
#' tbl
#' @aliases bfcmeta
#' @exportMethod bfcmeta
setMethod("bfcmeta", "BiocFileCacheBase",
function(x, name, ...)
{
if (missing(name)) {
tbls <- paste(sQuote(bfcmetalist(x)), collapse=", ")
if (!nzchar(tbls))
tbls <- NA_character_
stop("metadata table 'name' missing, possible values: ", tbls)
}
stopifnot(is.character(name), length(name) == 1L, !is.na(name))
.sql_meta(x, name, ...)
})
#' @export
setGeneric("bfcquerycols",
function(x) standardGeneric("bfcquerycols")
)
#' @rdname BiocFileCache-class
#' @aliases bfcquerycols,missing-method
#' @exportMethod bfcquerycols
setMethod("bfcquerycols", "missing",
function(x)
{
bfcquerycols(x=BiocFileCache())
})
#' @describeIn BiocFileCache Get all the possible columns to query
#' @return For 'bfcquerycols': character() all columns in all database tables
#' available for query.
#' @examples
#' bfcquerycols(bfc0)
#' @aliases bfcquerycols
#' @exportMethod bfcquerycols
setMethod("bfcquerycols", "BiocFileCacheBase",
function(x)
{
.get_all_colnames(x)
})
#' @export
setGeneric("bfcquery",
function(x, query, field=c("rname", "rpath", "fpath"), ..., exact = FALSE)
standardGeneric("bfcquery"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcquery,missing-method
#' @exportMethod bfcquery
setMethod("bfcquery", "missing",
function(x, query, field=c("rname", "rpath", "fpath"), ..., exact = FALSE)
{
bfcquery(x=BiocFileCache(), query=query, field=field, ..., exact = exact)
})
#' @describeIn BiocFileCache query resource
#' @param query character() Regular expression pattern(s) to match in
#' resource. It will match the pattern against \code{fields},
#' using \code{&} logic across query element. By default, case
#' sensitive. When \code{exact = TRUE}, \code{query} uses exact
#' matching.
#' @param field character() column names in resource to query, using
#' \code{||} logic across multiple field elements. By default,
#' matches pattern agains rname, rpath, and fpath. If exact
#' matching, may only be a single value.
#' @param exact logical(1) when FALSE, treat \code{query} as a regular
#' expression. When TRUE, use exact matching. For \code{bfcquery},
#' the default is \code{FALSE} (regular expression matching; for
#' \code{bfcrpath}, the default is \code{TRUE} (exact matching).
#' @return For 'bfcquery': A \code{bfc_tbl} of current resources in
#' the database whose \code{field} contained query. If multiple
#' values are given, the resource must contain all of the
#' patterns. A tbl with zero rows is returned when no resources
#' match the query.
#' @examples
#' bfcquery(bfc0, "Test")
#' bfcquery(bfc0, "^Test1$", field="rname")
#' @aliases bfcquery
#' @exportMethod bfcquery
setMethod("bfcquery", "BiocFileCacheBase",
function(x, query, field=c("rname", "rpath", "fpath"), ..., exact = FALSE)
{
stopifnot(is.character(query))
stopifnot(all(field %in% .get_all_colnames(x)))
keep <- TRUE
if (exact) {
tryCatch({
where <- paste(field, "== :query", collapse=" OR ")
.sql_select_query(x, where, query = query)
})
} else {
tbl <- .sql_get_resource_table(x)
for (q in query)
keep <- keep & Reduce(`|`, lapply(tbl[field], grepl, pattern = q, ...))
rids <- intersect(tbl$rid[keep], bfcrid(x))
bfcinfo(x, rids)
}
})
#' @export
setGeneric("bfccount",
function(x) standardGeneric("bfccount")
)
#' @rdname BiocFileCache-class
#' @aliases bfccount,missing-method
#' @exportMethod bfccount
setMethod("bfccount", "missing",
function(x)
{
bfccount(x=BiocFileCache())
})
#' @describeIn BiocFileCache Get the number of objects in the file
#' cache or query.
#' @return For 'bfccount': integer(1) Number of objects in the cache
#' or query.
#' @examples
#' bfccount(bfc0)
#' bfccount(bfcquery(bfc0, "test"))
#' @aliases bfccount
#' @exportMethod bfccount
setMethod("bfccount", "BiocFileCacheBase",
function(x)
{
bfccount(bfcinfo(x))
})
#' @rdname BiocFileCache-class
#' @aliases bfccount,tbl_bfc-method
#' @exportMethod bfccount
setMethod("bfccount", "tbl_bfc",
function(x)
{
.sql_get_nrows(x)
})
#' @export
setGeneric("bfcneedsupdate",
function(x, rids) standardGeneric("bfcneedsupdate"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcneedsupdate,missing-method
#' @exportMethod bfcneedsupdate
setMethod("bfcneedsupdate", "missing",
function(x, rids)
{
bfcneedsupdate(x=BiocFileCache(), rids=rids)
})
#' @describeIn BiocFileCache check if a resource needs to be updated
#' @return For 'bfcneedsupdate': named logical vector if resource
#' needs to be updated. The name is the resource
#' 'rid'. \code{TRUE}: fpath \code{etag} or \code{modified} time of
#' web resource more recent than in BiocFileCache; \code{FALSE}: fpath
#' \code{etag} or \code{modified} time of web resource not more recent
#' than in BiocFileCache; \code{NA}: web resource etag and modified time
#' could not be determined. If the etag is available the function will use
#' that information definitively and only compare last modified time if
#' etag is not available. If there is an \code{expires} time that will be
#' used to initially determine if the resource should be updated.
#' @examples
#' bfcneedsupdate(bfc0, "BFC5")
#' @aliases bfcneedsupdate
#' @exportMethod bfcneedsupdate
setMethod("bfcneedsupdate", "BiocFileCacheBase",
function(x, rids)
{
if (missing(rids))
rids <- .get_all_web_rids(x)
stopifnot(all(rids %in% bfcrid(x)))
if (!all(rids %in% .get_all_web_rids(x)))
stop("rids not all web resources")
helper <- function(x, rid) {
file_time <- .sql_get_last_modified(x, rid)
fpath <- .sql_get_fpath(x, rid)
file_etag <- .sql_get_etag(x, rid)
file_expires <- .sql_get_expires(x, rid)
cache_info <- .httr_get_cache_info(fpath)
web_time <- cache_info[["modified"]]
web_etag <- cache_info[["etag"]]
if (!is.na(file_expires))
expired <- as.Date(file_expires, optional=TRUE) <= Sys.Date()
else
expired <- FALSE
checkTime <- FALSE
if (expired){
res <- TRUE
checkTime <- FALSE
} else {
if (is.na(web_etag) || is.na(file_etag)) {
checkTime <- TRUE
} else {
res <- !identical(unname(file_etag), web_etag)
}
if (checkTime) {
if (is.na(file_time) || is.na(web_time)) {
res <- NA
} else {
res <- as.POSIXlt(web_time, optional=TRUE) >
as.POSIXlt(file_time, optional=TRUE)
}
}
}
res
} # end helper
result <- vapply(rids, helper, logical(1), x=x)
# if web resources hasn't been locally downloaded yet
result[rids %in% .get_rid_filenotfound(x)] = TRUE
setNames(result, rids)
})
#' @export
setGeneric("bfcdownload",
function(x, rid, proxy="", config=list(), ask=TRUE, FUN, ...)
standardGeneric("bfcdownload"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcdownload,missing-method
#' @param rid character(1) Unique resource id.
#' @exportMethod bfcdownload
setMethod("bfcdownload", "missing",
function(x, rid, proxy="", config=list(), ask=TRUE, FUN, ...)
{
bfcdownload(x=BiocFileCache(), rid=rid, proxy=proxy, config=config, ask=ask,
FUN=FUN, ...)
})
#' @describeIn BiocFileCache Redownload resource to location in cache
#' @param FUN A specialized implemented function designed by the user. This
#' function can be used to perform and save the results of a post download
#' processing step rather than direct output. The function should ONLY take in
#' two file names: the first the raw downloaded file and the second the output
#' file for saved results. The output of the function should be TRUE/FALSE if
#' step was successful. See vignette section on Specialty Advance Use Case for
#' more details.
#' @return For 'bfcdownload': character(1) path to downloaded resource
#' in cache.
#' @examples
#' bfcdownload(bfc0, "BFC5")
#' @aliases bfcdownload
#' @exportMethod bfcdownload
setMethod("bfcdownload", "BiocFileCache",
function(x, rid, proxy="", config=list(), ask=TRUE, FUN, ...)
{
stopifnot(
!missing(rid), length(rid) > 0L,
all(rid %in% bfcrid(x)),
all(.sql_get_rtype(x, rid) == "web")
)
.sql_set_time(x, rid)
if (ask && any(file.exists(.sql_get_rpath(x, rid)))) {
doit <- .util_ask(
"bfcdownload() will overwrite exisiting files, continue?"
)
} else {
doit <- TRUE
}
if (doit)
.util_download_and_rename(x, rid, proxy, config, "bfcdownload()",
FUN=FUN, ...)
bfcrpath(x, rids=rid)
})
#' @export
setGeneric("bfcremove",
function(x, rids) standardGeneric("bfcremove"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcremove,missing-method
#' @exportMethod bfcremove
setMethod("bfcremove", "missing",
function(x, rids)
{
bfcremove(x=BiocFileCache(), rids=rids)
})
#' @describeIn BiocFileCache Remove a resource to the database. If
#' the local file is located in \code{bfccache(x)}, the file will
#' also be deleted. This will not delete information in any metadata
#' table.
#' @return For 'bfcremove': updated BiocFileCache object, invisibly
#' @examples
#' bfcremove(bfc0, rid3)
#' bfcinfo(bfc0)
#' @aliases bfcremove
#' @exportMethod bfcremove
setMethod("bfcremove", "BiocFileCache",
function(x, rids)
{
stopifnot(all(rids %in% bfcrid(x)))
rpaths <- .sql_get_rpath(x, rids)
cached <- startsWith(rpaths, bfccache(x))
.sql_remove_resource(x, rids)
status <- .util_unlink(rpaths[cached])
invisible(x)
})
#' @export
setGeneric("bfcsync",
function(x, verbose = TRUE, ask = TRUE) standardGeneric("bfcsync"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcsync,missing-method
#' @exportMethod bfcsync
setMethod("bfcsync", "missing",
function(x, verbose = TRUE, ask = TRUE)
{
bfcsync(x=BiocFileCache(), verbose=verbose, ask=ask)
})
#' @describeIn BiocFileCache sync cache and resource.
#' @param verbose logical(1) If descriptive message and list of issues
#' should be included as output.
#' @return For 'bfcsync': logical(1) indicating whether the cache is
#' in sync (\code{TRUE}) or not. 'verbose' is TRUE by default, so
#' descriptive messages will also be included.
#' @examples
#' bfcsync(bfc0)
#'
#' if (!interactive()){
#' # in interactive mode, in the sync above
#' # this was probably already removed
#' # noninteractive mode does not remove resources
#' # so can remove manually here
#' bfcremove(bfc0, "BFC1")
#' }
#' bfcsync(bfc0, FALSE)
#' @aliases bfcsync
#' @importFrom utils capture.output
#' @exportMethod bfcsync
setMethod("bfcsync", "BiocFileCache",
function(x, verbose=TRUE, ask = TRUE)
{
stopifnot(is.logical(verbose), length(verbose) == 1L, !is.na(verbose))
# files not found
rids <- .get_rid_filenotfound(x)
# files untracked in cache location
files <- file.path(bfccache(x), setdiff(dir(bfccache(x)),c(.CACHE_FILE, .CACHE_FILE_LOCK)))
paths <- .sql_get_rpath(x, bfcrid(x))
# normalizePath on windows
# can't across platform - no opt on linux but added hidden on mac
if (tolower(.Platform$OS.type) == "windows") {
files = normalizePath(files)
paths = normalizePath(paths)
}
untracked <- setdiff(files, paths)
rids0 <- rids; untracked0 <- untracked
if (verbose && (length(rids) != 0L))
message(
"entries without corresponding files: ",
paste0("'", rids, "'", collapse=" ")
)
if (ask && (length(rids) != 0L)) {
doit <- .util_ask("delete ", length(rids), " entries?")
rids <- rids[doit]
}
if (verbose && (length(untracked) != 0L))
message(
"files without cache entries\n ",
paste(untracked, collpase="\n ")
)
if (ask && (length(untracked) != 0L)) {
doit <- .util_ask("delete ", length(untracked), " files?")
untracked <- untracked[doit]
}
.sql_remove_resource(x, rids)
.util_unlink(untracked)
!length(setdiff(rids0, rids)) && !length(setdiff(untracked0, untracked))
})
#' @export
setGeneric("exportbfc",
function(x, rids,
outputFile="BiocFileCacheExport.tar", outputMethod=c("tar","zip"),
verbose=TRUE, ...)
standardGeneric("exportbfc"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases exportbfc,missing-method
#' @exportMethod exportbfc
setMethod("exportbfc", "missing",
function(x, rids,
outputFile="BiocFileCacheExport.tar", outputMethod=c("tar","zip"),
verbose=TRUE, ...)
{
exportbfc(x=BiocFileCache(), rids=rids,
outputFile=outputFile, outputMethod=outputMethod,
verbose=verbose, ...)
})
#' @describeIn BiocFileCache Create exportable file containing
#' BiocFileCache.
#' @param outputFile character(1) The <filepath>/basename for the
#' output archive. Please include appropriate extension based on
#' outMethod and any additional parameters selected for
#' \code{utils::tar} or \code{utils::zip}
#' @param outputMethod Either 'tar' or 'zip' for how the directory
#' should be archived. Default is 'tar'.
#' @return character(1) The outputFile path.
#' @examples
#' \dontrun{exportbfc(bfc)}
#' @aliases exportbfc
#' @exportMethod exportbfc
setMethod("exportbfc", "BiocFileCacheBase",
function(x, rids,
outputFile="BiocFileCacheExport.tar", outputMethod=c("tar","zip"),
verbose=TRUE, ...)
{
if (missing(rids))
rids <- bfcrid(x)
stopifnot(all(rids %in% bfcrid(x)))
stopifnot(length(outputFile) == 1L, is.character(outputFile))
outputMethod <- match.arg(outputMethod)
stopifnot(is.logical(verbose), length(verbose) == 1L)
bfc <- x[rids]
if (length(bfc) == 0L)
stop("No valid rids selected")
dir <- file.path(tempdir(), "BiocFileCacheExport")
dir.create(dir)
ids <- bfcrid(bfc)
file.copy(.sql_dbfile(x), dir)
newbfc <- BiocFileCache(dir)
idrm <- setdiff(.get_all_rids(newbfc), ids)
if (length(idrm) != 0)
newbfc <- bfcremove(newbfc, rids=idrm)
res <- vapply(ids, .util_export_file, character(1),
bfc=x, dir=dir)
.sql_set_time(x, ids)
# 'relative' = ok, 'web'= not download
# 'local' = file not in cache, 'NA' = file not found
if (any(res == "web", na.rm=TRUE)) {
webid <- names(which(res == "web"))
if (verbose)
message(
"The following are identified as web resources\n",
"but have not been downloaded yet. No associated\n",
"files will be exported:\n",
" ", paste0("'", webid, "'", collapse=" "),
"\n\n"
)
}
if (any(res == "local", na.rm=TRUE)) {
locid <- names(which(res == "local"))
if (verbose)
message(
"The following are identified as local resources.\n",
"A copy of the file will be exported:\n",
" ", paste0("'", locid, "'", collapse=" "),
"\n\n"
)
for (i in locid) {
orig <- .sql_get_rpath(x, i)
newpath <- file.path(dir, basename(orig))
if (file.exists(newpath)) {
filename <- paste(basename(tempfile("", bfccache(newbfc))),
basename(orig), sep="_")
newpath <- file.path(dir, filename)
}
file.copy(orig, newpath)
}
}
if (any(is.na(res))) {
naid <- names(which(is.na(res)))
if (verbose)
message(
"The following had a file that was not found.\n",
"The file is not included and the rid will be removed\n",
"from the BiocFileCache object being exported:\n",
" ", paste0("'", naid, "'", collapse=" "),
"\n\n"
)
newbfc <- bfcremove(newbfc, rids=naid)
}
if (length(bfcmetalist(newbfc)) != 0) {
metaList <- bfcmetalist(newbfc)
res <- vapply(metaList, .sql_filter_metadata, logical(1),
bfc=newbfc, verbose=verbose)
}
# tar/zip up directory
origdir <- getwd()
if (dirname(outputFile) == ".")
outputFile = file.path(origdir, outputFile)
setwd(dirname(dir))
files = basename(dir)
archive <- function(outputFile, how = c("tar", "zip"), files, ...) {
fun <- switch(how, tar = tar, zip = zip)
fun(outputFile, files, ...)
}
# remove lock file from export
.util_unlink(file.path(dir, .CACHE_FILE_LOCK))
archive(outputFile=outputFile, how=outputMethod, files=files, ...)
setwd(origdir)
.util_unlink(dir, recursive=TRUE)
outputFile
})
#' @export
setGeneric("importbfc",
function(filename, archiveMethod=c("untar","unzip"),
exdir=".", ...)
standardGeneric("importbfc"),
signature = "filename"
)
#' @describeIn BiocFileCache Import file created with exportbfc containing
#' BiocFileCache.
#' @param filename character(1) The name of the archive.
#' @param archiveMethod Either 'untar' or 'unzip' for how the directory should
#' be extracted. Default is 'untar'.
#' @param exdir Directory to extract files too. See \code{utils::untar} or
#' \code{utils::unzip} for more details.
#' @return A BiocFileCache object
#' @examples
#' \dontrun{importbfc("ExportBiocFileCache.tar")}
#' @aliases importbfc
#' @exportMethod importbfc
setMethod("importbfc", "character",
function(filename, archiveMethod=c("untar","unzip"),
exdir=".", ...)
{
exportPath <- file.path(exdir, "BiocFileCacheExport")
stopifnot(!dir.exists(exportPath))
stopifnot(length(exdir) == 1L, is.character(exdir))
stopifnot(length(filename) == 1L, is.character(filename))
archiveMethod = match.arg(archiveMethod)
inflate <- function(filename, how = c("untar", "unzip"), exdir, ...) {
fun <- switch(how, untar = untar, unzip = unzip)
fun(filename, exdir=exdir, ...)
}
inflate(filename=filename, how=archiveMethod, exdir=exdir, ...)
bfc = BiocFileCache(exportPath)
bfc
})
#' @export
setGeneric("cleanbfc",
function(x, days = 120, ask = TRUE) standardGeneric("cleanbfc"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases cleanbfc,missing-method
#' @exportMethod cleanbfc
setMethod("cleanbfc", "missing",
function(x, days = 120, ask = TRUE)
{
cleanbfc(x=BiocFileCache(), days=days, ask=ask)
})
#' @describeIn BiocFileCache Remove old/unused files in
#' BiocFileCache. If file to be removed is not in the bfccache
#' location it will not be deleted. Setting \code{days=-Inf}
#' will remove all cached files.
#' @param days integer(1) Number of days between accessDate and
#' currentDate; if exceeded entry will be deleted.
#' @return For 'cleanbfc': updated BiocFileCache, invisibly.
#' @examples
#' \dontrun{cleanbfc(bfc, ask=FALSE)}
#' @aliases cleanbfc
#' @exportMethod cleanbfc
setMethod("cleanbfc", "BiocFileCache",
function(x, days = 120, ask=TRUE)
{
stopifnot(is.numeric(days), length(days) == 1L, !is.na(days))
stopifnot(is.logical(ask), length(ask) == 1L, !is.na(ask))
rids <- .sql_clean_cache(x, days)
rpaths <- .sql_get_rpath(x, rids)
cached <- startsWith(rpaths, bfccache(x))
if (ask) {
txt0 <- paste("file ", sQuote(rpaths))
txt <- sprintf("Remove id %s %s", sQuote(rids), ifelse(cached, txt0, ""))
doit <- vapply(txt, .util_ask, logical(1))
rids <- rids[doit]
cached <- cached & doit
}
.sql_remove_resource(x, rids)
.util_unlink(rpaths[cached])
invisible(x)
})
#' @export
setGeneric("removebfc",
function(x, ask = TRUE) standardGeneric("removebfc"),
signature="x"
)
#' @rdname BiocFileCache-class
#' @aliases removebfc,missing-method
#' @exportMethod removebfc
setMethod("removebfc", "missing",
function(x, ask = TRUE)
{
removebfc(x=BiocFileCache(), ask=ask)
})
#' @describeIn BiocFileCache Completely remove the BiocFileCache
#' @return For 'removebfc': TRUE if successfully removed.
#' @examples
#' \dontrun{removebfc(bfc, ask=FALSE)}
#' @aliases removebfc
#' @exportMethod removebfc
setMethod("removebfc", "BiocFileCache",
function(x, ask=TRUE)
{
stopifnot(is.logical(ask), length(ask) == 1L, !is.na(ask))
doit <- FALSE
txt <- paste("remove cache and", length(x), "resource(s)?")
if (!ask || .util_ask(txt))
doit <- .util_unlink(bfccache(x), recursive=TRUE)
doit
})
#' @describeIn BiocFileCache Display a \code{BiocFileCache} instance.
#' @param object A \code{BiocFileCache} instance.
#' @exportMethod show
setMethod("show", "BiocFileCacheBase",
function(object)
{
cat("class: ", class(object), "\n",
"bfccache: ", bfccache(object), "\n",
"bfccount: ", bfccount(object), "\n",
"For more information see: bfcinfo() or bfcquery()\n",
sep="")
})
Bioconductor/BiocFileCache documentation built on Oct. 31, 2024, 6:58 a.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.
Defines functions BiocFileCache
Documented in BiocFileCache
#' @import methods
#' @import httr
#' @importFrom utils tar zip untar unzip
#' @importFrom dplyr mutate
#' @importFrom tools R_user_dir
.BiocFileCacheBase = setClass(
"BiocFileCacheBase",
slots=c(cache="character")
)
.BiocFileCacheReadOnly = setClass(
"BiocFileCacheReadOnly",
contains="BiocFileCacheBase",
slots=c(rid="character")
)
.BiocFileCache = setClass(
"BiocFileCache",
contains="BiocFileCacheBase"
)
#' BiocFileCache class
#'
#' This class represents the location of files stored on disk. Use the
#' return value to add and retrieve files that persist across
#' sessions.
#'
#' @details The package defines 'BiocFileCache', 'BiocFileCacheBase' and
#' 'BiocFileCacheReadOnly' classes.
#'
#' Slots unique to 'BiocFileCache' and related classes:
#' \itemize{
#' \item{'cache': }{character(1) on-disk location (directory path) of the
#' cache}
#' \item{'rid': }{character() of unique rids in the cache. }
#' }
#'
#' The cache creates an RSQLite database to keep track of local and remote
#' resources. Each item located in the database will have the following
#' information:
#' \itemize{
#' \item{'rid': }{resource id. Autogenerated. This is a unique identifier
#' automatically generated when a resource is added to the cache}
#' \item{'rname': }{resource name. This is given by the user when a
#' resource is added to the cache. It does not have to be unique
#' and can be updated at anytime. We recommend descriptive key
#' words and identifers.}
#' \item{'create_time': }{The date and time a resource is added to the cache.}
#' \item{'access_time': }{The date and time a resource is utilized
#' within the cache. The access time is updated when the resource
#' is updated or accessed}
#' \item{'rpath': }{resource path. This is the path to the local
#' (on-disk) file}
#' \item{'rtype': }{resource type. Either "relative", "local", or
#' "web", indicating if the resource has a remote origin}
#' \item{'fpath': }{If rtype is "web", this is the link to the
#' remote resource. It will be utilized to download or update the
#' remote data}
#' \item{'last_modified_time': }{For a remote resource, the
#' last_modified (if available) information for the local copy of
#' the data. This information is checked against the remote
#' resource to determine if the local copy is stale and needs to
#' be updated}
#' }
#'
#' All functions have a quick implementation where if the BiocFileCache object
#' is not passed as an argument, the function uses default 'BiocFileCache()' for
#' implementation. e.g 'bfcinfo()' can be used instead of
#' 'bfcinfo(BiocFileCache())'. The only function this is not available for is
#' 'bfcmeta()<-'; The BiocFileCache object must be defined as a varaible and
#' passed as an argument. See vignette("BiocFileCache") for more details.
#'
#' @param cache character(1) On-disk location (directory path) of
#' cache. For default location see
#' \code{\link[tools]{R_user_dir}}.
#' @param ask logical(1) Ask before creating, updating, overwriting,
#' or removing cache or local file locations.
#' @return For 'BiocFileCache': a \code{BiocFileCache} instance.
#' @examples
#' # bfc <- BiocFileCache() # global cache
#' # bfc
#' bfc0 <- BiocFileCache(tempfile()) # temporary catch for examples
#' @name BiocFileCache-class
#' @aliases BiocFileCache
#' @export BiocFileCache
BiocFileCache <-
function(cache=getBFCOption("CACHE"), ask = interactive())
{
stopifnot(
is.character(cache), length(cache) == 1L, !is.na(cache),
is.logical(ask), length(ask) == 1L, !is.na(ask)
)
if (!file.exists(cache)) {
ans <- !ask
if (ask && !.biocfilecache_flags$get_create_asked()) {
ans <- .util_ask(cache, "\n does not exist, create directory?")
.biocfilecache_flags$set_create_asked()
}
if (ans) {
dir.create(cache, recursive=TRUE)
} else {
cache <- file.path(tempdir(), "BiocFileCache")
if (!file.exists(cache)) {
message("using temporary cache ", cache)
dir.create(cache, recursive=TRUE)
}
}
}
bfc <- .BiocFileCache(cache=cache)
.sql_create_db(bfc)
bfc
}
#' @export
setGeneric("bfccache",
function(x) standardGeneric("bfccache")
)
#' @describeIn BiocFileCache Get the location of the on-disk cache.
#' @param x A \code{BiocFileCache} instance or, if missing, the result
#' of \code{BiocFileCache()}.
#' @return For 'bfccache': character(1) location of the directory
#' containing the cache.
#' @examples
#' bfccache(bfc0)
#' @aliases bfccache
#' @exportMethod bfccache
setMethod("bfccache", "BiocFileCacheBase", function(x) x@cache)
#' @rdname BiocFileCache-class
#' @aliases bfccache,missing-method
#' @exportMethod bfccache
setMethod("bfccache", "missing", function(x) bfccache(BiocFileCache()))
#' @describeIn BiocFileCache Get the number of objects in the file
#' cache.
#' @return For 'length': integer(1) Number of objects in the file
#' cache.
#' @examples
#' length(bfc0)
#' @importFrom stats setNames
#' @exportMethod length
setMethod("length", "BiocFileCacheBase", function(x) length(bfcrid(x)))
#' @rdname BiocFileCache-class
#' @aliases bfcrid
#' @export
setGeneric("bfcrid", function(x) standardGeneric("bfcrid"))
#' @rdname BiocFileCache-class
#' @aliases bfcrid,missing-method
#' @exportMethod bfcrid
setMethod("bfcrid", "missing", function(x) bfcrid(BiocFileCache()))
#' @describeIn BiocFileCache Get the rids of the object.
#' @aliases bfcrid,BiocFileCacheReadOnly-method
#' @exportMethod bfcrid
setMethod("bfcrid", "BiocFileCacheReadOnly", function(x) x@rid)
#' @rdname BiocFileCache-class
#' @aliases bfcrid,BiocFileCache-method
#' @exportMethod bfcrid
setMethod("bfcrid", "BiocFileCache", function(x) .get_all_rids(x))
#' @describeIn BiocFileCache Subset a BiocFileCache object.
#' @param drop Ignored.
#' @return For '[': A subset of the BiocFileCache object.
#' @exportMethod [
setMethod("[", c("BiocFileCache", "character", "missing"),
function(x, i, j, ..., drop=TRUE)
{
stopifnot(all(i %in% bfcrid(x)))
stopifnot(identical(unname(drop), TRUE))
.BiocFileCacheReadOnly(x, rid=as.character(i))
})
#' @rdname BiocFileCache-class
#' @aliases [,BiocFileCacheReadOnly,character,missing-method
#' @exportMethod [
setMethod("[", c("BiocFileCacheReadOnly", "character", "missing"),
function(x, i, j, ..., drop=TRUE)
{
stopifnot(all(i %in% bfcrid(x)))
stopifnot(identical(unname(drop), TRUE))
initialize(x, rid=as.character(i))
})
#' @rdname BiocFileCache-class
#' @aliases [,BiocFileCache,missing,missing-method
#' @exportMethod [
setMethod("[", c("BiocFileCache", "missing", "missing"),
function(x, i, j, ..., drop=TRUE)
{
stopifnot(identical(unname(drop), TRUE))
.BiocFileCacheReadOnly(x, rid=bfcrid(x))
})
#' @rdname BiocFileCache-class
#' @aliases [,BiocFileCacheReadOnly,missing,missing-method
#' @exportMethod [
setMethod("[", c("BiocFileCacheReadOnly", "missing", "missing"),
function(x, i, j, ..., drop=TRUE)
{
x # no-op
})
#' @describeIn BiocFileCache Get a file path for select resources from
#' the cache.
#' @param i character() 'rid' identifiers.
#' @param j Ignored.
#' @return For '[[': named character(1) rpath for the given resource
#' in the cache.
#' @exportMethod [[
setMethod("[[", c("BiocFileCacheBase", "character", "missing"),
function(x, i, j)
{
stopifnot(length(i) == 1L, i %in% bfcrid(x))
.sql_get_rpath(x, i)
})
#' @describeIn BiocFileCache Set the file path of selected resources
#' from the cache.
#' @param value character(1) Replacement file path.
#' @return For '[[<-': Updated BiocFileCache, invisibly.
#' @exportMethod [[<-
setReplaceMethod("[[", c("BiocFileCache", "character", "missing", "character"),
function(x, i, j, ..., value)
{
stopifnot(length(i) == 1L, length(value) == 1L)
stopifnot(file.exists(value))
.sql_set_time(x, i)
.sql_set_rpath(x, i, value)
rtype <- unname(.sql_get_rtype(x, i))
if (identical(rtype, "relative") || identical(rtype, "web")) {
warning("updating rpath, changing rtype to 'local'")
.sql_set_rtype(x, i, "local")
}
x
})
#' @export
setGeneric("bfcnew",
function(x, rname, rtype=c("relative", "local"), ext=NA_character_,
fname=c("unique", "exact"))
standardGeneric("bfcnew"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcnew,missing-method
#' @exportMethod bfcnew
setMethod("bfcnew", "missing",
function(x, rname, rtype=c("relative", "local"), ext=NA_character_,
fname=c("unique", "exact"))
{
bfcnew(x=BiocFileCache(), rname=rname, rtype=rtype, ext=ext, fname=fname)
})
#' @describeIn BiocFileCache Add a resource to the database
#' @param rname character(1) Name of object in file cache. For
#' 'bfcupdate' a character vector of replacement rnames.
#' @param ext character(1) A file extension to add to the local
#' copy of the file (e.g., \sQuote{sqlite}, \sQuote{txt},
#' \sQuote{tar.gz}).
#' @param fname character(1). Options are \sQuote{unique} or
#' \sQuote{exact}. \sQuote{unique} provides each bfc resource with a unique
#' identifier when storing the file, allowing resources with the same name
#' to be stored in the cache. \sQuote{exact} uses the exact file name of the
#' resource; only one of foo/my.txt and bar/my.txt could be stored. Default
#' is \sQuote{unique}.
#' @return For 'bfcnew': named character(1), the path to save your
#' object / file. The name of the return value is the unique rid
#' for the resource.
#' @examples
#' path <- bfcnew(bfc0, "NewResource")
#' path
#' @aliases bfcnew
#' @exportMethod bfcnew
setMethod("bfcnew", "BiocFileCache",
function(x, rname, rtype=c("relative", "local"), ext=NA_character_,
fname=c("unique", "exact"))
{
stopifnot(
is.character(rname), length(rname) > 0L, !any(is.na(rname)),
is.character(ext), length(ext) > 0L
)
rtype <- match.arg(rtype)
fname <- match.arg(fname)
.sql_add_resource(x, rname, rtype, NA_character_, ext, fname)
})
#' @export
setGeneric("bfcadd",
function(
x, rname, fpath = rname, rtype=c("auto", "relative", "local", "web"),
action=c("copy", "move", "asis"), proxy="",
download=TRUE, config=list(), ext=NA_character_,
fname=c("unique", "exact"),...
) standardGeneric("bfcadd"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcadd,missing-method
#' @exportMethod bfcadd
setMethod("bfcadd", "missing",
function(
x, rname, fpath = rname, rtype=c("auto", "relative", "local", "web"),
action=c("copy", "move", "asis"), proxy="",
download=TRUE, config=list(), ext=NA_character_,
fname=c("unique", "exact"), ...
)
{
bfcadd(x=BiocFileCache(), rname=rname, fpath=fpath, rtype=rtype,
action=action, proxy=proxy, download=download, config=config,
ext=ext, fname=fname,...)
})
#' @describeIn BiocFileCache Add an existing resource to the database
#' @param fpath For bfcadd(), character(1) path to current file
#' location or remote web resource. If none is given, the rname is
#' assumed to also be the path location. For bfcupdate()
#' character() vector of replacement web resources.
#' @param rtype character(1) 'local', 'relative', or 'web' indicating
#' if the resource is a local file, a relative path in the cache,
#' or a web resource. For \code{bfcnew}: local or relative are
#' only options. For \code{bfcadd}, the default 'auto' creates
#' relative or web paths, based on the path prefix.
#' @param action character(1) How to handle the file: create a
#' \code{copy} of \code{fpath} in the cache directory; \code{move}
#' the file to the cache directory; or \code{asis} leave the file
#' in current location but save the path in the cache. If 'rtype
#' == "relative"', action can not be "asis".
#' @param proxy character(1) (Optional) proxy server.
#' @param download logical(1) If \code{rtype=web}, should remote
#' resource be downloaded locally immediately.
#' @param config list() passed as config argument in \code{httr::GET}
#' @param ... For 'bfcadd', 'bfcupdate' and 'bfcdownload': Additional
#' arguments passed to internal download functions for use with
#' \code{httr::GET}. For 'bfcrpaths': Additional arguments passed
#' to 'bfcadd', or \code{exact} passed to 'bfcquery'. For
#' 'bfcquery': Additional arguments passed to \code{grepl}. For
#' 'exportbfc': Additional arguments to the selected outputMethod
#' function. See \code{utils::tar} or \code{utils::zip} for more
#' information. For 'importbfc': Additional arguments to the
#' selected archiveMethod function. See \code{utils::untar} or
#' \code{utils::unzip} for more information.
#' @return For 'bfcadd': named character(1), the path to save your
#' object / file. The name of the character is the unique rid for
#' the resource.
#' @examples
#' fl1 <- tempfile(); file.create(fl1)
#' bfcadd(bfc0, "Test1", fl1) # copy
#' fl2 <- tempfile(); file.create(fl2)
#' bfcadd(bfc0, "Test2", fl2, action="move") # move
#' fl3 <- tempfile(); file.create(fl3)
#' add3 <- bfcadd(bfc0, "Test3", fl3, rtype="local", action="asis") # reference
#' rid3 <- names(add3)
#'
#' bfc0
#' file.exists(fl1) # TRUE
#' file.exists(fl2) # FALSE
#' file.exists(fl3) # TRUE
#'
#' # add a remote resource
#' url <- "http://httpbin.org/get"
#' bfcadd(bfc0, "TestWeb", fpath=url)
#' @aliases bfcadd
#' @exportMethod bfcadd
setMethod("bfcadd", "BiocFileCache",
function(
x, rname, fpath = rname,
rtype = c("auto", "relative", "local", "web"),
action = c("copy", "move", "asis"),
proxy = "", download = TRUE, config = list(), ext=NA_character_,
fname=c("unique", "exact"),...)
{
stopifnot(
is.character(rname), length(rname) > 0L, !any(is.na(rname)),
is.character(fpath), length(fpath) > 0L, !any(is.na(fpath))
)
stopifnot(all(action %in% c("copy", "move", "asis")),
all(rtype %in% c("auto", "relative", "local", "web")))
if (missing(rtype)) rtype <- match.arg(rtype)
if (missing(action)) action <- match.arg(action)
stopifnot((length(action) == 1) || (length(action) == length(fpath)))
stopifnot((length(rtype) == 1) || (length(rtype) == length(fpath)))
if (length(action) == 1) action = rep(action, length(fpath))
if (length(rtype) == 1) rtype = rep(rtype, length(fpath))
rtype <- .util_standardize_rtype(rtype, fpath, action)
stopifnot(all(rtype == "web" | file.exists(fpath)))
fname <- match.arg(fname)
rpath <- .sql_add_resource(x, rname, rtype, fpath, ext, fname)
rid <- names(rpath)
for(i in seq_along(rpath)){
if (rtype[i] %in% c("local", "relative")) {
switch(
action[i],
copy = file.copy(fpath[i], rpath[i]),
move = file.rename(fpath[i], rpath[i]),
asis = {
.sql_set_rpath(x, rid[i], fpath[i])
rpath[i] <- bfcrpath(x, rids = rid[i])
}
)
} else if (download) { # rtype == "web"
.util_download(x, rid[i], proxy, config, "bfcadd()", ...)
}
}
rpath
})
#' @export
setGeneric("bfcinfo",
function(x, rids) standardGeneric("bfcinfo"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcinfo,missing-method
#' @exportMethod bfcinfo
setMethod("bfcinfo", "missing",
function(x, rids)
{
bfcinfo(x=BiocFileCache(), rids=rids)
})
#' @describeIn BiocFileCache list resources in database
#' @param rids character() Vector of rids.
#' @return For 'bfcinfo': A \code{bfc_tbl} of current resources in the
#' database.
#' @examples
#' bfcinfo(bfc0)
#' @aliases bfcinfo
#' @exportMethod bfcinfo
setMethod("bfcinfo", "BiocFileCacheBase",
function(x, rids)
{
if (missing(rids))
rids <- bfcrid(x)
stopifnot(all(rids %in% bfcrid(x)))
tbl <- .sql_get_resource_table(x, rids)
tbl <- mutate(tbl, rpath = unname(bfcrpath(x, rids=rids)))
class(tbl) <- c("tbl_bfc", class(tbl))
tbl
})
setOldClass("tbl_bfc")
#' @describeIn BiocFileCache Get the rids of the object
#' @exportMethod bfcrid
setMethod("bfcrid", "tbl_bfc", function(x) .get_tbl_rid(x))
#' @export
setGeneric("bfcpath",
function(x, rids) standardGeneric("bfcpath"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcpath,missing-method
#' @exportMethod bfcpath
setMethod("bfcpath", "missing",
function(x, rids)
{
bfcpath(x=BiocFileCache(), rids=rids)
})
#' @describeIn BiocFileCache display rpaths of resource.
#' @return For 'bfcpath': the file path location to load
#' @examples
#' bfcpath(bfc0, rid3)
#' @aliases bfcpath
#' @exportMethod bfcpath
setMethod("bfcpath", "BiocFileCacheBase",
function(x, rids)
{
if (missing(rids))
rids <- bfcrid(x)
stopifnot(length(rids) > 0L, all(rids %in% bfcrid(x)))
path <- .sql_get_rpath(x, rids)
path
})
#' @export
setGeneric("bfcrpath",
function(x, rnames, ..., rids, exact = TRUE) standardGeneric("bfcrpath"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcrpath,missing-method
#' @exportMethod bfcrpath
setMethod("bfcrpath", "missing",
function(x, rnames, ..., rids, exact = TRUE)
{
bfcrpath(x=BiocFileCache(), rnames=rnames, ..., rids=rids, exact=exact)
})
#' @describeIn BiocFileCache display rpath of resource. If 'rnames' is
#' in the cache the path is returned, if it is not it will try to
#' add it to the cache with 'bfcadd'
#' @param rnames character() to match against rnames. Each element of
#' \code{rnames} must match exactly one record. Use \code{exact =
#' FALSE} to use regular expression matching.
#' @return For 'bfcrpath': The local file path location to load.
#' @examples
#' bfcrpath(bfc0, rids = rid3)
#' @aliases bfcrpath
#' @exportMethod bfcrpath
setMethod("bfcrpath", "BiocFileCacheBase",
function(x, rnames, ..., rids, exact = TRUE)
{
if (!missing(rnames) && !missing(rids))
stop("specify either 'rnames' or 'rids' not both.")
update_time_and_path <- function(x, i) {
.sql_get_rpath(x, i)
}
add_or_return_rname <- function(x, rname, ..., exact) {
res <- bfcrid(bfcquery(x, rname, field="rname", exact = exact))
if (length(res) == 0L) {
## obtain an exclusive lock to add 'rname'
id <- "add_or_return_rname"
locfile_path <- file.path(bfccache(x), id)
locfile <- .lock2(locfile_path, exclusive = TRUE)
tryCatch({
## need to re-check that the resource is still needed,
## now that we have the exclusive lock
res <- bfcrid(bfcquery(x, rname, field="rname", exact = exact))
if (length(res) == 0L) {
message("adding rname '", rname, "'")
names(bfcadd(x, rname, ...))
} else {
names(update_time_and_path(x, res))
}
}, error=function(e) {
warning(
"\ntrying to add rname '", rname, "' produced error:",
"\n ", conditionMessage(e)
)
NA_character_
}, finally = function() {
.unlock2(locfile_path)
})
} else if (length(res) == 1L) {
names(update_time_and_path(x, res))
} else {
warning("'rnames' ",
if (exact) "exact" else "regular expression",
" pattern",
"\n '", rname, "'",
"\n is not unique; use 'bfcquery()' to see matches.")
NA_character_
}
}
if (missing(rids))
rids <- bfcrid(x)
if (!missing(rnames)) {
rids0 <- vapply(
rnames, add_or_return_rname, character(1), x=x, ..., exact = exact
)
if (anyNA(rids0)) {
rmdx <- setdiff(bfcrid(x), rids)
if (length(rmdx) > 0L)
bfcremove(x, rmdx)
stop("not all 'rnames' found or unique.")
}
bfcrpath(x, rids = rids0)
} else {
stopifnot(all(rids %in% bfcrid(x)))
update_time_and_path(x, rids)
}
})
#' @export
setGeneric("bfcupdate",
function(x, rids, ...) standardGeneric("bfcupdate"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcupdate,missing-method
#' @exportMethod bfcupdate
setMethod("bfcupdate", "missing",
function(x, rids, ...)
{
bfcupdate(x=BiocFileCache(), rids=rids, ...)
})
#' @describeIn BiocFileCache Update a resource in the cache
#' @param rpath character() vector of replacement rpaths.
#' @return For 'bfcupdate': an updated \code{BiocFileCache} object,
#' invisibly.
#' @examples
#' bfcupdate(bfc0, rid3, rpath=fl3, rname="NewRname")
#' bfc0[[rid3]] = fl1
#' bfcupdate(bfc0, "BFC5", fpath="http://google.com")
#' @aliases bfcupdate
#' @exportMethod bfcupdate
setMethod("bfcupdate", "BiocFileCache",
function(x, rids, ..., rname=NULL, rpath=NULL, fpath=NULL,
proxy="", config=list(), ask=TRUE)
{
stopifnot(!missing(rids), all(rids %in% bfcrid(x)))
stopifnot(
is.null(rname) || (length(rids) == length(rname)),
is.null(rpath) || (length(rids) == length(rpath)),
is.null(fpath) || (length(rids) == length(fpath))
)
stopifnot(
is.null(rname) || is.character(rname),
is.null(rpath) || is.character(rpath),
is.null(fpath) || is.character(fpath)
)
if(is.null(rname) && is.null(rpath) && is.null(fpath)) {
stop("bfcupdate() has nothing to update.",
"\n Please set rname, rpath, or fpath",
call.=FALSE)
}
info <- NULL
for (i in seq_along(rids)) {
.sql_set_time(x, rids[i])
if (!is.null(rname)) {
.sql_set_rname(x, rids[i], rname[i])
}
if (!is.null(rpath)) {
if (!file.exists(rpath[i]))
stop(
"bfcupdate() failed",
"\n rid: ", rids[i],
"\n rpath: ", sQuote(rpath[i]),
"\n reason: rpath does not exist.",
call.=FALSE
)
.sql_set_rpath(x, rids[i], rpath[i])
rtype <- unname(.sql_get_rtype(x, rids[i]))
if (identical(rtype, "relative") || identical(rtype, "web")) {
warning("updating rpath, changing rtype to 'local'")
.sql_set_rtype(x, rids[i], "local")
}
}
if (!is.null(fpath)) {
if (.sql_get_rtype(x, rids[i]) != "web")
stop("bfcupdate() failed",
"\n rid: ", rids[i],
"\n reason: resource rtype is not 'web'",
call.=FALSE)
if (ask) {
doit <- .util_ask(
"Setting a new remote path results in immediate\n",
" download and overwriting of existing file.\n",
" Continue?"
)
} else {
doit <- TRUE
}
if (doit) {
.util_download_and_rename(
x, rids[i], proxy, config, "bfcupdate()", fpath[i], ...
)
.sql_set_fpath(x, rids[i], fpath[i])
}
}
}
invisible(x)
})
#' @rdname BiocFileCache-class
#' @export
setGeneric("bfcmeta<-",
function(x, name, ..., value)
standardGeneric("bfcmeta<-"),
signature = "x"
)
#' @describeIn BiocFileCache add meta data table in database
#' @param name character(1) name of metadata table.
#' @return For 'bfcmeta': updated BiocFileCache, invisibly
#' @examples
#' meta = data.frame(list(rid = paste("BFC",seq_len(bfccount(bfc0)), sep=""),
#' num=seq(bfccount(bfc0),1,-1),
#' data=c(paste("Letter",
#' letters[seq_len(bfccount(bfc0))]))),
#' stringsAsFactors=FALSE)
#' bfcmeta(bfc0, name="resourcedata") <- meta
#' @aliases bfcmeta<-
#' @exportMethod bfcmeta<-
setReplaceMethod("bfcmeta", "BiocFileCacheBase",
function(x, name, ..., value)
{
stopifnot("rid" %in% colnames(value))
rids <- value$rid
stopifnot(all(rids %in% bfcrid(x)))
stopifnot(is.character(name), length(name) == 1L, !is.na(name))
if (name %in% .RESERVED$TABLES)
stop(
"'", name, "' cannot be added; reserved table names: ",
paste(sQuote(.RESERVED$TABLES), collapse=", ")
)
if (any(colnames(value) %in% .RESERVED$COLUMNS))
stop(
"'value' (metadata) cannot contain colnames ",
paste(sQuote(.RESERVED$COLUMNS), collapse= ", ")
)
.sql_meta_gets(x, name, value, ...)
x
})
#' @export
setGeneric("bfcmetaremove",
function(x, name, ...) standardGeneric("bfcmetaremove"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcmetaremove,missing-method
#' @exportMethod bfcmetaremove
setMethod("bfcmetaremove", "missing",
function(x, name, ...)
{
bfcmetaremove(x=BiocFileCache(), name=name, ...)
})
#' @describeIn BiocFileCache remove meta data table in database
#' @return For 'bfcmetaremove': updated BiocFileCache, invisibly
#' @examples
#' \dontrun{bfcmetaremove(bfc0, "resourcedata")}
#' @aliases bfcmetaremove
#' @exportMethod bfcmetaremove
setMethod("bfcmetaremove", "BiocFileCacheBase",
function(x, name, ...)
{
stopifnot(
!missing(name), is.character(name), length(name) == 1L, !is.na(name)
)
if (name %in% .RESERVED$TABLES)
stop("reserved table '", name, "' cannot be removed")
.sql_meta_remove(x, name, ...)
invisible(x)
})
#' @export
setGeneric("bfcmetalist",
function(x) standardGeneric("bfcmetalist"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcmetalist,missing-method
#' @exportMethod bfcmetalist
setMethod("bfcmetalist", "missing",
function(x)
{
bfcmetalist(x=BiocFileCache())
})
#' @describeIn BiocFileCache retrieve listing of metadata tables
#' @return For 'bfcmetalist': returns a character() of all metadata tables
#' currently in the database. If no metadata tables are available returns
#' character(0)
#' @examples
#' bfcmetalist(bfc0)
#' @aliases bfcmetalist
#' @exportMethod bfcmetalist
setMethod("bfcmetalist", "BiocFileCacheBase",
function(x)
{
.sql_meta_list(x)
})
#' @export
setGeneric("bfcmeta",
function(x, name, ...) standardGeneric("bfcmeta"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcmeta,missing-method
#' @exportMethod bfcmeta
setMethod("bfcmeta", "missing",
function(x, name, ...)
{
bfcmeta(x=BiocFileCache(), name=name, ...)
})
#' @describeIn BiocFileCache retrieve metadata table
#' @return For 'bfcmeta': returns a data.frame representation of database
#' table
#' @examples
#' tbl = bfcmeta(bfc0, "resourcedata")
#' tbl
#' @aliases bfcmeta
#' @exportMethod bfcmeta
setMethod("bfcmeta", "BiocFileCacheBase",
function(x, name, ...)
{
if (missing(name)) {
tbls <- paste(sQuote(bfcmetalist(x)), collapse=", ")
if (!nzchar(tbls))
tbls <- NA_character_
stop("metadata table 'name' missing, possible values: ", tbls)
}
stopifnot(is.character(name), length(name) == 1L, !is.na(name))
.sql_meta(x, name, ...)
})
#' @export
setGeneric("bfcquerycols",
function(x) standardGeneric("bfcquerycols")
)
#' @rdname BiocFileCache-class
#' @aliases bfcquerycols,missing-method
#' @exportMethod bfcquerycols
setMethod("bfcquerycols", "missing",
function(x)
{
bfcquerycols(x=BiocFileCache())
})
#' @describeIn BiocFileCache Get all the possible columns to query
#' @return For 'bfcquerycols': character() all columns in all database tables
#' available for query.
#' @examples
#' bfcquerycols(bfc0)
#' @aliases bfcquerycols
#' @exportMethod bfcquerycols
setMethod("bfcquerycols", "BiocFileCacheBase",
function(x)
{
.get_all_colnames(x)
})
#' @export
setGeneric("bfcquery",
function(x, query, field=c("rname", "rpath", "fpath"), ..., exact = FALSE)
standardGeneric("bfcquery"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcquery,missing-method
#' @exportMethod bfcquery
setMethod("bfcquery", "missing",
function(x, query, field=c("rname", "rpath", "fpath"), ..., exact = FALSE)
{
bfcquery(x=BiocFileCache(), query=query, field=field, ..., exact = exact)
})
#' @describeIn BiocFileCache query resource
#' @param query character() Regular expression pattern(s) to match in
#' resource. It will match the pattern against \code{fields},
#' using \code{&} logic across query element. By default, case
#' sensitive. When \code{exact = TRUE}, \code{query} uses exact
#' matching.
#' @param field character() column names in resource to query, using
#' \code{||} logic across multiple field elements. By default,
#' matches pattern agains rname, rpath, and fpath. If exact
#' matching, may only be a single value.
#' @param exact logical(1) when FALSE, treat \code{query} as a regular
#' expression. When TRUE, use exact matching. For \code{bfcquery},
#' the default is \code{FALSE} (regular expression matching; for
#' \code{bfcrpath}, the default is \code{TRUE} (exact matching).
#' @return For 'bfcquery': A \code{bfc_tbl} of current resources in
#' the database whose \code{field} contained query. If multiple
#' values are given, the resource must contain all of the
#' patterns. A tbl with zero rows is returned when no resources
#' match the query.
#' @examples
#' bfcquery(bfc0, "Test")
#' bfcquery(bfc0, "^Test1$", field="rname")
#' @aliases bfcquery
#' @exportMethod bfcquery
setMethod("bfcquery", "BiocFileCacheBase",
function(x, query, field=c("rname", "rpath", "fpath"), ..., exact = FALSE)
{
stopifnot(is.character(query))
stopifnot(all(field %in% .get_all_colnames(x)))
keep <- TRUE
if (exact) {
tryCatch({
where <- paste(field, "== :query", collapse=" OR ")
.sql_select_query(x, where, query = query)
})
} else {
tbl <- .sql_get_resource_table(x)
for (q in query)
keep <- keep & Reduce(`|`, lapply(tbl[field], grepl, pattern = q, ...))
rids <- intersect(tbl$rid[keep], bfcrid(x))
bfcinfo(x, rids)
}
})
#' @export
setGeneric("bfccount",
function(x) standardGeneric("bfccount")
)
#' @rdname BiocFileCache-class
#' @aliases bfccount,missing-method
#' @exportMethod bfccount
setMethod("bfccount", "missing",
function(x)
{
bfccount(x=BiocFileCache())
})
#' @describeIn BiocFileCache Get the number of objects in the file
#' cache or query.
#' @return For 'bfccount': integer(1) Number of objects in the cache
#' or query.
#' @examples
#' bfccount(bfc0)
#' bfccount(bfcquery(bfc0, "test"))
#' @aliases bfccount
#' @exportMethod bfccount
setMethod("bfccount", "BiocFileCacheBase",
function(x)
{
bfccount(bfcinfo(x))
})
#' @rdname BiocFileCache-class
#' @aliases bfccount,tbl_bfc-method
#' @exportMethod bfccount
setMethod("bfccount", "tbl_bfc",
function(x)
{
.sql_get_nrows(x)
})
#' @export
setGeneric("bfcneedsupdate",
function(x, rids) standardGeneric("bfcneedsupdate"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcneedsupdate,missing-method
#' @exportMethod bfcneedsupdate
setMethod("bfcneedsupdate", "missing",
function(x, rids)
{
bfcneedsupdate(x=BiocFileCache(), rids=rids)
})
#' @describeIn BiocFileCache check if a resource needs to be updated
#' @return For 'bfcneedsupdate': named logical vector if resource
#' needs to be updated. The name is the resource
#' 'rid'. \code{TRUE}: fpath \code{etag} or \code{modified} time of
#' web resource more recent than in BiocFileCache; \code{FALSE}: fpath
#' \code{etag} or \code{modified} time of web resource not more recent
#' than in BiocFileCache; \code{NA}: web resource etag and modified time
#' could not be determined. If the etag is available the function will use
#' that information definitively and only compare last modified time if
#' etag is not available. If there is an \code{expires} time that will be
#' used to initially determine if the resource should be updated.
#' @examples
#' bfcneedsupdate(bfc0, "BFC5")
#' @aliases bfcneedsupdate
#' @exportMethod bfcneedsupdate
setMethod("bfcneedsupdate", "BiocFileCacheBase",
function(x, rids)
{
if (missing(rids))
rids <- .get_all_web_rids(x)
stopifnot(all(rids %in% bfcrid(x)))
if (!all(rids %in% .get_all_web_rids(x)))
stop("rids not all web resources")
helper <- function(x, rid) {
file_time <- .sql_get_last_modified(x, rid)
fpath <- .sql_get_fpath(x, rid)
file_etag <- .sql_get_etag(x, rid)
file_expires <- .sql_get_expires(x, rid)
cache_info <- .httr_get_cache_info(fpath)
web_time <- cache_info[["modified"]]
web_etag <- cache_info[["etag"]]
if (!is.na(file_expires))
expired <- as.Date(file_expires, optional=TRUE) <= Sys.Date()
else
expired <- FALSE
checkTime <- FALSE
if (expired){
res <- TRUE
checkTime <- FALSE
} else {
if (is.na(web_etag) || is.na(file_etag)) {
checkTime <- TRUE
} else {
res <- !identical(unname(file_etag), web_etag)
}
if (checkTime) {
if (is.na(file_time) || is.na(web_time)) {
res <- NA
} else {
res <- as.POSIXlt(web_time, optional=TRUE) >
as.POSIXlt(file_time, optional=TRUE)
}
}
}
res
} # end helper
result <- vapply(rids, helper, logical(1), x=x)
# if web resources hasn't been locally downloaded yet
result[rids %in% .get_rid_filenotfound(x)] = TRUE
setNames(result, rids)
})
#' @export
setGeneric("bfcdownload",
function(x, rid, proxy="", config=list(), ask=TRUE, FUN, ...)
standardGeneric("bfcdownload"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcdownload,missing-method
#' @param rid character(1) Unique resource id.
#' @exportMethod bfcdownload
setMethod("bfcdownload", "missing",
function(x, rid, proxy="", config=list(), ask=TRUE, FUN, ...)
{
bfcdownload(x=BiocFileCache(), rid=rid, proxy=proxy, config=config, ask=ask,
FUN=FUN, ...)
})
#' @describeIn BiocFileCache Redownload resource to location in cache
#' @param FUN A specialized implemented function designed by the user. This
#' function can be used to perform and save the results of a post download
#' processing step rather than direct output. The function should ONLY take in
#' two file names: the first the raw downloaded file and the second the output
#' file for saved results. The output of the function should be TRUE/FALSE if
#' step was successful. See vignette section on Specialty Advance Use Case for
#' more details.
#' @return For 'bfcdownload': character(1) path to downloaded resource
#' in cache.
#' @examples
#' bfcdownload(bfc0, "BFC5")
#' @aliases bfcdownload
#' @exportMethod bfcdownload
setMethod("bfcdownload", "BiocFileCache",
function(x, rid, proxy="", config=list(), ask=TRUE, FUN, ...)
{
stopifnot(
!missing(rid), length(rid) > 0L,
all(rid %in% bfcrid(x)),
all(.sql_get_rtype(x, rid) == "web")
)
.sql_set_time(x, rid)
if (ask && any(file.exists(.sql_get_rpath(x, rid)))) {
doit <- .util_ask(
"bfcdownload() will overwrite exisiting files, continue?"
)
} else {
doit <- TRUE
}
if (doit)
.util_download_and_rename(x, rid, proxy, config, "bfcdownload()",
FUN=FUN, ...)
bfcrpath(x, rids=rid)
})
#' @export
setGeneric("bfcremove",
function(x, rids) standardGeneric("bfcremove"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcremove,missing-method
#' @exportMethod bfcremove
setMethod("bfcremove", "missing",
function(x, rids)
{
bfcremove(x=BiocFileCache(), rids=rids)
})
#' @describeIn BiocFileCache Remove a resource to the database. If
#' the local file is located in \code{bfccache(x)}, the file will
#' also be deleted. This will not delete information in any metadata
#' table.
#' @return For 'bfcremove': updated BiocFileCache object, invisibly
#' @examples
#' bfcremove(bfc0, rid3)
#' bfcinfo(bfc0)
#' @aliases bfcremove
#' @exportMethod bfcremove
setMethod("bfcremove", "BiocFileCache",
function(x, rids)
{
stopifnot(all(rids %in% bfcrid(x)))
rpaths <- .sql_get_rpath(x, rids)
cached <- startsWith(rpaths, bfccache(x))
.sql_remove_resource(x, rids)
status <- .util_unlink(rpaths[cached])
invisible(x)
})
#' @export
setGeneric("bfcsync",
function(x, verbose = TRUE, ask = TRUE) standardGeneric("bfcsync"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases bfcsync,missing-method
#' @exportMethod bfcsync
setMethod("bfcsync", "missing",
function(x, verbose = TRUE, ask = TRUE)
{
bfcsync(x=BiocFileCache(), verbose=verbose, ask=ask)
})
#' @describeIn BiocFileCache sync cache and resource.
#' @param verbose logical(1) If descriptive message and list of issues
#' should be included as output.
#' @return For 'bfcsync': logical(1) indicating whether the cache is
#' in sync (\code{TRUE}) or not. 'verbose' is TRUE by default, so
#' descriptive messages will also be included.
#' @examples
#' bfcsync(bfc0)
#'
#' if (!interactive()){
#' # in interactive mode, in the sync above
#' # this was probably already removed
#' # noninteractive mode does not remove resources
#' # so can remove manually here
#' bfcremove(bfc0, "BFC1")
#' }
#' bfcsync(bfc0, FALSE)
#' @aliases bfcsync
#' @importFrom utils capture.output
#' @exportMethod bfcsync
setMethod("bfcsync", "BiocFileCache",
function(x, verbose=TRUE, ask = TRUE)
{
stopifnot(is.logical(verbose), length(verbose) == 1L, !is.na(verbose))
# files not found
rids <- .get_rid_filenotfound(x)
# files untracked in cache location
files <- file.path(bfccache(x), setdiff(dir(bfccache(x)),c(.CACHE_FILE, .CACHE_FILE_LOCK)))
paths <- .sql_get_rpath(x, bfcrid(x))
# normalizePath on windows
# can't across platform - no opt on linux but added hidden on mac
if (tolower(.Platform$OS.type) == "windows") {
files = normalizePath(files)
paths = normalizePath(paths)
}
untracked <- setdiff(files, paths)
rids0 <- rids; untracked0 <- untracked
if (verbose && (length(rids) != 0L))
message(
"entries without corresponding files: ",
paste0("'", rids, "'", collapse=" ")
)
if (ask && (length(rids) != 0L)) {
doit <- .util_ask("delete ", length(rids), " entries?")
rids <- rids[doit]
}
if (verbose && (length(untracked) != 0L))
message(
"files without cache entries\n ",
paste(untracked, collpase="\n ")
)
if (ask && (length(untracked) != 0L)) {
doit <- .util_ask("delete ", length(untracked), " files?")
untracked <- untracked[doit]
}
.sql_remove_resource(x, rids)
.util_unlink(untracked)
!length(setdiff(rids0, rids)) && !length(setdiff(untracked0, untracked))
})
#' @export
setGeneric("exportbfc",
function(x, rids,
outputFile="BiocFileCacheExport.tar", outputMethod=c("tar","zip"),
verbose=TRUE, ...)
standardGeneric("exportbfc"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases exportbfc,missing-method
#' @exportMethod exportbfc
setMethod("exportbfc", "missing",
function(x, rids,
outputFile="BiocFileCacheExport.tar", outputMethod=c("tar","zip"),
verbose=TRUE, ...)
{
exportbfc(x=BiocFileCache(), rids=rids,
outputFile=outputFile, outputMethod=outputMethod,
verbose=verbose, ...)
})
#' @describeIn BiocFileCache Create exportable file containing
#' BiocFileCache.
#' @param outputFile character(1) The <filepath>/basename for the
#' output archive. Please include appropriate extension based on
#' outMethod and any additional parameters selected for
#' \code{utils::tar} or \code{utils::zip}
#' @param outputMethod Either 'tar' or 'zip' for how the directory
#' should be archived. Default is 'tar'.
#' @return character(1) The outputFile path.
#' @examples
#' \dontrun{exportbfc(bfc)}
#' @aliases exportbfc
#' @exportMethod exportbfc
setMethod("exportbfc", "BiocFileCacheBase",
function(x, rids,
outputFile="BiocFileCacheExport.tar", outputMethod=c("tar","zip"),
verbose=TRUE, ...)
{
if (missing(rids))
rids <- bfcrid(x)
stopifnot(all(rids %in% bfcrid(x)))
stopifnot(length(outputFile) == 1L, is.character(outputFile))
outputMethod <- match.arg(outputMethod)
stopifnot(is.logical(verbose), length(verbose) == 1L)
bfc <- x[rids]
if (length(bfc) == 0L)
stop("No valid rids selected")
dir <- file.path(tempdir(), "BiocFileCacheExport")
dir.create(dir)
ids <- bfcrid(bfc)
file.copy(.sql_dbfile(x), dir)
newbfc <- BiocFileCache(dir)
idrm <- setdiff(.get_all_rids(newbfc), ids)
if (length(idrm) != 0)
newbfc <- bfcremove(newbfc, rids=idrm)
res <- vapply(ids, .util_export_file, character(1),
bfc=x, dir=dir)
.sql_set_time(x, ids)
# 'relative' = ok, 'web'= not download
# 'local' = file not in cache, 'NA' = file not found
if (any(res == "web", na.rm=TRUE)) {
webid <- names(which(res == "web"))
if (verbose)
message(
"The following are identified as web resources\n",
"but have not been downloaded yet. No associated\n",
"files will be exported:\n",
" ", paste0("'", webid, "'", collapse=" "),
"\n\n"
)
}
if (any(res == "local", na.rm=TRUE)) {
locid <- names(which(res == "local"))
if (verbose)
message(
"The following are identified as local resources.\n",
"A copy of the file will be exported:\n",
" ", paste0("'", locid, "'", collapse=" "),
"\n\n"
)
for (i in locid) {
orig <- .sql_get_rpath(x, i)
newpath <- file.path(dir, basename(orig))
if (file.exists(newpath)) {
filename <- paste(basename(tempfile("", bfccache(newbfc))),
basename(orig), sep="_")
newpath <- file.path(dir, filename)
}
file.copy(orig, newpath)
}
}
if (any(is.na(res))) {
naid <- names(which(is.na(res)))
if (verbose)
message(
"The following had a file that was not found.\n",
"The file is not included and the rid will be removed\n",
"from the BiocFileCache object being exported:\n",
" ", paste0("'", naid, "'", collapse=" "),
"\n\n"
)
newbfc <- bfcremove(newbfc, rids=naid)
}
if (length(bfcmetalist(newbfc)) != 0) {
metaList <- bfcmetalist(newbfc)
res <- vapply(metaList, .sql_filter_metadata, logical(1),
bfc=newbfc, verbose=verbose)
}
# tar/zip up directory
origdir <- getwd()
if (dirname(outputFile) == ".")
outputFile = file.path(origdir, outputFile)
setwd(dirname(dir))
files = basename(dir)
archive <- function(outputFile, how = c("tar", "zip"), files, ...) {
fun <- switch(how, tar = tar, zip = zip)
fun(outputFile, files, ...)
}
# remove lock file from export
.util_unlink(file.path(dir, .CACHE_FILE_LOCK))
archive(outputFile=outputFile, how=outputMethod, files=files, ...)
setwd(origdir)
.util_unlink(dir, recursive=TRUE)
outputFile
})
#' @export
setGeneric("importbfc",
function(filename, archiveMethod=c("untar","unzip"),
exdir=".", ...)
standardGeneric("importbfc"),
signature = "filename"
)
#' @describeIn BiocFileCache Import file created with exportbfc containing
#' BiocFileCache.
#' @param filename character(1) The name of the archive.
#' @param archiveMethod Either 'untar' or 'unzip' for how the directory should
#' be extracted. Default is 'untar'.
#' @param exdir Directory to extract files too. See \code{utils::untar} or
#' \code{utils::unzip} for more details.
#' @return A BiocFileCache object
#' @examples
#' \dontrun{importbfc("ExportBiocFileCache.tar")}
#' @aliases importbfc
#' @exportMethod importbfc
setMethod("importbfc", "character",
function(filename, archiveMethod=c("untar","unzip"),
exdir=".", ...)
{
exportPath <- file.path(exdir, "BiocFileCacheExport")
stopifnot(!dir.exists(exportPath))
stopifnot(length(exdir) == 1L, is.character(exdir))
stopifnot(length(filename) == 1L, is.character(filename))
archiveMethod = match.arg(archiveMethod)
inflate <- function(filename, how = c("untar", "unzip"), exdir, ...) {
fun <- switch(how, untar = untar, unzip = unzip)
fun(filename, exdir=exdir, ...)
}
inflate(filename=filename, how=archiveMethod, exdir=exdir, ...)
bfc = BiocFileCache(exportPath)
bfc
})
#' @export
setGeneric("cleanbfc",
function(x, days = 120, ask = TRUE) standardGeneric("cleanbfc"),
signature = "x"
)
#' @rdname BiocFileCache-class
#' @aliases cleanbfc,missing-method
#' @exportMethod cleanbfc
setMethod("cleanbfc", "missing",
function(x, days = 120, ask = TRUE)
{
cleanbfc(x=BiocFileCache(), days=days, ask=ask)
})
#' @describeIn BiocFileCache Remove old/unused files in
#' BiocFileCache. If file to be removed is not in the bfccache
#' location it will not be deleted. Setting \code{days=-Inf}
#' will remove all cached files.
#' @param days integer(1) Number of days between accessDate and
#' currentDate; if exceeded entry will be deleted.
#' @return For 'cleanbfc': updated BiocFileCache, invisibly.
#' @examples
#' \dontrun{cleanbfc(bfc, ask=FALSE)}
#' @aliases cleanbfc
#' @exportMethod cleanbfc
setMethod("cleanbfc", "BiocFileCache",
function(x, days = 120, ask=TRUE)
{
stopifnot(is.numeric(days), length(days) == 1L, !is.na(days))
stopifnot(is.logical(ask), length(ask) == 1L, !is.na(ask))
rids <- .sql_clean_cache(x, days)
rpaths <- .sql_get_rpath(x, rids)
cached <- startsWith(rpaths, bfccache(x))
if (ask) {
txt0 <- paste("file ", sQuote(rpaths))
txt <- sprintf("Remove id %s %s", sQuote(rids), ifelse(cached, txt0, ""))
doit <- vapply(txt, .util_ask, logical(1))
rids <- rids[doit]
cached <- cached & doit
}
.sql_remove_resource(x, rids)
.util_unlink(rpaths[cached])
invisible(x)
})
#' @export
setGeneric("removebfc",
function(x, ask = TRUE) standardGeneric("removebfc"),
signature="x"
)
#' @rdname BiocFileCache-class
#' @aliases removebfc,missing-method
#' @exportMethod removebfc
setMethod("removebfc", "missing",
function(x, ask = TRUE)
{
removebfc(x=BiocFileCache(), ask=ask)
})
#' @describeIn BiocFileCache Completely remove the BiocFileCache
#' @return For 'removebfc': TRUE if successfully removed.
#' @examples
#' \dontrun{removebfc(bfc, ask=FALSE)}
#' @aliases removebfc
#' @exportMethod removebfc
setMethod("removebfc", "BiocFileCache",
function(x, ask=TRUE)
{
stopifnot(is.logical(ask), length(ask) == 1L, !is.na(ask))
doit <- FALSE
txt <- paste("remove cache and", length(x), "resource(s)?")
if (!ask || .util_ask(txt))
doit <- .util_unlink(bfccache(x), recursive=TRUE)
doit
})
#' @describeIn BiocFileCache Display a \code{BiocFileCache} instance.
#' @param object A \code{BiocFileCache} instance.
#' @exportMethod show
setMethod("show", "BiocFileCacheBase",
function(object)
{
cat("class: ", class(object), "\n",
"bfccache: ", bfccache(object), "\n",
"bfccount: ", bfccount(object), "\n",
"For more information see: bfcinfo() or bfcquery()\n",
sep="")
})
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.