diff --git a/NAMESPACE b/NAMESPACE index eda5f50..8e55f53 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -20,6 +20,7 @@ export(hitCache) export(loadCache) export(loadLogfile) export(logMessage) +export(registerCache) export(requestLogSummary) export(saveCache) export(setCache) diff --git a/R/cache.R b/R/cache.R index 43c7772..5f1918a 100644 --- a/R/cache.R +++ b/R/cache.R @@ -23,7 +23,7 @@ cacheOff <- function () { #' @export clearCache <- function () { logMessage("CACHE CLEAR") - rm(list=cacheKeys(), envir=cache) + rm(list=cacheKeys(), envir = identifyCache()) } #' HTTP Cache API @@ -37,7 +37,7 @@ clearCache <- function () { #' @name cache-api #' @export hitCache <- function (key) { - exists(key, envir=cache) + exists(key, envir = identifyCache()) } #' @rdname cache-api @@ -45,7 +45,7 @@ hitCache <- function (key) { getCache <- function (key) { if (hitCache(key)) { logMessage("CACHE HIT", key) - return(get(key, envir=cache)) + return(get(key, envir = identifyCache())) } else { return(NULL) } @@ -55,10 +55,12 @@ getCache <- function (key) { #' @export setCache <- function (key, value) { logMessage("CACHE SET", key) - assign(key, value, envir=cache) + assign(key, value, envir = identifyCache()) } -cacheKeys <- function () ls(all.names=TRUE, envir=cache) +cacheKeys <- function (){ + setdiff(ls(all.names=TRUE, envir = identifyCache()), cache_identifier_key) +} #' Construct a unique cache key for a request #' @@ -125,14 +127,14 @@ dropCache <- function (x) { #' @export dropOnly <- function (x) { logMessage("CACHE DROP", x) - suppressWarnings(rm(list=x, envir=cache)) + suppressWarnings(rm(list=x, envir=identifyCache())) } #' @rdname dropCache #' @export dropPattern <- function (x) { logMessage("CACHE DROP", x) - rm(list=ls(envir=cache, pattern=x), envir=cache) + rm(list=ls(envir=cache, pattern=x), envir=identifyCache()) } # dropBelow <- function (x) { diff --git a/R/load-cache.R b/R/load-cache.R index e328aea..473983e 100644 --- a/R/load-cache.R +++ b/R/load-cache.R @@ -1,9 +1,23 @@ + ## Create the cache env cache <- NULL initCache <- function () { cache <<- new.env(hash=TRUE) } +cache_identifier_key <- '__CACHE_IDENTIFIER_FUNCTION__' +#' @export +registerCache <- function(fn){ + stopifnot( + 'fn must be a function' = is.function(fn) + ) + assign(cache_identifier_key, fn, envir=cache) +} +identifyCache <- function(){ + idfun <- get(cache_identifier_key, envir = cache) + idfun() +} initCache() +registerCache(function() cache) #' Save and load cache state #' @@ -13,7 +27,7 @@ initCache() #' @return Nothing; called for side effects. #' @export saveCache <- function (file) { - saveRDS(cache, file=file) + saveRDS(identifyCache(), file=file) } #' @rdname saveCache