Skip to content

Commit

Permalink
Force a render when user pkgs don't match the pkgs used in a rendered…
Browse files Browse the repository at this point in the history 
…, shiny-prerendered document (rstudio#1420)

Fixes rstudio/learnr#169
  • Loading branch information
@schloerke @yihui
schloerke authored and yihui committed Apr 1, 2019
1 parent a000103 commit e117ec4
Show file tree
Hide file tree
Showing 4 changed files with 152 additions and 53 deletions.
4 changes: 3 additions & 1 deletion NEWS.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,9 @@ rmarkdown 1.11 (unreleased)

* Fixed the website navbar not being able to display submenus properly (#721, #1426).

* Added checks for shiny-prerendered documents to find all html dependencies, match all execution packages, and match the major R version (#1420).


rmarkdown 1.10
================================================================================

Expand Down Expand Up @@ -549,4 +552,3 @@ rmarkdown 0.3.11
================================================================================

Initial release to CRAN

5 changes: 4 additions & 1 deletion R/render.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -360,7 +360,10 @@ render <- function(input,
# force various output options
output_options$self_contained <- FALSE
output_options$dependency_resolver <- function(deps) {
shiny_prerendered_dependencies <<- deps
shiny_prerendered_dependencies <<- list(
deps = deps,
packages = get_loaded_packages()
)
list()
}
}
Expand Down
172 changes: 121 additions & 51 deletions R/shiny_prerendered.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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) {
Expand Down Expand Up @@ -171,17 +135,114 @@ 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

# check for execution package version differences
execution_json <- shiny_prerendered_extract_context(html_lines, "execution_dependencies")
execution_info <- jsonlite::unserializeJSON(execution_json)
execution_pkg_names <- execution_info$packages$package
execution_pkg_versions <- execution_info$packages$version
for (i in seq_along(execution_pkg_names)) {
if (!identical(
get_package_version_string(execution_pkg_names[i]),
execution_pkg_versions[i]
)) {
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)
Expand All @@ -199,6 +260,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)
}
Expand All @@ -225,6 +288,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["packages"],
pretty = FALSE
)
shiny_prerendered_append_context(con, "execution_dependencies", execution_json)
}


Expand Down Expand Up @@ -324,7 +395,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)
Expand Down Expand Up @@ -406,7 +477,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"))
Expand Down Expand Up @@ -562,7 +633,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
Expand All @@ -576,7 +647,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")
}

Expand All @@ -585,4 +656,3 @@ shiny_prerendered_data_file_name <- function(label, cache) {
type <- ifelse(cache, ".cached", "")
sprintf("%s%s.RData", label, type)
}

24 changes: 24 additions & 0 deletions R/util.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -513,3 +513,27 @@ 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 will contain all packages used while knitting
get_loaded_packages <- function() {
packages <- sort(loadedNamespaces())
version <- vapply(packages, get_package_version_string, character(1))

data.frame(
packages = packages,
version = version,
row.names = NULL, stringsAsFactors = FALSE
)
}

0 comments on commit e117ec4

Please sign in to comment.