## This is the core of the package - it holds all the facilities for
## caching etc.
R6_datastorr <- R6::R6Class(
"datastorr",
public = list(
storr = NULL,
cache = NULL,
info = NULL,
path = NULL,
initialize = function(info) {
self$info <- info
self$path <- info$path
self$storr <- storr::storr_rds(self$path)
self$cache <- storr::storr_environment()
dir.create(file.path(self$path, "file"), FALSE, TRUE)
dir.create(file.path(self$path, "workdir"), FALSE, TRUE)
lockBinding("info", self)
lockBinding("path", self)
},
get = function(version = NULL, download = TRUE, verbose = TRUE,
reread = FALSE) {
if (is.null(version)) {
version <- self$version_current()
}
# DEFAULT should pull the source code
# TODO: temporary solution is to fill in NULL fileanmes
# with "version.zip" and handle it at
# download stage
if (is.null(self$info$filenames)) {
filenames <- "Source.zip"
} else {
filenames <- self$info$filenames
}
for(target_file in filenames) {
version_file <- create_version_filename(version, target_file)
if (!self$storr$exists(version_file, "file") && download) {
self$download(version, target_file, verbose)
}
}
## TODO: messy handling of single vs multiple files
if(length(filenames) == 1L) {
self$read(version, filenames[1], self$info$read[[1]], reread)
} else {
opened_files <- vector("list", length=length(filenames))
for(index in 1:length(opened_files)) {
opened_files[[index]] <- self$read(version, filenames[index], self$info$read[[index]], reread)
}
names(opened_files) <- filenames
opened_files
}
},
read = function(version, target_file, read_function, reread = FALSE) {
version_file <- create_version_filename(version, target_file)
if (reread || !self$cache$exists(version_file)) {
file <- file.path(self$path, "file", self$storr$get(version_file, "file"))
ret <- read_function(file)
self$cache$set(version_file, ret, use_cache = FALSE)
} else {
ret <- self$cache$get(version_file, use_cache = FALSE)
}
ret
},
download = function(version, target_file, verbose = TRUE) {
# API interaction
message(paste0("Downloading ", target_file))
# This check needs to be changed
# to enable backwards compatibilty
if(target_file == "Source.zip") {
url <- github_api_source_url(version, self$info$repo, self$info$private)
filename <- "Source.zip"
} else {
url <- github_api_release_url(version, target_file, self$info$repo,
self$info$private)
filename <- basename(sub("\\?.*$", "", url))
}
## needs new handling when source code is being pulled
ext <- tools::file_ext(filename)
if (nzchar(ext)) {
ext <- paste0(".", ext)
}
tmp <- tempfile(tmpdir = file.path(self$path, "workdir"), fileext = ext)
on.exit(unlink(tmp))
download_file(url, dest = tmp, verbose = verbose, binary = ifelse(target_file == "Source.zip", FALSE, TRUE))
# hash key for storr
hash <- unname(tools::md5sum(tmp))
# file name
file <- paste0(hash, ext)
dest <- file.path(self$path, "file", file)
if (!file.exists(dest)) {
file.rename(tmp, dest)
}
version_filename <- create_version_filename(version, target_file)
self$storr$set(version_filename, hash, "hash")
self$storr$set(version_filename, file, "file")
},
versions = function(local = TRUE) {
if (local) {
local_files <- self$storr$list("file")
local_versions <- unlist(lapply(local_files, function(x) {regmatches(x,regexpr("^(\\d+\\.){2}\\d+(?:(\\.\\d+))?",x))}))
# Captures versions formatted x.y.z with optional 4th sub version
stringr::str_sort(unique(local_versions), numeric=TRUE)
} else {
rev(names(github_api_cache(self$info$private)$get(self$info$repo)))
}
},
version_current = function(local = TRUE) {
v <- self$versions(local)
if (length(v) == 0L && local) {
v <- self$versions(FALSE)
}
if (length(v) == 0L) {
NULL
} else {
v[[length(v)]]
}
},
del = function(version) {
if (is.null(version)) {
# delete all files cached with associated repository
unlink(file.path(self$path, "file"), recursive = TRUE)
self$storr$destroy()
} else {
# delete all files from specified version
file_list_keys <- self$storr$list("file")[grepl(get_version_regex(version), self$storr$list("file"))]
if(length(file_list_keys) == 0L) {
stop(paste0("Version ", version, " is already deleted or does not exist"))
}
for(key in file_list_keys) {
file <- self$storr$get(key, "file")
unlink(file.path(self$path, "file", file))
self$storr$del(key, "file")
self$storr$del(key, "hash")
self$cache$del(key)
}
}
}
)
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.