From 83bba24d8589b593ca954c2b128a228918456adf Mon Sep 17 00:00:00 2001
From: Ashton Trey Belew <abelew@gmail.com>
Date: Wed, 20 Sep 2023 21:52:08 -0400
Subject: [PATCH] small change to attempt to stop tempfile() problems in larger
 documents.

---
 R/block.R | 33 +++++++++++++++++++++++++++++++--
 R/plot.R  |  4 ++--
 R/utils.R |  6 +++---
 3 files changed, 36 insertions(+), 7 deletions(-)

diff --git a/R/block.R b/R/block.R
index 283b2e28d4..1b3c247c35 100644
--- a/R/block.R
+++ b/R/block.R
@@ -201,7 +201,7 @@ eng_r = function(options) {
     opts_knit$set(global.pars = par(no.readonly = TRUE))
   }, add = TRUE)
 
-  tmp.fig = tempfile(); on.exit(unlink(tmp.fig), add = TRUE)
+  tmp.fig = tmpmd5file(); on.exit(unlink(tmp.fig), add = TRUE)
   # open a device to record plots if not using a global device or no device is
   # open, and close this device if we don't want to use a global device
   if (!opts_knit$get('global.device') || is.null(dev.list())) {
@@ -373,7 +373,7 @@ cache_globals = function(option, code) {
 }
 
 # open a graphical device for a chunk to record plots
-chunk_device = function(options, record = TRUE, tmp = tempfile()) {
+chunk_device = function(options, record = TRUE, tmp = tmpmd5file()) {
   width = options$fig.width[1L]
   height = options$fig.height[1L]
   dev = fallback_dev(options$dev)
@@ -641,3 +641,32 @@ label_code = function(code, options) {
 as.source = function(code) {
   list(structure(list(src = code), class = 'source'))
 }
+
+#' A hopefully more robust version of tempfile().
+#'
+#' @param pattern Filename prefix.
+#' @param suffix Filename suffix.
+#' @param digits Currently I use Sys.time() with this number of digits.
+#' @param body No implemented, intended to use other sources of digest()
+#' @param fileext Filename extension as per tempfile().
+#' @return md5 based tempfilename.
+#' @export
+tmpmd5file <- function(pattern = "", suffix = "", digits = 6, tmpdir = NULL,
+                       body = NULL, fileext = "", check = FALSE) {
+  if (!grepl(pattern = "^\\.", x = fileext)) {
+    pattern <- paste0(".", pattern)
+  }
+  op <- options(digits.secs = digits)
+  body_string <- digest::digest(Sys.time())
+  new <- options(op)
+  outdir <- tmpdir
+  if (is.null(outdir)) {
+    outdir <- tempdir(check = check)
+  }
+  if (!file.exists(outdir)) {
+    created <- dir.create(outdir, recursive = TRUE)
+  }
+  file_string <- paste0(pattern, body_string, suffix, fileext)
+  file_path <- file.path(outdir, file_string)
+  return(file_path)
+}
diff --git a/R/plot.R b/R/plot.R
index 7e194d2255..9972ee9361 100644
--- a/R/plot.R
+++ b/R/plot.R
@@ -41,7 +41,7 @@ dev_available = local({
   function(name, fun = dev_get(name)) {
     if (!is.null(res[[name]])) return(res[[name]])
     res[[name]] <<- tryCatch({
-      f = tempfile(); on.exit(unlink(f))
+      f = tmpmd5file(); on.exit(unlink(f))
       fun(f, width = 5, height = 5)
       grDevices::dev.off()
       TRUE
@@ -629,7 +629,7 @@ html_screenshot = function(x, options = opts_current$get(), ...) {
   if (is.null(wargs$vwidth)) wargs$vwidth = options$out.width.px
   if (is.null(wargs$vheight)) wargs$vheight = options$out.height.px
   if (is.null(wargs$delay)) wargs$delay = if (i1) 0.2 else 1
-  d = tempfile()
+  d = tmpmd5file()
   dir.create(d); on.exit(unlink(d, recursive = TRUE), add = TRUE)
   w = webshot_available()
   webshot = c(options$webshot, names(w)[w])
diff --git a/R/utils.R b/R/utils.R
index 404dd768c9..314a7bd713 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -472,7 +472,7 @@ out_format = function(x) {
 }
 
 # tempfile under the current working directory
-wd_tempfile = function(...) basename(tempfile(tmpdir = '.', ...))
+wd_tempfile = function(...) basename(tmpmd5file(tmpdir = '.', ...))
 
 pandoc_fragment = function(text, to = pandoc_to(), from = pandoc_from()) {
   if (length(text) == 0) return(text)
@@ -1066,14 +1066,14 @@ digest = function(x) {
 digest2 = function(x) {
   s = serialize(x, NULL, ascii = FALSE)
   if (length(s) > 14) s = s[-(1:14)]  # https://d.cosx.org/d/419804
-  writeBin(s, f <- tempfile())
+  writeBin(s, f <- tmpmd5file())
   on.exit(unlink(f), add = TRUE)
   unname(tools::md5sum(f))
 }
 
 # not removing the serialize() header (first few bytes)
 digest3 = function(x) {
-  f = tempfile(); on.exit(unlink(f), add = TRUE)
+  f = tmpmd5file(); on.exit(unlink(f), add = TRUE)
   s = file(f, open = 'wb')
   serialize(x, s, ascii = FALSE)
   close(s)