[mips] handle docMetadata folder with "LabelInfo.xml" file (#1028)

R/class-workbook-wrappers.R

@@ -2722,7 +2722,7 @@ wb_set_properties <- function(wb, creator = NULL, title = NULL, subject = NULL,
 #' @export
 wb_add_mips <- function(wb, xml = NULL) {
   assert_workbook(wb)
-  wb$clone()$set_properties(custom = xml)
+  wb$clone()$add_mips(xml = xml)
 }
 
 #' @param single_xml option to define if the string should be exported as single string. helpful if storing as option is desired.

R/class-workbook.R

@@ -106,6 +106,9 @@ wbWorkbook <- R6::R6Class(
     #' @field drawings_rels drawings_rels
     drawings_rels = NULL,
 
+    #' field docMetadata doc_meta_data
+    docMetadata = NULL,
+
     # #' @field drawings_vml drawings_vml
     # drawings_vml = NULL,
 
@@ -2808,6 +2811,16 @@ wbWorkbook <- R6::R6Class(
         Targets <- c(Targets, "docProps/custom.xml")
       }
 
+      # At the moment there is only a single known docMetadata file
+      if (length(self$docMetadata)) {
+        Ids <- c(Ids, paste0("rId", length(Ids) + 1L))
+        Types <- c(
+          Types,
+          "http://schemas.microsoft.com/office/2020/02/relationships/classificationlabels"
+        )
+        Targets <- c(Targets, "docMetadata/LabelInfo.xml")
+      }
+
       relship <- df_to_xml("Relationship",
         data.frame(Id = Ids, Type = Types, Target = Targets, stringsAsFactors = FALSE)
       )
@@ -2954,6 +2967,14 @@ wbWorkbook <- R6::R6Class(
         }
       }
 
+      if (length(self$docMetadata)) {
+        docMetadataDir     <- dir_create(tmpDir, "docMetadata")
+
+        write_file(body = self$docMetadata, fl = file.path(docMetadataDir, "LabelInfo.xml"))
+
+        ct <- append(ct, '<Override PartName="/docMetadata/LabelInfo.xml" ContentType="application/vnd.ms-office.classificationlabels+xml"/>')
+      }
+
       ## externalLinks
       if (length(self$externalLinks)) {
         externalLinksDir <- dir_create(tmpDir, "xl", "externalLinks")
@@ -6745,9 +6766,17 @@ wbWorkbook <- R6::R6Class(
       # get option and make sure that it can be imported as xml
       mips <- xml %||% getOption("openxlsx2.mips_xml_string")
       if (is.null(mips)) stop("no mips xml provided")
-      mips <- xml_node(mips, "property")
 
-      self$set_properties(custom = mips)
+      nam <- xml_node_name(mips)
+
+      if (all(nam == "clbl:labelList")) {
+        self$docMetadata <- xml_node(mips, nam)
+      } else {
+        mips <- xml_node(mips, "property")
+        self$set_properties(custom = mips)
+      }
+
+      invisible(self)
     },
 
     #' @description get mips string
@@ -6758,11 +6787,18 @@ wbWorkbook <- R6::R6Class(
         prop_nams <- grepl("MSIP_Label_", rbindlist(xml_attr(props, "property"))$name)
 
         name <- grepl("_Name$", rbindlist(xml_attr(props[prop_nams], "property"))$name)
-
         name <- xml_value(props[prop_nams][name], "property", "vt:lpwstr")
+        mips <- props[prop_nams]
+
+        if (length(name) == 0 && length(self$docMetadata)) {
+          name <- xml_attr(self$docMetadata, "clbl:labelList", "clbl:label")[[1]][["id"]]
+          mips <- self$docMetadata
+          # names(mips) <- "docMetadata"
+          single_xml <- FALSE
+        }
+
         if (!quiet) message("Found MIPS section: ", name)
 
-        mips <- props[prop_nams]
         if (single_xml)
           paste0(mips, collapse = "")
         else

R/wb_load.R

@@ -112,19 +112,21 @@ wb_load <- function(
   }
 
   ## Not used
-  # .relsXML          <- grep_xml("_rels/.rels$")
   ContentTypesXML   <- grep_xml("\\[Content_Types\\].xml$")
 
   if (length(ContentTypesXML) == 0 && !debug) {
     msg <- paste("File does not appear to be xlsx, xlsm or xlsb: ", file)
     stop(msg)
   }
 
+  # relsXML           <- grep_xml("_rels/.rels$")
+
   appXML            <- grep_xml("app.xml$")
   coreXML           <- grep_xml("core.xml$")
   customXML         <- grep_xml("custom.xml$")
 
   customXmlDir      <- grep_xml("customXml/")
+  docMetadataXML    <- grep_xml("docMetadata/")
 
   workbookBIN       <- grep_xml("workbook.bin$")
   workbookXML       <- grep_xml("workbook.xml$")
@@ -218,11 +220,11 @@ wb_load <- function(
   file_folders <- unique(basename(dirname(xmlFiles)))
   known <- c(
     basename(xmlDir), "_rels", "charts", "chartsheets", "ctrlProps",
-    "customXml", "docProps", "drawings", "embeddings", "externalLinks",
-    "media", "persons", "pivotCache", "pivotTables", "printerSettings",
-    "queryTables", "richData", "slicerCaches", "slicers", "tables", "theme",
-    "threadedComments", "timelineCaches", "timelines", "worksheets", "xl",
-    "[trash]"
+    "customXml", "docMetadata", "docProps", "drawings", "embeddings",
+    "externalLinks", "media", "persons", "pivotCache", "pivotTables",
+    "printerSettings", "queryTables", "richData", "slicerCaches",
+    "slicers", "tables", "theme", "threadedComments", "timelineCaches",
+    "timelines", "worksheets", "xl", "[trash]"
   )
   unknown <- file_folders[!file_folders %in% known]
   # nocov start
@@ -322,6 +324,17 @@ wb_load <- function(
     wb$custom <- read_xml(customXML, pointer = FALSE)
   }
 
+  if (!data_only && length(docMetadataXML)) {
+
+    # rels <- read_xml(relsXML)
+    # rels_df <- rbindlist(xml_attr(rels, "Relationships", "Relationship"))
+
+    if (any(basename2(docMetadataXML) != "LabelInfo.xml"))
+      warning("unknown metadata file found")
+
+    wb$docMetadata <- read_xml(docMetadataXML, pointer = FALSE)
+  }
+
   nSheets <- length(worksheetsXML) + length(chartSheetsXML)
 
   ##

tests/testthat/test-class-workbook.R

@@ -1216,3 +1216,15 @@ test_that("adding mips section works", {
   expect_equal(exp, got)
 
 })
+
+test_that("handling mips in docMetadata works", {
+  tmp <- temp_xlsx()
+  xml <- '<clbl:labelList xmlns:clbl=\"http://schemas.microsoft.com/office/2020/mipLabelMetadata\"><clbl:label foo="bar"/></clbl:labelList>'
+  wb <- wb_workbook() %>% wb_add_worksheet() %>% wb_add_mips(xml = xml)
+  wb$docMetadata
+  wb$save(tmp)
+  rm(wb)
+
+  wb <- wb_load(tmp)
+  expect_equal(xml, wb$docMetadata)
+})