[wb_to_df] fix date1904 conversion (#737)

Author: JanMarvin

NEWS.md

@@ -2,6 +2,7 @@
 
 ## Fixes
 
+* fix date1904 detection in `wb_to_df()`. Previous results from this somewhat rare file type were using a wrong timezone origin.
 * corrections in vignettes
 * fixes for loading workbooks with threaded comments
 * fixes for loading workbooks with embeddings other than docx

R/read.R

@@ -366,8 +366,11 @@ wb_to_df <- function(
     }
   }
 
+  origin <- get_date_origin(wb)
+
   # dates
   if (!is.null(cc$c_s)) {
+
     # if a cell is t="s" the content is a sst and not da date
     if (detect_dates && missing(types)) {
       cc$is_string <- FALSE
@@ -376,7 +379,7 @@ wb_to_df <- function(
 
       if (any(sel <- cc$c_s %in% xlsx_date_style)) {
         sel <- sel & !cc$is_string & cc$v != ""
-        cc$val[sel] <- suppressWarnings(as.character(convert_date(cc$v[sel])))
+        cc$val[sel] <- suppressWarnings(as.character(convert_date(cc$v[sel], origin = origin)))
         cc$typ[sel]  <- "d"
       }
 
@@ -393,7 +396,7 @@ wb_to_df <- function(
 
       if (any(sel <- cc$c_s %in% xlsx_posix_style)) {
         sel <- sel & !cc$is_string & cc$v != ""
-        cc$val[sel] <- suppressWarnings(as.character(convert_datetime(cc$v[sel])))
+        cc$val[sel] <- suppressWarnings(as.character(convert_datetime(cc$v[sel], origin = origin)))
         cc$typ[sel]  <- "p"
       }
     }
@@ -570,8 +573,8 @@ wb_to_df <- function(
       # convert "#NUM!" to "NaN" -- then converts to NaN
       # maybe consider this an option to instead return NA?
       if (length(nums)) z[nums] <- lapply(z[nums], function(i) as.numeric(replace(i, i == "#NUM!", "NaN")))
-      if (length(dtes)) z[dtes] <- lapply(z[dtes], date_conv)
-      if (length(poxs)) z[poxs] <- lapply(z[poxs], datetime_conv)
+      if (length(dtes)) z[dtes] <- lapply(z[dtes], date_conv, origin = origin)
+      if (length(poxs)) z[poxs] <- lapply(z[poxs], datetime_conv, origin = origin)
       if (length(logs)) z[logs] <- lapply(z[logs], as.logical)
       if (isNamespaceLoaded("hms")) z[difs] <- lapply(z[difs], hms_conv)
     } else {

R/wb_load.R

@@ -341,7 +341,7 @@ wb_load <- function(
     }
 
     workbookPr <- xml_node(workbook_xml, "workbook", "workbookPr")
-    if (!data_only && length(workbookPr)) {
+    if (length(workbookPr)) { # needed for date1904 detection
       wb$workbook$workbookPr <- workbookPr
     }
 

tests/testthat/test-date_time_conversion.R

@@ -98,3 +98,29 @@ test_that("custom classes are treated independently", {
   expect_equal(exp, got)
 
 })
+
+test_that("date 1904 workbooks to df work", {
+
+  DATE  <- as.Date("2015-02-07") + -10:10
+  POSIX <- as.POSIXct("2022-03-02 19:27:35") + -10:10
+  time <- data.frame(DATE, POSIX)
+
+  wb <- wb_workbook()
+  wb$add_worksheet()$add_data(x = time)
+  exp <- wb_to_df(wb)
+
+  wb <- wb_workbook()
+  wb$workbook$workbookPr <- '<workbookPr date1904="true"/>'
+  wb$add_worksheet()$add_data(x = time)
+  got <- wb_to_df(wb)
+
+  expect_equal(exp, got)
+
+  wb <- wb_workbook()
+  wb$workbook$workbookPr <- '<workbookPr date1904="1"/>'
+  wb$add_worksheet()$add_data(x = time)
+  got <- wb_to_df(wb)
+
+  expect_equal(exp, got)
+
+})

tests/testthat/test-named_regions.R

@@ -145,7 +145,11 @@ test_that("Missing rows in named regions", {
 
   ## create region
   wb$add_data(sheet = 1, x = iris[1:11, ], startCol = 1, startRow = 1)
-  delete_data(wb, sheet = 1, cols = 1:2, rows = c(6, 6))
+  expect_warning(
+    delete_data(wb, sheet = 1, cols = 1:2, rows = c(6, 6)),
+    "'delete_data' is deprecated."
+  )
+
 
   expect_warning(
     wb$add_named_region(
@@ -224,7 +228,10 @@ test_that("Missing columns in named regions", {
 
   ## create region
   wb$add_data(sheet = 1, x = iris[1:11, ], startCol = 1, startRow = 1)
-  delete_data(wb, sheet = 1, cols = 2, rows = 1:12)
+  expect_warning(
+    delete_data(wb, sheet = 1, cols = 2, rows = 1:12),
+    "'delete_data' is deprecated."
+  )
 
   wb$add_named_region(
     sheet = 1,