# Copyright 2016 Province of British Columbia
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and limitations under the License.
write_cache <- function() {
path <- rems_data_dir()
._remsenv_$cache <- storr::storr_rds(path, compress = FALSE, default_namespace = "rems")
}
cache_exists <- function() {
exists("cache", envir = ._remsenv_) && dir.exists(rems_data_dir()) && rems_data_dir() == ._remsenv_$cache$driver$path
}
rems_data_dir <- function() {
path <- getOption("rems.cache.dir", default = rappdirs::user_data_dir("rems"))
normalizePath(path, mustWork = FALSE)
}
set_cache_date <- function(which, value) {
stopifnot(cache_exists())
if (!inherits(value, "POSIXct") && !is.null(value)) {
stop("cache date must be POSIXct or NULL")
}
if (._remsenv_$cache$exists("cache_dates")) {
cache_dates <- ._remsenv_$cache$get("cache_dates")
} else {
cache_dates <- list()
}
if (!is.null(value)) value <- as.numeric(value)
cache_dates[which] <- value # store time as a numeric value
._remsenv_$cache$set("cache_dates", cache_dates)
}
#' Get the date(s) when ems data was last updated locally.
#'
#' @param which The data for which you want to check it's cache date. "2yr", "4yr", or "historic
#'
#' @return The date the data was last updated (if it exists in your cache)
#' @export
get_cache_date <- function(which) {
stopifnot(cache_exists())
if (!._remsenv_$cache$exists("cache_dates")) return(-Inf)
cache_date <- ._remsenv_$cache$get("cache_dates")[[which]]
if (is.null(cache_date)) return(-Inf)
as.POSIXct(cache_date, origin = "1970/01/01") # converted numeric to POSIXct
}
#' Destroy data cache
#'
#' Use this if you are getting odd errors when trying to get data or update dates
#' from the cache
#'
#' @return TRUE
#' @noRd
burn_it_down <- function() {
if (cache_exists()) {
._remsenv_$cache$destroy()
rm("cache", envir = ._remsenv_)
message("Removed rems cache. Please restart R and reload rems before continuing.")
}
write_cache()
invisible(TRUE)
}
#' Remove cached EMS data from your computer
#'
#' @param which which data to remove? Either \code{"2yr"}, \code{"4yr"},
#' \code{"historic"}, or \code{"all"}.
#'
#' @return NULL
#' @export
remove_data_cache <- function(which) {
if (!which %in% c("all", "2yr", "4yr", "historic")) {
stop("'which' must be one of 'all', '2yr', '4yr', 'historic'")
}
message("Removing ", which, " data from your local cache...")
if (which == "all") {
remove_it("historic")
burn_it_down()
} else {
remove_it(which)
}
invisible(NULL)
}
remove_it <- function(which) {
if (which == "historic") {
fpath <- write_db_path()
if (file.exists(fpath)) {
unlink(dirname(fpath), recursive = TRUE)
}
} else if (which %in% c("2yr", "4yr")) {
stopifnot(cache_exists())
._remsenv_$cache$del(which)
}
set_cache_date(which, value = NULL)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.