force datetime creation. closes #685 (#686)

* pass datetime_created to genBaseCore() * force datetime_created * enforce a fixed date
JanMarvin · Jul 22, 2023 · 9b05abd · 9b05abd
1 parent c4cd736
commit 9b05abd
Show file tree

Hide file tree

Showing 5 changed files with 26 additions and 17 deletions.
diff --git a/R/baseXML.R b/R/baseXML.R
@@ -152,17 +152,18 @@ genBaseApp <- function() {
   )
 }
 
-genBaseCore <- function(creator = "", title = NULL, subject = NULL, category = NULL) {
+genBaseCore <- function(creator = "", title = NULL, subject = NULL, category = NULL, datetimeCreated = NULL) {
 
   if (length(creator) > 1) creator <- paste0(creator, collapse = ";")
+  if (is.null(datetimeCreated)) datetimeCreated <- Sys.time()
 
   dc_creator <- xml_node_create("dc:creator", xml_children = creator)
   cp_lastMod <- xml_node_create("cp:lastModifiedBy", xml_children = creator)
   dc_terms   <- xml_node_create("dcterms:created",
     xml_attributes = c(
       `xsi:type` = "dcterms:W3CDTF"
     ),
-    xml_children = format(as_POSIXct_utc(Sys.time()), "%Y-%m-%dT%H:%M:%SZ")
+    xml_children = format(as_POSIXct_utc(datetimeCreated), "%Y-%m-%dT%H:%M:%SZ")
   )
 
   dc_title <- NULL

diff --git a/R/class-workbook.R b/R/class-workbook.R
@@ -181,15 +181,17 @@ wbWorkbook <- R6::R6Class(
     #' @param ... additional arguments
     #' @return a `wbWorkbook` object
     initialize = function(
-      creator         = NULL,
-      title           = NULL,
-      subject         = NULL,
-      category        = NULL,
+      creator          = NULL,
+      title            = NULL,
+      subject          = NULL,
+      category         = NULL,
       datetime_created = Sys.time(),
-      theme           = NULL,
+      theme            = NULL,
       ...
     ) {
 
+      force(datetime_created)
+
       standardize_case_names(...)
 
       self$app <- genBaseApp()
@@ -291,11 +293,14 @@ wbWorkbook <- R6::R6Class(
         # USERNAME may only be present for windows
         Sys.getenv("USERNAME", Sys.getenv("USER"))
 
-      assert_class(self$creator,     "character")
-      assert_class(title,            "character", or_null = TRUE)
-      assert_class(subject,          "character", or_null = TRUE)
-      assert_class(category,         "character", or_null = TRUE)
-      assert_class(datetime_created, "POSIXt")
+      self$datetimeCreated <- getOption("openxlsx2.datetimeCreated") %||%
+        datetime_created
+
+      assert_class(self$creator,         "character")
+      assert_class(title,                "character", or_null = TRUE)
+      assert_class(subject,              "character", or_null = TRUE)
+      assert_class(category,             "character", or_null = TRUE)
+      assert_class(self$datetimeCreated, "POSIXt")
 
       stopifnot(
         length(title) <= 1L,
@@ -306,7 +311,6 @@ wbWorkbook <- R6::R6Class(
       self$title           <- title
       self$subject         <- subject
       self$category        <- category
-      self$datetimeCreated <- datetime_created
       private$generate_base_core()
       private$current_sheet <- 0L
       invisible(self)
@@ -3857,11 +3861,13 @@ wbWorkbook <- R6::R6Class(
         done <- as_xml_attr(resolve)
         if (reply) done <- NULL
 
+        ts <- getOption("openxlsx2.datetimeCreated") %||% Sys.time()
+
         tc <- xml_node_create(
           "threadedComment",
           xml_attributes = c(
             ref      = dims,
-            dT       = format(as_POSIXct_utc(Sys.time()), "%Y-%m-%dT%H:%M:%SZ"),
+            dT       = format(as_POSIXct_utc(ts), "%Y-%m-%dT%H:%M:%SZ"),
             personId = person_id,
             id       = cmt_id,
             parentId = parentId,
@@ -7159,7 +7165,7 @@ wbWorkbook <- R6::R6Class(
 
     generate_base_core = function() {
       # how do self$datetimeCreated and genBaseCore time differ?
-      self$core <- genBaseCore(creator = self$creator, title = self$title, subject = self$subject, category = self$category)
+      self$core <- genBaseCore(creator = self$creator, title = self$title, subject = self$subject, category = self$category, datetimeCreated = self$datetimeCreated)
       invisible(self)
     },
 

diff --git a/tests/testthat/test-Workbook_properties.R b/tests/testthat/test-Workbook_properties.R
@@ -80,7 +80,7 @@ test_that("escaping in wbWorkbooks genBaseCore works as expected", {
 
   nms <- xml_node_name(got, "cp:coreProperties")
 
-  for (nm in nms[nms != "cp:lastModifiedBy"]) {
+  for (nm in nms[!nms %in% c("cp:lastModifiedBy", "dcterms:created")]) {
     expect_equal(
       xml_node(got, "cp:coreProperties", nm),
       xml_node(wb$core, "cp:coreProperties", nm)

diff --git a/tests/testthat/test-aaa.R b/tests/testthat/test-aaa.R
@@ -1,5 +1,7 @@
 test_that("testsetup", {
 
+  options("openxlsx2.datetimeCreated" = as.POSIXct("2023-07-20 23:32:14"))
+
   if (Sys.getenv("openxlsx2_testthat_fullrun") == "") {
     skip_on_ci()
   }

diff --git a/tests/testthat/test-class-workbook-wrappers.R b/tests/testthat/test-class-workbook-wrappers.R
@@ -133,7 +133,7 @@ test_that("wb_set_creators() is a wrapper", {
 
 test_that("wb_remove_creators() is a wrapper", {
   wb <- wb_workbook(creator = "myself")
-  expect_wrapper("remove_creators", params = list(creators = "myself"))
+  expect_wrapper("remove_creators", wb = wb, params = list(creators = "myself"))
 })
 
 # wb_set_last_modified_by() ---------------------------------------------------