-
-
Notifications
You must be signed in to change notification settings - Fork 965
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Force a render when user pkgs don't match the pkgs used in a rendered, shiny-prerendered document #1420
Force a render when user pkgs don't match the pkgs used in a rendered, shiny-prerendered document #1420
Changes from 10 commits
e0651c0
d2a7252
00da5fa
fc9de14
6281c12
e7615ef
ff9b16c
26c84b0
d04941f
8456c80
ffd19cb
de86f8e
a47129e
ad406f3
07f4a86
9b9f1d8
File filter
Filter by extension
Conversations
Jump to
Diff view
Diff view
There are no files selected for viewing
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -75,49 +75,13 @@ shiny_prerendered_html <- function(input_rmd, encoding, render_args) { | |
|
||
# determine whether we need to render the Rmd in advance | ||
prerender_option <- tolower(Sys.getenv("RMARKDOWN_RUN_PRERENDER", "1")) | ||
|
||
if (file.access(output_dir, 2) != 0) { | ||
if (!file.exists(rendered_html)) | ||
stop("Unable to write prerendered HTML file to ", rendered_html) | ||
|
||
prerender <- FALSE | ||
} | ||
else if (identical(prerender_option, "0")) { | ||
prerender <- FALSE | ||
} | ||
else if (identical(prerender_option, "1")) { | ||
|
||
# determine the last modified time of the output file | ||
if (file.exists(rendered_html)) | ||
output_last_modified <- as.integer(file.info(rendered_html)$mtime) | ||
else | ||
output_last_modified <- 0L | ||
|
||
# short circuit for Rmd modified. if it hasn't been modified since the | ||
# html was generated look at external resources | ||
input_last_modified <- as.integer(file.info(input_rmd)$mtime) | ||
if (input_last_modified > output_last_modified) { | ||
prerender <- TRUE | ||
} | ||
else { | ||
# find external resources referenced by the file | ||
external_resources <- find_external_resources(input_rmd, encoding) | ||
|
||
# get paths to external resources | ||
input_files <- c(input_rmd, | ||
file.path(output_dir, external_resources$path)) | ||
|
||
# what's the maximum last_modified time of an input file | ||
input_last_modified <- max(as.integer(file.info(input_files)$mtime), | ||
na.rm = TRUE) | ||
|
||
# render if an input file was modified after the output file | ||
prerender <- input_last_modified > output_last_modified | ||
} | ||
} | ||
else { | ||
stop("Invalid value '", prerender_option, "' for RMARKDOWN_RUN_PRERENDER") | ||
} | ||
prerender <- shiny_prerendered_prerender( | ||
input_rmd, | ||
rendered_html, | ||
output_dir, | ||
encoding, | ||
prerender_option | ||
) | ||
|
||
# prerender if necessary | ||
if (prerender) { | ||
|
@@ -171,17 +135,116 @@ shiny_prerendered_html <- function(input_rmd, encoding, render_args) { | |
shinyHTML_with_deps(rendered_html, dependencies) | ||
} | ||
|
||
shiny_prerendered_prerender <- function( | ||
input_rmd, | ||
rendered_html, | ||
output_dir, | ||
encoding, | ||
prerender_option | ||
) { | ||
if (file.access(output_dir, 2) != 0) { | ||
if (!file.exists(rendered_html)) | ||
stop("Unable to write prerendered HTML file to ", rendered_html) | ||
return(FALSE) | ||
} | ||
|
||
if (identical(prerender_option, "0")) { | ||
return(FALSE) | ||
} | ||
if (!identical(prerender_option, "1")) { | ||
stop("Invalid value '", prerender_option, "' for RMARKDOWN_RUN_PRERENDER") | ||
} | ||
|
||
# determine the last modified time of the output file | ||
if (file.exists(rendered_html)) { | ||
output_last_modified <- as.integer(file.info(rendered_html)$mtime) | ||
} else { | ||
output_last_modified <- 0L | ||
} | ||
|
||
# short circuit for Rmd modified. if it hasn't been modified since the | ||
# html was generated look at external resources | ||
input_last_modified <- as.integer(file.info(input_rmd)$mtime) | ||
if (input_last_modified > output_last_modified) { | ||
return(TRUE) | ||
} | ||
|
||
# find external resources referenced by the file | ||
external_resources <- find_external_resources(input_rmd, encoding) | ||
|
||
# get paths to external resources | ||
input_files <- c(input_rmd, file.path(output_dir, external_resources$path)) | ||
|
||
# what's the maximum last_modified time of an input file | ||
input_last_modified <- max(as.integer(file.info(input_files)$mtime), na.rm = TRUE) | ||
|
||
# render if an input file was modified after the output file | ||
if (input_last_modified > output_last_modified) { | ||
return(TRUE) | ||
} | ||
|
||
html_lines <- readLines(rendered_html, encoding = "UTF-8", warn = FALSE) | ||
|
||
# check that all html dependencies exist | ||
dependencies_json <- shiny_prerendered_extract_context(html_lines, "dependencies") | ||
dependencies <- jsonlite::unserializeJSON(dependencies_json) | ||
|
||
pkgsSeen <- list() | ||
for (dep in dependencies) { | ||
if (is.null(dep$package)) { | ||
# if the file doesn't exist at all, render again | ||
if (!file.exists(dep$src$file)) { | ||
# might create a missing file compile-time error, | ||
# but that's better than a missing file prerendered error | ||
return(TRUE) | ||
} | ||
} else { | ||
depPkg <- dep$package | ||
depVer <- dep$pkgVersion | ||
if (is.null(pkgsSeen[[depPkg]])) { | ||
# has not seen pkg | ||
|
||
# depVer could be NULL, producing a logical(0) | ||
# means old prerender version, render again | ||
if (!isTRUE(get_package_version_string(depPkg) == depVer)) { | ||
# was not rendered with the same R package. must render again | ||
return (TRUE) | ||
} | ||
pkgsSeen[[depPkg]] <- depVer | ||
} | ||
} | ||
} | ||
# all html dependencies are accounted for | ||
|
||
execution_json <- shiny_prerendered_extract_context(html_lines, "execution_dependencies") | ||
execution_info <- jsonlite::unserializeJSON(execution_json) | ||
|
||
# check for execution package version differences | ||
execution_pkgs <- execution_info$packages | ||
versions_dont_match <- unlist(Map( | ||
execution_pkgs$package, | ||
execution_pkgs$version, | ||
f = function(package, version) { | ||
!identical(get_package_version_string(package), version) | ||
} | ||
)) | ||
if (any(versions_dont_match)) { | ||
return(TRUE) | ||
} | ||
# all execution packages match | ||
|
||
return(FALSE) | ||
} | ||
|
||
|
||
# Write the dependencies for a shiny_prerendered document. | ||
shiny_prerendered_append_dependencies <- function(input, # always UTF-8 | ||
shiny_prerendered_dependencies, | ||
files_dir, | ||
output_dir) { | ||
|
||
|
||
|
||
# transform dependencies (if we aren't in debug mode) | ||
dependencies <- lapply(shiny_prerendered_dependencies, function(dependency) { | ||
dependencies <- lapply(shiny_prerendered_dependencies$deps, function(dependency) { | ||
|
||
# no transformation in dev mode (so browser dev tools can map directly | ||
# to the locations of CSS and JS files in their pkg src directory) | ||
|
@@ -199,6 +262,8 @@ shiny_prerendered_append_dependencies <- function(input, # always UTF-8 | |
package_desc <- read.dcf(file.path(package_dir, "DESCRIPTION"), | ||
all = TRUE) | ||
dependency$package <- package_desc$Package | ||
# named to something that doesn't start with 'package' to deter lazy name matching | ||
dependency$pkgVersion <- package_desc$Version | ||
dependency$src$file <- normalized_relative_to(package_dir, | ||
dependency$src$file) | ||
} | ||
|
@@ -225,6 +290,14 @@ shiny_prerendered_append_dependencies <- function(input, # always UTF-8 | |
# write deps to connection | ||
dependencies_json <- jsonlite::serializeJSON(dependencies, pretty = FALSE) | ||
shiny_prerendered_append_context(con, "dependencies", dependencies_json) | ||
|
||
# write r major version and execution package dependencies | ||
execution_json <- jsonlite::serializeJSON( | ||
# visibly display what is being stored | ||
shiny_prerendered_dependencies[c("packages")], | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Don't need |
||
pretty = FALSE | ||
) | ||
shiny_prerendered_append_context(con, "execution_dependencies", execution_json) | ||
} | ||
|
||
|
||
|
@@ -324,7 +397,7 @@ shiny_prerendered_option_hook <- function(input, encoding) { | |
options$cache > 0) | ||
data_file <- to_utf8(data_file, encoding) | ||
data_dir <- shiny_prerendered_data_dir(input, create = TRUE) | ||
index_file <- shiny_prerendred_data_chunks_index(data_dir) | ||
index_file <- shiny_prerendered_data_chunks_index(data_dir) | ||
conn <- file(index_file, open = "ab", encoding = "UTF-8") | ||
on.exit(close(conn), add = TRUE) | ||
write(data_file, file = conn, append = TRUE) | ||
|
@@ -406,7 +479,7 @@ shiny_prerendered_evaluate_hook <- function(input) { | |
shiny_prerendered_remove_uncached_data <- function(input) { | ||
data_dir <- shiny_prerendered_data_dir(input) | ||
if (dir_exists(data_dir)) { | ||
index_file <- shiny_prerendred_data_chunks_index(data_dir) | ||
index_file <- shiny_prerendered_data_chunks_index(data_dir) | ||
if (file.exists(index_file)) | ||
unlink(index_file) | ||
rdata_files <- list.files(data_dir, pattern = utils::glob2rx("*.RData")) | ||
|
@@ -562,7 +635,7 @@ shiny_prerendered_data_load <- function(input_rmd, server_envir) { | |
data_dir <- shiny_prerendered_data_dir(input_rmd) | ||
if (dir_exists(data_dir)) { | ||
# read index of data files | ||
index_file <- shiny_prerendred_data_chunks_index(data_dir) | ||
index_file <- shiny_prerendered_data_chunks_index(data_dir) | ||
if (file.exists(index_file)) { | ||
rdata_files <- readLines(index_file, encoding = "UTF-8") | ||
# load each of the files in the index | ||
|
@@ -576,7 +649,7 @@ shiny_prerendered_data_load <- function(input_rmd, server_envir) { | |
} | ||
|
||
# File used to store names of chunks which had cache=TRUE during the last render | ||
shiny_prerendred_data_chunks_index <- function(data_dir) { | ||
shiny_prerendered_data_chunks_index <- function(data_dir) { | ||
file.path(data_dir, "data_chunks_index.txt") | ||
} | ||
|
||
|
@@ -585,4 +658,3 @@ shiny_prerendered_data_file_name <- function(label, cache) { | |
type <- ifelse(cache, ".cached", "") | ||
sprintf("%s%s.RData", label, type) | ||
} | ||
|
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -513,3 +513,30 @@ package_root <- function(path) { | |
length(grep('^Package: ', readLines(desc))) == 0) return(package_root(dir)) | ||
dir | ||
} | ||
|
||
|
||
# retrieve package version without fear of error | ||
# loading namespace is ok as these packages have been or will be used | ||
get_package_version_string <- function(package) { | ||
tryCatch( | ||
as.character(getNamespaceVersion(package)), | ||
error = function(e) { | ||
NULL | ||
} | ||
) | ||
} | ||
# find all loaded packages. | ||
# May contain extra packages, but contains all packages used while knitting | ||
get_loaded_packages <- function() { | ||
base_r_packages <- rownames(installed.packages(priority = 'base')) | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. This can be removed -- we might as well look at the base R packages as well, since it's (marginally) safer to use them, and the code will be slightly simpler without excluding them. It also lets us not record the R major version because that comes along with these packages. |
||
|
||
packages <- sort(setdiff(loadedNamespaces(), base_r_packages)) | ||
version <- vapply(packages, get_package_version_string, character(1)) | ||
attached <- paste0("package:", packages) %in% search() | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. We need to look at all loaded packages, not just the attached ones. For example, if someone does Another case is if they do |
||
|
||
data.frame( | ||
packages = packages[attached], | ||
version = version[attached], | ||
row.names = NULL, stringsAsFactors = FALSE | ||
) | ||
} |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Change to
for
loop with a short-circuit return.