provide basename2 for to long strings

R/helper-functions.R

@@ -1341,3 +1341,18 @@ solve_merge <- function(have, want) {
 
   vapply(pieces, dataframe_to_dims, NA_character_)
 }
+
+#' get the basename
+#' on windows [basename()] only handles strings up to 255 characters, but we
+#' can have longer strings when loading file systems
+#' @param path a character string
+#' @keywords internal
+#' @noRd
+basename2 <- function(path) {
+  is_to_long <- vapply(path, to_long, NA)
+  if (any(is_to_long)) {
+    return(gsub(".*[\\/]", "", path))
+  } else {
+    return(basename(path))
+  }
+}

R/wb_load.R

@@ -834,7 +834,7 @@ wb_load <- function(
         # we do not ship this binary blob, therefore spreadsheet software may
         # stumble over this non existent reference. In the future we might want
         # to check if the references are valid pre file saving.
-        sel_row <- !grepl("printerSettings", basename(xml_relship$Target))
+        sel_row <- !grepl("printerSettings", basename2(xml_relship$Target))
         sel_col <- c("Id", "Type", "Target", "TargetMode")
         # return as xml
         xml <- df_to_xml("Relationship", xml_relship[sel_row, sel_col])
@@ -861,7 +861,7 @@ wb_load <- function(
 
       if (ncol(wb_rels)) {
         # since target can be any hyperlink, we have to expect various things here like uint64
-        wb_rels$tid <- suppressWarnings(as.integer(gsub("\\D+", "", basename(wb_rels$Target))))
+        wb_rels$tid <- suppressWarnings(as.integer(gsub("\\D+", "", basename2(wb_rels$Target))))
         wb_rels$typ <- basename(wb_rels$Type)
 
         cmmts <- wb_rels$tid[wb_rels$typ == "comments"]

tests/testthat/test-helper-functions.R

@@ -218,3 +218,21 @@ test_that("validate_colors() works", {
   expect_equal(exp, got)
 
 })
+
+test_that("basename2() works", {
+
+  long_path <- paste0(
+    paste0(rep("foldername/", 40), collapse = ""),
+    paste0(rep("filename", 40), collapse = ""),
+    ".txt"
+  )
+
+  # # maybe only broken on old Windows. Errors in 4.1 not in 4.3.1
+  # if (to_long(long_path))
+  #   expect_error(basename(long_path))
+
+  exp <- "filenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilenamefilename.txt"
+  got <- basename2(long_path)
+  expect_equal(exp, got)
+
+})