diff --git a/R/helper-functions.R b/R/helper-functions.R index a12f904c7..85a040a80 100644 --- a/R/helper-functions.R +++ b/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)) + } +} diff --git a/R/wb_load.R b/R/wb_load.R index 66f885b88..e0600043d 100644 --- a/R/wb_load.R +++ b/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"] diff --git a/tests/testthat/test-helper-functions.R b/tests/testthat/test-helper-functions.R index a21e4243b..b78f7cfb3 100644 --- a/tests/testthat/test-helper-functions.R +++ b/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) + +})