From 1aa6a129427ba24fec9813bde816bc6765096568 Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Sun, 15 Dec 2024 17:45:20 +0100 Subject: [PATCH] [load] read featurePropertyBag folder (#1216) This is used for checkboxes in MS365 --- R/class-workbook.R | 25 +++++++++++++++++++++++++ R/wb_load.R | 23 ++++++++++++++++++----- src/styles_xml.cpp | 22 ++++++++++++++++------ tests/testthat/test-read_sources.R | 8 ++++++++ tests/testthat/test-styles_xml.R | 12 ++++++++++++ tests/testthat/test-wb_styles.R | 4 ++-- 6 files changed, 81 insertions(+), 13 deletions(-) diff --git a/R/class-workbook.R b/R/class-workbook.R index 06b5a8f29..eb802b082 100644 --- a/R/class-workbook.R +++ b/R/class-workbook.R @@ -206,6 +206,9 @@ wbWorkbook <- R6::R6Class( #' @field externalLinksRels externalLinksRels externalLinksRels = NULL, + #' @field featurePropertyBag featurePropertyBag + featurePropertyBag = NULL, + #' @field headFoot The header and footer headFoot = NULL, @@ -3348,6 +3351,19 @@ wbWorkbook <- R6::R6Class( } } + # featurePropertyBag + if (length(self$featurePropertyBag)) { + featurePropertyBagDir <- dir_create(tmpDir, "xl", "featurePropertyBag") + + write_file( + body = self$featurePropertyBag, + fl = file.path( + featurePropertyBagDir, + sprintf("featurePropertyBag.xml") + ) + ) + } + if (!is.null(self$richData)) { richDataDir <- dir_create(tmpDir, "xl", "richData") if (length(self$richData$richValueRel)) { @@ -10102,6 +10118,15 @@ wbWorkbook <- R6::R6Class( ) } + if (!is.null(self$featurePropertyBag)) { + self$append("workbook.xml.rels", + sprintf( + '', + 1L + length(self$workbook.xml.rels) + ) + ) + } + ## Reassign rId to workbook sheet elements, (order sheets by sheetId first) self$workbook$sheets <- unapply( diff --git a/R/wb_load.R b/R/wb_load.R index c36d208f8..122cd4de6 100644 --- a/R/wb_load.R +++ b/R/wb_load.R @@ -213,6 +213,9 @@ wb_load <- function( ## VBA Macro vbaProject <- grep_xml("vbaProject\\.bin$") + ## feature property bag + featureProperty <- grep_xml("featurePropertyBag.xml$") + ## remove all EXCEPT media and charts on.exit( unlink( @@ -227,10 +230,11 @@ wb_load <- function( known <- c( basename(xmlDir), "_rels", "activeX", "charts", "chartsheets", "ctrlProps", "customXml", "docMetadata", "docProps", "drawings", - "embeddings", "externalLinks", "media", "persons", "pivotCache", - "pivotTables", "printerSettings", "queryTables", "richData", - "slicerCaches", "slicers", "tables", "theme", "threadedComments", - "timelineCaches", "timelines", "worksheets", "xl", "[trash]" + "embeddings", "externalLinks", "featurePropertyBag", "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 @@ -624,7 +628,7 @@ wb_load <- function( } - ## xl\sharedStrings + ## xl\metadata if (!data_only && length(metadataXML)) { wb$append( "Content_Types", @@ -813,6 +817,15 @@ wb_load <- function( wb$externalLinksRels <- lapply(extLinksRelsXML, read_xml, pointer = FALSE) } + ## featurePropertyBag + if (!data_only && length(featureProperty)) { + wb$append( + "Content_Types", + '' + ) + wb$featurePropertyBag <- read_xml(featureProperty, pointer = FALSE) + } + ##* ----------------------------------------------------------------------------------------------*## ### BEGIN READING IN WORKSHEET DATA diff --git a/src/styles_xml.cpp b/src/styles_xml.cpp index 0a7dfb373..eb764ec4f 100644 --- a/src/styles_xml.cpp +++ b/src/styles_xml.cpp @@ -119,7 +119,7 @@ Rcpp::DataFrame read_xf(XPtrXML xml_doc_xf) { // only handle known names // - // // FIXME should be imported as single node. most likely broken + // // for (auto cld : xml_xf.children()) { @@ -128,6 +128,14 @@ Rcpp::DataFrame read_xf(XPtrXML xml_doc_xf) { // check known names if (cld_name == "alignment" || cld_name == "extLst" || cld_name == "protection") { + if (cld_name == "extLst") { + R_xlen_t mtc = std::distance(nams.begin(), nams.find(cld_name)); + uint32_t pugi_format_flags = pugi::format_raw; + std::ostringstream oss; + cld.print(oss, " ", pugi_format_flags); + Rcpp::as(df[mtc])[itr] = Rcpp::String(oss.str()); + } + for (auto attrs : cld.attributes()) { std::string attr_name = attrs.name(); std::string attr_value = attrs.value(); @@ -229,9 +237,6 @@ Rcpp::CharacterVector write_xf(Rcpp::DataFrame df_xf) { has_extLst = has_it(df_xf, xf_nams_extLst, i); pugi::xml_node xf_extLst; - if (has_extLst) { - xf_extLst = xf.append_child("extLst"); - } // check if protection node is required bool has_protection = false; @@ -275,14 +280,19 @@ Rcpp::CharacterVector write_xf(Rcpp::DataFrame df_xf) { } } - // FIXME should be written as single node. most likely broken if (has_extLst && is_extLst) { Rcpp::CharacterVector cv_s = ""; cv_s = Rcpp::as(df_xf[j])[i]; if (cv_s[0] != "") { const std::string val_strl = Rcpp::as(cv_s); - xf_extLst.append_attribute(attrnam.c_str()) = val_strl.c_str(); + pugi::xml_document tempDoc; + pugi::xml_parse_result tempResult = tempDoc.load_string(val_strl.c_str()); + if (tempResult) { + xf.append_copy(tempDoc.first_child()); + } else { + Rcpp::stop("failed to load xf child `extLst`."); + } } } diff --git a/tests/testthat/test-read_sources.R b/tests/testthat/test-read_sources.R index 26f03bc68..a3a726f60 100644 --- a/tests/testthat/test-read_sources.R +++ b/tests/testthat/test-read_sources.R @@ -482,3 +482,11 @@ test_that("loading d3p1 file works", { expect_equal(exp, got) }) + +test_that("loading file with featurePropertyBag works", { + fl <- testfile_path("checkboxes.xlsx") + tmp <- temp_xlsx() + + expect_silent(wb <- wb_load(fl)) + expect_silent(wb$save(tmp)) +}) diff --git a/tests/testthat/test-styles_xml.R b/tests/testthat/test-styles_xml.R index 79766b685..02617f4fd 100644 --- a/tests/testthat/test-styles_xml.R +++ b/tests/testthat/test-styles_xml.R @@ -164,3 +164,15 @@ test_that("colors", { ) }) + +test_that("reading xf node extLst works", { + xml <- "" + xf <- read_xml(xml) + + df_xf <- read_xf(xml_doc_xf = xf) + got <- write_xf(df_xf) + expect_equal(xml, got) + + df_xf$extLst <- "" + expect_error(write_xf(df_xf), "failed to load xf child") +}) diff --git a/tests/testthat/test-wb_styles.R b/tests/testthat/test-wb_styles.R index d8c32ab52..2566e3789 100644 --- a/tests/testthat/test-wb_styles.R +++ b/tests/testthat/test-wb_styles.R @@ -257,7 +257,7 @@ test_that("test add_cell_style()", { expect_equal(exp, got) ### - exp <- "" + exp <- "" got <- create_cell_style( borderId = "1", fillId = "1", @@ -275,7 +275,7 @@ test_that("test add_cell_style()", { textRotation = "1", vertical = "1", wrapText = "1", - extLst = "1", + extLst = "", hidden = "1", locked = "1" )