ropensci · chainsawriot · Aug 21, 2023 · Aug 21, 2023 · Aug 21, 2023 · Aug 21, 2023
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -35,7 +35,6 @@ LinkingTo:
     cpp11
 Suggests:
     spelling, 
-    dplyr,
     testthat,
     datasets,
     covr,

diff --git a/NEWS.md b/NEWS.md
@@ -2,7 +2,7 @@
 
 ## Add support for writing flat ODS
 
-`write_fods` is available; but it can't update or append sheets ref #103
+`write_fods` is available, fix #103
 
 # readODS 2.0.2
 

diff --git a/R/write_ods.R b/R/write_ods.R
@@ -1,3 +1,10 @@
+## CREATION OF sysdata
+## .CONTENT <- readLines("benchmark/header.xml")
+## .FOOTER <- readLines("benchmark/footer.xml")
+## .FODS_HEADER <- paste(readLines("benchmark/fods_header.xml"), collapse = "\n")
+## .FODS_FOOTER <- paste(readLines("benchmark/fods_footer.xml"), collapse = "\n")
+## usethis::use_data(.CONTENT, .FOOTER, .FODS_HEADER, .FODS_FOOTER, internal = TRUE, overwrite = TRUE)
+
 .zip_tmp_to_path <- function(temp_ods_dir, path, overwrite = TRUE) {
     wd <- getwd()
     on.exit(setwd(wd), add = TRUE)
@@ -28,13 +35,6 @@
     .silent_read_xml(sprintf('<table:table table:name="%s" table:style-name="ta1"><table:table-column table:style-name="co1" table:number-columns-repeated="16384" table:default-cell-style-name="ce1"/></table:table>', sheet))
 }
 
-## CREATION OF sysdata
-## .CONTENT <- readLines("benchmark/header.xml")
-## .FOOTER <- readLines("benchmark/footer.xml")
-## .FODS_HEADER <- paste(readLines("benchmark/fods_header.xml"), collapse = "\n")
-## .FODS_FOOTER <- paste(readLines("benchmark/fods_footer.xml"), collapse = "\n")
-## usethis::use_data(.CONTENT, .FOOTER, .FODS_HEADER, .FODS_FOOTER, internal = TRUE, overwrite = TRUE)
-
 .convert_df_to_sheet <- function(x, sheet = "Sheet1", row_names = FALSE, col_names = FALSE, na_as_string = FALSE, padding = FALSE) {
     throwaway_xml_file <- file.path(tempfile(fileext = ".xml"))
     write_sheet_(x = x, filename = throwaway_xml_file, sheet = sheet, row_names = row_names, col_names = col_names,
@@ -43,17 +43,6 @@
                   footer = "")
 }
 
-## https://github.com/ropensci/readODS/issues/88
-.vfwrite_ods <- function(x, temp_ods_dir, sheet = "Sheet1", row_names = FALSE, col_names = TRUE, na_as_string = FALSE, padding = FALSE) {
-    templatedir <- system.file("template", package = "readODS")
-    file.copy(dir(templatedir, full.names = TRUE), temp_ods_dir, recursive = TRUE, copy.mode = FALSE)
-    filename <- file.path(temp_ods_dir, "content.xml")
-    write_sheet_(x = x, filename = filename, sheet = sheet, row_names = row_names, col_names = col_names,
-                  na_as_string = na_as_string, padding = padding,
-                  header = paste0(.CONTENT[1], .CONTENT[2]),
-                  footer = .FOOTER)
-}
-
 .preprocess_x <- function(x) {
     if (inherits(x, "tbl_df")) { #Convert to a df if currently a tibble
         x <- as.data.frame(x)
@@ -78,6 +67,68 @@
     return(normalized_path)
 }
 
+.write_ods <- function(x, path = tempfile(fileext = ".ods"), sheet = "Sheet1", append = FALSE, update = FALSE, row_names = FALSE, col_names = TRUE, na_as_string = FALSE, padding = FALSE, flat = FALSE) {
+    if (isFALSE(flat)) {
+        temp_ods_dir <- file.path(tempdir(), stringi::stri_rand_strings(1, 20, pattern = "[A-Za-z0-9]"))
+        dir.create(temp_ods_dir)
+        on.exit(unlink(temp_ods_dir))
+    }
+    x <- .preprocess_x(x)
+    if (!file.exists(path) || (!append && !update)) {
+        path <- .preprocess_path(path)
+        if (isFALSE(flat)) {
+            templatedir <- system.file("template", package = "readODS")
+            file.copy(dir(templatedir, full.names = TRUE), temp_ods_dir, recursive = TRUE, copy.mode = FALSE)
+            filename <- file.path(temp_ods_dir, "content.xml")
+            header <- paste0(.CONTENT[1], .CONTENT[2])
+            footer <- .FOOTER
+        } else {
+            filename <- path
+            header <- .FODS_HEADER
+            footer <- .FODS_FOOTER
+        }
+        write_sheet_(filename = filename, x = x, sheet = sheet, row_names = row_names, col_names = col_names, na_as_string = na_as_string, padding = padding, header = header, footer = footer)
+    } else {
+        if (isFALSE(flat)) {
+            zip::unzip(path, exdir = temp_ods_dir)
+            contentfile <- file.path(temp_ods_dir, "content.xml")
+            sheet_exist <- sheet %in% list_ods_sheets(path, include_external_data = TRUE)
+
+        } else {
+            contentfile <- path
+            sheet_exist <- sheet %in% list_fods_sheets(path, include_external_data = TRUE)
+        }
+        if ((sheet_exist && append && !update) || (sheet_exist && !update)) {
+            ## Sheet exists so we cannot append
+            stop(paste0("Sheet ", sheet, " exists. Set update to TRUE is you want to update this sheet."), call. = FALSE)
+        }
+        if (!sheet_exist && update) {
+            stop(paste0("Sheet ", sheet, " does not exist. Cannot update."), call. = FALSE)
+        }
+        content <- xml2::read_xml(contentfile)
+        spreadsheet_node <- xml2::xml_children(xml2::xml_children(content)[[which(!is.na(xml2::xml_find_first(xml2::xml_children(content),"office:spreadsheet")))]])[[1]]
+        if (update) {
+            ## clean up the sheet
+            sheet_node <- .find_sheet_node_by_sheet(spreadsheet_node, sheet)
+            xml2::xml_remove(xml2::xml_children(sheet_node)[2:length(xml2::xml_children(sheet_node))])
+        }
+        if (append) {
+            ## Add a new sheet
+            sheet_node <- xml2::xml_add_child(spreadsheet_node, .silent_add_sheet_node(sheet))
+        }
+        throwaway_xml_file <- .convert_df_to_sheet(x = x, sheet = sheet, row_names = row_names, col_names = col_names,
+                                                       na_as_string = na_as_string, padding = padding)
+        xml2::xml_replace(sheet_node, .silent_read_xml(throwaway_xml_file))
+        ## write xml to contentfile
+        xml2::write_xml(content, contentfile)
+    }
+    if (isFALSE(flat)) {
+        ## zip up ODS archive
+        .zip_tmp_to_path(temp_ods_dir, path)
+    }
+    invisible(path)
+}
+
 #' Write Data to (F)ODS File
 #' @description
 #' Function to write a single data.frame to a (f)ods file.
@@ -105,53 +156,13 @@
 #' }
 #' @export
 write_ods <- function(x, path = tempfile(fileext = ".ods"), sheet = "Sheet1", append = FALSE, update = FALSE, row_names = FALSE, col_names = TRUE, na_as_string = FALSE, padding = FALSE) {
-    ## setup temp directory
-    ## one can't just use tempdir() because it is the same in the same session
-    temp_ods_dir <- file.path(tempdir(), stringi::stri_rand_strings(1, 20, pattern = "[A-Za-z0-9]"))
-    dir.create(temp_ods_dir)
-    on.exit(unlink(temp_ods_dir))
-    ## x <- .preprocess_x(x)
-    if (!file.exists(path) || (!append && !update)) {
-        path <- .preprocess_path(path)
-        .vfwrite_ods(x = x, temp_ods_dir = temp_ods_dir, sheet = sheet, row_names = row_names, col_names = col_names, na_as_string = na_as_string, padding = padding)
-    } else {
-        ## The file must be there.
-        zip::unzip(path, exdir = temp_ods_dir)
-        contentfile <- file.path(temp_ods_dir, "content.xml")
-        content <- xml2::read_xml(contentfile)
-        spreadsheet_node <- xml2::xml_children(xml2::xml_children(content)[[which(!is.na(xml2::xml_find_first(xml2::xml_children(content),"office:spreadsheet")))]])[[1]]
-        sheet_node <- .find_sheet_node_by_sheet(spreadsheet_node, sheet)
-        if ((!is.null(sheet_node) && append && !update) || (!is.null(sheet_node) && !update)) {
-            ## Sheet exists so we cannot append
-            stop(paste0("Sheet ", sheet, " exists. Set update to TRUE is you want to update this sheet."), call. = FALSE)
-        }
-        if (is.null(sheet_node) && update) {
-            stop(paste0("Sheet ", sheet, " does not exist. Cannot update."), call. = FALSE)
-        }
-        if (!is.null(sheet_node) && update) {
-            ## clean up the sheet
-            xml2::xml_remove(xml2::xml_children(sheet_node)[2:length(xml2::xml_children(sheet_node))])
-        }
-        if (is.null(sheet_node) && append) {
-            ## Add a new sheet
-            sheet_node <- xml2::xml_add_child(spreadsheet_node, .silent_add_sheet_node(sheet))
-        }
-        throwaway_xml_file <- .convert_df_to_sheet(x = x, sheet = sheet, row_names = row_names, col_names = col_names,
-                                                       na_as_string = na_as_string, padding = padding)
-        xml2::xml_replace(sheet_node, .silent_read_xml(throwaway_xml_file))
-        ## write xml to contentfile
-        xml2::write_xml(content, contentfile)
-    }
-    ## zip up ODS archive
-    .zip_tmp_to_path(temp_ods_dir, path)
-    invisible(path)
+    .write_ods(x = x, path = path, sheet = sheet, append = append, update = update, row_names = row_names, col_names = col_names,
+               na_as_string = na_as_string, padding = padding, flat = FALSE)
 }
 
 #' @rdname write_ods
 #' @export
-write_fods <- function(x, path = tempfile(fileext = ".fods"), sheet = "Sheet1", row_names = FALSE, col_names = TRUE, na_as_string = FALSE) {
-    x <- .preprocess_x(x)
-    path <- .preprocess_path(path)
-    write_sheet_(filename = path, x = x, sheet = sheet, row_names = row_names, col_names = col_names, na_as_string = na_as_string, padding = FALSE, header = .FODS_HEADER, footer = .FODS_FOOTER)
-    invisible(path)
+write_fods <- function(x, path = tempfile(fileext = ".fods"), sheet = "Sheet1", append = FALSE, update = FALSE, row_names = FALSE, col_names = TRUE, na_as_string = FALSE, padding = FALSE) {
+    .write_ods(x = x, path = path, sheet = sheet, append = append, update = update, row_names = row_names, col_names = col_names,
+               na_as_string = na_as_string, padding = padding, flat = TRUE)
 }
diff --git a/man/write_ods.Rd b/man/write_ods.Rd
diff --git a/tests/testthat/test_write_ods.R b/tests/testthat/test_write_ods.R
@@ -38,6 +38,20 @@ test_that("write to non-existing location", {
     expect_error(write_fods(mtcars, file.path("/there/is/no/way/this/exists/anyway", stringi::stri_rand_strings(1, 20, pattern = "[A-Za-z0-9]"),"mtcars.fods")))
 })
 
+test_that("round trip ods", {
+    a <- read_ods("../testdata/starwars.ods")
+    b <- write_ods(a)
+    d <- read_ods(b)
+    expect_equal(a,d)
+})
+
+test_that("round trip fods", {
+    a <- read_ods("../testdata/starwars.ods")
+    b <- write_fods(a)
+    d <- read_fods(b)
+    expect_equal(a,d)
+})
+
 ## from now on no need to test both fods and ods and they are using the same engine
 
 test_that("na_as_string, #79", {

diff --git a/tests/testthat/test_write_ods_append_update.R b/tests/testthat/test_write_ods_append_update.R
@@ -1,87 +1,113 @@
-library(dplyr)
-
-tmp <- tempfile(fileext=".ods")
-
-# Use this instead of numbers_to_letters for testing - only works for 1:26
-cols_to_letters <- function(n) {
-    stopifnot(n <= 26)
-
-    seq <- seq_len(n)
-    vapply(seq, function(n) LETTERS[n], character(1))
-}
-
-setup({
-
-})
-teardown({
-
-    unlink(tmp)
-})
-
-test_that("Write Excel sheets", {
-
-    # Use a dataframe with row and column headers, and at least one charactor column
-    # If you write a dataframe which has not had rownames explicitly set and use row_names=T,
-    # reading it back and comparing will give an attribute difference
+.test_funcs <- function(funcs) {
+    ## Use a dataframe with row and column headers, and at least one charactor column
+    ## If you write a dataframe which has not had rownames explicitly set and use row_names=T,
+    ## reading it back and comparing will give an attribute difference
     starwars10 <- readRDS("../testdata/starwars10.rds")
-
-    expect_silent(write_ods(starwars10, tmp, "SW", row_names = FALSE, col_names = FALSE))
+    expect_silent(tmp <- funcs[["w"]](starwars10, path = tempfile(fileext = ".ods"), sheet = "SW", row_names = FALSE, col_names = FALSE))
     expect_true(file.exists(tmp))
-    expect_silent(write_ods(starwars10, tmp, "SWR", row_names=TRUE, col_names = FALSE, append = TRUE))
-    expect_silent(write_ods(starwars10, tmp, "SWC", row_names = FALSE, col_names = TRUE, append = TRUE))
-    expect_silent(write_ods(starwars10, tmp, "SWRC", row_names=TRUE, col_names = TRUE, append = TRUE))
-    expect_silent(write_ods(starwars10[1, seq_len(ncol(starwars10))], tmp, "SW1", row_names=TRUE, col_names = TRUE, append = TRUE))
-    expect_silent(write_ods(starwars10[seq_len(nrow(starwars10)), 1, drop=FALSE], tmp, "SW10", row_names=TRUE, col_names = TRUE, append = TRUE))
+    expect_silent(funcs[["w"]](starwars10, tmp, "SWR", row_names = TRUE, col_names = FALSE, append = TRUE))
+    expect_silent(funcs[["w"]](starwars10, tmp, "SWC", row_names = FALSE, col_names = TRUE, append = TRUE))
+    expect_silent(funcs[["w"]](starwars10, tmp, "SWRC", row_names = TRUE, col_names = TRUE, append = TRUE))
+    expect_silent(funcs[["w"]](starwars10[1, seq_len(ncol(starwars10))], tmp, "SW1", row_names = TRUE, col_names = TRUE, append = TRUE))
+    expect_silent(funcs[["w"]](starwars10[seq_len(nrow(starwars10)), 1, drop = FALSE], tmp, "SW10", row_names=TRUE, col_names = TRUE, append = TRUE))
 
     ## SWRC is there
-    expect_error(write_ods(starwars10, tmp, "SWRC", row_names=TRUE, col_names = TRUE, append = TRUE))
+    expect_error(funcs[["w"]](starwars10, tmp, "SWRC", row_names = TRUE, col_names = TRUE, append = TRUE))
     ## SWRC is there, but this is update
-    expect_error(write_ods(starwars10, tmp, "SWRC", row_names=TRUE, col_names = TRUE, update = TRUE), NA)
-    expect_error(write_ods(starwars10, tmp, "whatevernotexists", row_names=TRUE, col_names = TRUE, update = TRUE))
+    expect_error(funcs[["w"]](starwars10, tmp, "SWRC", row_names = TRUE, col_names = TRUE, update = TRUE), NA)
+    expect_error(funcs[["w"]](starwars10, tmp, "whatevernotexists", row_names = TRUE, col_names = TRUE, update = TRUE))
 
-    df <- read_ods(tmp, "SW", row_names = FALSE, col_names = FALSE, strings_as_factors = TRUE, as_tibble = FALSE)
-     expect_true(all.equal({
+    df <- suppressMessages(funcs[["r"]](tmp, "SW", row_names = FALSE, col_names = FALSE, strings_as_factors = TRUE, as_tibble = FALSE))
+    expect_true(all.equal({
         cars <- starwars10
         rownames(cars) <- NULL
         colnames(cars) <- vctrs::vec_as_names(rep("", 9), repair = "unique")
         cars
     }, df))
 
-    df <- read_ods(tmp, "SWR", row_names = TRUE, col_names = FALSE, strings_as_factors = TRUE, as_tibble = FALSE)
+    df <- funcs[["r"]](tmp, "SWR", row_names = TRUE, col_names = FALSE, strings_as_factors = TRUE, as_tibble = FALSE)
     expect_true(all.equal({
         cars <- starwars10
         colnames(cars) <- vctrs::vec_as_names(rep("", 9), repair = "unique")
         cars}, df))
 
-    df <- read_ods(tmp, "SWC", row_names = FALSE, col_names = TRUE, strings_as_factors = TRUE, as_tibble = FALSE)
+    df <- funcs[["r"]](tmp, "SWC", row_names = FALSE, col_names = TRUE, strings_as_factors = TRUE, as_tibble = FALSE)
     expect_true(all.equal({
         cars <- starwars10
         rownames(cars) <- NULL
         cars
     }, df))
 
-    df <- read_ods(tmp, "SWRC", row_names = TRUE, col_names = TRUE, strings_as_factors = TRUE, as_tibble = FALSE)
+    df <- funcs[["r"]](tmp, "SWRC", row_names = TRUE, col_names = TRUE, strings_as_factors = TRUE, as_tibble = FALSE)
     expect_true(all.equal(starwars10, df))
 
-    df <- read_ods(tmp, "SW1", row_names = TRUE, col_names = TRUE, strings_as_factors = TRUE, as_tibble = FALSE)
+    df <- funcs[["r"]](tmp, "SW1", row_names = TRUE, col_names = TRUE, strings_as_factors = TRUE, as_tibble = FALSE)
 
     expect_false(isTRUE(all.equal(starwars10[1, seq_len(ncol(starwars10))], df))) # factor mismatch
     expect_true(all((df == starwars10[1, seq_len(ncol(starwars10))])[1,]))
 
-    df <- read_ods(tmp, "SW10", row_names = TRUE, col_names = TRUE, strings_as_factors = TRUE, as_tibble = FALSE)
-    expect_true(all.equal(starwars10[seq_len(nrow(starwars10)), 1, drop=FALSE], df))
+    df <- funcs[["r"]](tmp, "SW10", row_names = TRUE, col_names = TRUE, strings_as_factors = TRUE, as_tibble = FALSE)
+    expect_true(all.equal(starwars10[seq_len(nrow(starwars10)), 1, drop = FALSE], df))
+
+}
+
+test_that("Update / append sheets ods & fods", {
+    .test_funcs(list("r" = read_ods, "w" = write_ods))
+    .test_funcs(list("r" = read_fods, "w" = write_fods))
 })
 
+## test_that("Update / append sheets fods", {
+##     starwars10 <- readRDS("../testdata/starwars10.rds")
+##     expect_silent(tmp <- write_ods(starwars10, path = tempfile(fileext = ".ods"), sheet = "SW", row_names = FALSE, col_names = FALSE))
+##     expect_true(file.exists(tmp))
+##     expect_silent(write_ods(starwars10, tmp, "SWR", row_names = TRUE, col_names = FALSE, append = TRUE))
+##     expect_silent(write_ods(starwars10, tmp, "SWC", row_names = FALSE, col_names = TRUE, append = TRUE))
+##     expect_silent(write_ods(starwars10, tmp, "SWRC", row_names = TRUE, col_names = TRUE, append = TRUE))
+##     expect_silent(write_ods(starwars10[1, seq_len(ncol(starwars10))], tmp, "SW1", row_names = TRUE, col_names = TRUE, append = TRUE))
+##     expect_silent(write_ods(starwars10[seq_len(nrow(starwars10)), 1, drop = FALSE], tmp, "SW10", row_names=TRUE, col_names = TRUE, append = TRUE))
+
+##     ## SWRC is there
+##     expect_error(write_ods(starwars10, tmp, "SWRC", row_names = TRUE, col_names = TRUE, append = TRUE))
+##     ## SWRC is there, but this is update
+##     expect_error(write_ods(starwars10, tmp, "SWRC", row_names = TRUE, col_names = TRUE, update = TRUE), NA)
+##     expect_error(write_ods(starwars10, tmp, "whatevernotexists", row_names = TRUE, col_names = TRUE, update = TRUE))
+
+##     df <- suppressMessages(read_ods(tmp, "SW", row_names = FALSE, col_names = FALSE, strings_as_factors = TRUE, as_tibble = FALSE))
+##     expect_true(all.equal({
+##         cars <- starwars10
+##         rownames(cars) <- NULL
+##         colnames(cars) <- vctrs::vec_as_names(rep("", 9), repair = "unique")
+##         cars
+##     }, df))
+
+##     df <- read_ods(tmp, "SWR", row_names = TRUE, col_names = FALSE, strings_as_factors = TRUE, as_tibble = FALSE)
+##     expect_true(all.equal({
+##         cars <- starwars10
+##         colnames(cars) <- vctrs::vec_as_names(rep("", 9), repair = "unique")
+##         cars}, df))
+
+##     df <- read_ods(tmp, "SWC", row_names = FALSE, col_names = TRUE, strings_as_factors = TRUE, as_tibble = FALSE)
+##     expect_true(all.equal({
+##         cars <- starwars10
+##         rownames(cars) <- NULL
+##         cars
+##     }, df))
+
+##     df <- read_ods(tmp, "SWRC", row_names = TRUE, col_names = TRUE, strings_as_factors = TRUE, as_tibble = FALSE)
+##     expect_true(all.equal(starwars10, df))
+
+##     df <- read_ods(tmp, "SW1", row_names = TRUE, col_names = TRUE, strings_as_factors = TRUE, as_tibble = FALSE)
+
+##     expect_false(isTRUE(all.equal(starwars10[1, seq_len(ncol(starwars10))], df))) # factor mismatch
+##     expect_true(all((df == starwars10[1, seq_len(ncol(starwars10))])[1,]))
+
+##     df <- read_ods(tmp, "SW10", row_names = TRUE, col_names = TRUE, strings_as_factors = TRUE, as_tibble = FALSE)
+##     expect_true(all.equal(starwars10[seq_len(nrow(starwars10)), 1, drop = FALSE], df))
+## })
+
 test_that("issue 107", {
     legend <- readRDS("../testdata/legend.rds")
-    expect_error(write_ods(legend, tmp, sheet = "Legend"), NA)
-    expect_error(write_ods(legend, tmp, sheet = "Legend", update = TRUE), NA)
-    expect_error(write_ods(legend, tmp, sheet = "Legend2", append = TRUE), NA)
-})
-
-test_that("reading and writing and reading gets the same result as the start", {
-    a <- read_ods("../testdata/starwars.ods")
-    b <- write_ods(a, tmp)
-    d <- read_ods(tmp)
-    expect_equal(a,d)
+    expect_error(write_ods(legend, sheet = "Legend"), NA)
+    expect_error(write_ods(legend, sheet = "Legend", update = TRUE), NA)
+    expect_error(write_ods(legend, sheet = "Legend2", append = TRUE), NA)
 })