Add possibility to interact with metadata

NAMESPACE

@@ -120,6 +120,7 @@ export(wb_set_grid_lines)
 export(wb_set_header_footer)
 export(wb_set_last_modified_by)
 export(wb_set_order)
+export(wb_set_properties)
 export(wb_set_row_heights)
 export(wb_set_selected)
 export(wb_set_sheet_names)

R/class-workbook-wrappers.R

@@ -2254,6 +2254,32 @@ wb_get_creators <- function(wb) {
   wb[["creator"]]
 }
 
+#' Modify workbook properties
+#'
+#' This function is useful for workbooks that are loeaded. It can be used to set the
+#' workbook `title`, `subject` and `category` field. Use [wb_workbook()]
+#' to easily set these properties with a new workbook.
+#'
+#' @param wb A Workbook object
+#' @seealso [wb_workbook()]
+#' @inheritParams wb_workbook
+#' @return A wbWorkbook object, invisibly.
+#' @export
+#'
+#' @examples
+#' file <- system.file("extdata", "openxlsx2_example.xlsx", package = "openxlsx2")
+#' wb <- wb_load(file)
+#' wb$title
+#'
+#' # Add a title to properties
+#' wb$set_properties(title = "my title")
+#'
+#' wb$title
+#'
+wb_set_properties <- function(wb, title = NULL, subject = NULL, category = NULL) {
+  assert_workbook(wb)
+  wb$clone()$set_properties(title = title, subject = subject, category = category)
+}
 
 
 # names -------------------------------------------------------------------

R/class-workbook.R

@@ -5190,6 +5190,30 @@ wbWorkbook <- R6::R6Class(
     },
 
 
+    #' @description Set a property of a workbook
+    #' @param title,subject,category A workbook property to set
+    set_properties = function(title = NULL, subject = NULL, category = NULL) {
+      private$generate_base_core()
+
+      if (is.null(title) && is.null(subject) && is.null(category)) {
+        return(invisible(self))
+      }
+
+      if (!is.null(title)) {
+        private$modify_property("set", value = title, property = "title")
+      }
+
+      if (!is.null(subject)) {
+        private$modify_property("set", value = subject, "subject")
+      }
+
+      if (!is.null(category)) {
+        private$modify_property("set", value = category, "category")
+      }
+
+    },
+
+
     #' @description
     #' Change the last modified by
     #' @param name A new value
@@ -7311,6 +7335,28 @@ wbWorkbook <- R6::R6Class(
       invisible(self)
     },
 
+    modify_property = function(method = c("set", "remove"), value, property) {
+      method <- match.arg(method)
+
+     assert_class(value, "character", arg_nm = property)
+    # stopifnot(length(value) == 1)
+
+      if (any(!has_chr(value))) {
+        stop(property, " must be a string without NAs", call. = FALSE)
+      }
+
+      value <- switch(
+        method,
+        set    = unique(value),
+        remove = setdiff(self[[property]], value)
+      )
+
+      self[[property]] <- value
+      # core is made on initialization
+      private$generate_base_core()
+      invisible(self)
+    },
+
     get_drawingsref = function() {
       has_drawing <- which(grepl("drawings", self$worksheets_rels))
 

R/wb_load.R

@@ -165,6 +165,22 @@ wb_load <- function(
 
   if (!data_only && length(coreXML) == 1) {
     wb$core <- read_xml(coreXML, pointer = FALSE)
+    wb$title <- xml_value(wb$core, "cp:coreProperties", "dc:title")
+    if (length(wb$title) == 0) wb$title <- NULL
+
+    wb$subject <- xml_value(wb$core, "cp:coreProperties", "dc:subject")
+    if (length(wb$subject) == 0) wb$subject <- NULL
+    wb$category <- xml_value(wb$core, "cp:coreProperties", "cp:category")
+    if (length(wb$category) == 0) wb$category <- NULL
+
+    wb$creator <- xml_value(wb$core, "cp:coreProperties", "dc:creator")
+    if (length(wb$creator) == 0) wb$creator <- NULL
+    wb$creator <- wb$creator %||%
+      getOption("openxlsx2.creator") %||%
+      # USERNAME may only be present for windows
+      Sys.getenv("USERNAME", Sys.getenv("USER"))
+
+
   }
 
   if (!data_only && length(customXML)) {

_pkgdown.yml

@@ -92,6 +92,7 @@ reference:
   contents:
   - wb_set_last_modified_by
   - creators-wb
+  - wb_set_properties
   - wb_order
   - sheet_names-wb
   - wb_remove_worksheet

tests/testthat/test-class-workbook-wrappers.R

@@ -136,6 +136,13 @@ test_that("wb_remove_creators() is a wrapper", {
   expect_wrapper("remove_creators", wb = wb, params = list(creators = "myself"))
 })
 
+# wb_set_properties() ------------------------------------------
+
+test_that("wb_set_properties() is a wrapper", {
+  wb <- wb_workbook(subject = "xyz")
+  expect_wrapper("set_properties", wb = wb, params = list(subject = "a new subject"))
+})
+
 # wb_set_last_modified_by() ---------------------------------------------------
 
 test_that("wb_set_last_modified_by() is a wrapper", {

tests/testthat/test-loading_workbook.R

@@ -397,3 +397,15 @@ test_that("sheetView is not switched", {
   expect_equal(exp, got)
 
 })
+
+
+test_that("Loading a workbook with property preserves it.", {
+  wb <- wb_workbook(title = "x")$add_worksheet()
+  tmp <- temp_xlsx()
+  wb$save(file = tmp)
+
+  wb2 <- wb_load(tmp)
+  expect_equal(wb2$title, "x")
+  wb2$set_properties(title = "xyz")
+  expect_equal(wb2$title, "xyz")
+})