Nothing
.addinsrepo_globals <- new.env(parent = emptyenv())
.addinsrepo_globals$ttl <- 60*60*24 # Expire list after 24 hours
# Update the list of addins
update_addins_list <- function(force = FALSE) {
# force means grab the latest list from online even if the existing list is recent
if (force) {
update_addins_file()
update_addins_list_helper()
} else {
if (is.null(.addinsrepo_globals$addins_list)) {
update_addins_list_helper()
} else {
if (is_expired(.addinsrepo_globals$last_refresh)) {
update_addins_list_helper()
} else {
update_addins_installed_field()
}
}
}
}
# Download a new version of the addins list and store it in a local file
#' @importFrom rmarkdown pandoc_convert
update_addins_file <- function() {
datapath <- get_files_path()
dir.create(datapath, showWarnings = FALSE, recursive = TRUE)
mdfile <- get_md_file()
htmlfile <- get_html_file()
url <- "https://raw.githubusercontent.com/pzhaonet/rmd/master/readme.md"
writeLines("% addinslist", mdfile)
curl::curl_download(url, destfile = mdfile, mode = "ab")
rmarkdown::pandoc_convert(mdfile, to = "html", output = htmlfile,
options = "-s")
}
# Assuming the addins list file exists, parse the markdown table and
# update the list objects
update_addins_list_helper <- function() {
htmlfile <- get_html_file()
lastrefresh <- file.mtime(htmlfile)
.addinsrepo_globals$last_refresh <- lastrefresh
html <- xml2::read_html(htmlfile)
headerNames <- xml2::xml_text(xml2::xml_find_all(html, "//thead//th"))
cranColumnId <- which(grepl("cran", headerNames, ignore.case = TRUE))
packageColumnId <- which(grepl("package", headerNames, ignore.case = TRUE))
.addinsrepo_globals$headerNames <- headerNames
.addinsrepo_globals$cranColumnId <- cranColumnId
.addinsrepo_globals$packageColumnId <- packageColumnId
rows <- xml2::xml_find_all(html, "//tbody/tr")
cells <- lapply(rows, function(x){ rvest::html_nodes(x, xpath = ".//td|.//th") })
installed_pkgs <- rownames(utils::installed.packages(noCache = TRUE))
out <- matrix(NA_character_, nrow = length(rows), ncol = length(headerNames) + 3)
colnames(out) <- c(headerNames, "internal_pkgname", "internal_github_repo",
"internal_installed")
for (i in seq_len(length(rows))) {
row <- cells[[i]]
values <- lapply(row, function(x) {
paste(as.character(xml2::xml_contents(x)), collapse = " ")
})
values <- unlist(values)
if (values[cranColumnId] == ":x:") {
oncran <- FALSE
} else if (values[cranColumnId] == ":white_check_mark:") {
oncran <- TRUE
} else {
stop("catch this error so that other rows still work!")
}
values[cranColumnId] <- oncran
pkg <- xml2::xml_text(row[[packageColumnId]])
pkg_url <- xml2::xml_attr(xml2::xml_find_first(row[[packageColumnId]], "a"), "href")
github <- gsub("(.*)(github.com/)([^/]+)/([^/@#]+)(.*)", "\\3/\\4", pkg_url )
is_installed <- pkg %in% installed_pkgs
values <- c(values, pkg, github, is_installed)
out[i, ] <- values
}
out <- as.data.frame(out, stringsAsFactors = FALSE)
out$internal_installed <- as.logical(out$internal_installed)
.addinsrepo_globals$addins_list <- out
packageNameColumnId <- which(colnames(out) == "internal_pkgname")
.addinsrepo_globals$packageNameColumnId <- packageNameColumnId
}
# When the list objects already exist, sometimes we just need to update
# whether or not each package is installed on our system
update_addins_installed_field <- function() {
installed_pkgs <- rownames(utils::installed.packages(noCache = TRUE))
.addinsrepo_globals$addins_list$internal_installed <-
.addinsrepo_globals$addins_list$internal_pkgname %in% installed_pkgs
}
# Return TRUE if a new addins list needs to be downloaded
is_addins_file_outdated <- function() {
htmlfile <- get_html_file()
if (!file.exists(htmlfile)) {
return(TRUE)
}
lastrefresh <- file.mtime(htmlfile)
return(is_expired(lastrefresh))
}
# Check if a time stamp is expired
is_expired <- function(time) {
as.numeric(Sys.time() - time, units = "secs") > .addinsrepo_globals$ttl
}
get_files_path <- function() {
rappdirs::user_data_dir("rmdrepo", "pzhaonet")
}
get_html_file <- function() {
datapath <- get_files_path()
htmlfile <- file.path(datapath, "rmd.html")
htmlfile
}
get_md_file <- function() {
datapath <- get_files_path()
mdfile <- file.path(datapath, "rmd.md")
mdfile
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.