[read] add show_hyperlinks argument (#1136)

NEWS.md

@@ -4,6 +4,8 @@
 
 * When writing a file with `na.strings = NULL`, the file will not contain any reference to the blank cell. Depending on the number of missings in a data set, this can reduce the file size significantly. [1111](https://github.com/JanMarvin/openxlsx2/pull/1111)
 
+* `wb_to_df()` gained a new argument `show_hyperlinks` which returns the target or location of a hyperlink, instead of the links description. [1136](https://github.com/JanMarvin/openxlsx2/pull/1136)
+
 ## Fixes
 
 * The integration of the shared formula feature in the previous release broke the silent extension of dims, if a single cell `dims` was provided for an `x` that was larger than a single cell in `wb_add_formula()`. [1131](https://github.com/JanMarvin/openxlsx2/pull/1131)

R/class-workbook.R

@@ -2466,6 +2466,7 @@ wbWorkbook <- R6::R6Class(
     #' @param fill_merged_cells If TRUE, the value in a merged cell is given to all cells within the merge.
     #' @param keep_attributes If TRUE additional attributes are returned. (These are used internally to define a cell type.)
     #' @param check_names If TRUE then the names of the variables in the data frame are checked to ensure that they are syntactically valid variable names.
+    #' @param show_hyperlinks If `TRUE` instead of the displayed text, hyperlink targets are shown.
     #' @return a data frame
     to_df = function(
       sheet,
@@ -2490,6 +2491,7 @@ wbWorkbook <- R6::R6Class(
       named_region,
       keep_attributes   = FALSE,
       check_names       = FALSE,
+      show_hyperlinks   = FALSE,
       ...
     ) {
 
@@ -2521,7 +2523,9 @@ wbWorkbook <- R6::R6Class(
         convert           = convert,
         types             = types,
         named_region      = named_region,
-        check_names       = check_names
+        check_names       = check_names,
+        show_hyperlinks   = show_hyperlinks,
+        ...               = ...
       )
     },
 

R/read.R

@@ -65,6 +65,7 @@
 #' @param keep_attributes If `TRUE` additional attributes are returned.
 #'   (These are used internally to define a cell type.)
 #' @param check_names If `TRUE` then the names of the variables in the data frame are checked to ensure that they are syntactically valid variable names.
+#' @param show_hyperlinks If `TRUE` instead of the displayed text, hyperlink targets are shown.
 #' @param ... additional arguments
 #'
 #' @examples
@@ -156,6 +157,7 @@ wb_to_df <- function(
     named_region,
     keep_attributes   = FALSE,
     check_names       = FALSE,
+    show_hyperlinks = FALSE,
     ...
 ) {
 
@@ -177,8 +179,12 @@ wb_to_df <- function(
     if (missing(sheet))
       sheet <- substitute()
 
+    data_only <- TRUE
+    # TODO hyperlinks are deeper embedded into the wb_load code
+    if (show_hyperlinks) data_only <- FALSE
+
     # possible false positive on current lintr runs
-    wb <- wb_load(file, sheet = sheet, data_only = TRUE) # nolint
+    wb <- wb_load(file, sheet = sheet, data_only = data_only) # nolint
   }
 
   if (!missing(named_region)) {
@@ -470,6 +476,21 @@ wb_to_df <- function(
 
   }
 
+  if (show_hyperlinks) {
+
+    if (length(wb$worksheets[[sheet]]$hyperlinks)) {
+      hyprlnks <- as.data.frame(
+        do.call("rbind",
+                lapply(wb$worksheets[[sheet]]$hyperlinks, function(hl) {
+                  c(hl$ref, ifelse(is.null(hl$target), hl$location, hl$target))
+                })
+        )
+      )
+      cc$val[match(hyprlnks$V1, cc$r)] <- hyprlnks$V2
+    }
+
+  }
+
   # convert "na_string" to missing
   if (has_na_string) cc$typ[cc$typ == "na_string"] <- NA
   if (has_na_number) cc$typ[cc$typ == "na_number"] <- NA
@@ -684,6 +705,7 @@ read_xlsx <- function(
   na.numbers        = NA,
   fill_merged_cells = FALSE,
   check_names       = FALSE,
+  show_hyperlinks   = FALSE,
   ...
 ) {
 
@@ -712,7 +734,8 @@ read_xlsx <- function(
     na.numbers        = na.numbers,
     fill_merged_cells = fill_merged_cells,
     check_names       = check_names,
-    ...
+    show_hyperlinks   = show_hyperlinks,
+    ...               = ...
   )
 }
 
@@ -735,6 +758,7 @@ wb_read <- function(
   na.strings      = "NA",
   na.numbers      = NA,
   check_names     = FALSE,
+  show_hyperlinks = FALSE,
   ...
 ) {
 
@@ -762,7 +786,8 @@ wb_read <- function(
     na.strings      = na.strings,
     na.numbers      = na.numbers,
     check_names     = check_names,
-    ...
+    show_hyperlinks = show_hyperlinks,
+    ...             = ...
   )
 
 }

tests/testthat/test-read_sources.R

@@ -411,3 +411,44 @@ test_that("reading timeline works", {
   )
 
 })
+
+test_that("show_hyperlink works", {
+
+  fl  <- testfile_path("hyperlinks.xlsx")
+
+  not_hl <- wb_to_df(fl, show_hyperlinks = FALSE)
+  has_hl <- wb_to_df(fl, show_hyperlinks = TRUE)
+
+  # everything identical in column A
+  expect_equal(not_hl$A, has_hl$A)
+
+  # column B: mail gets mailto:
+  exp <- "noreply@openxlsx2.com"
+  got <- not_hl$B[5]
+  expect_equal(exp, got)
+
+  exp <- "mailto:noreply@openxlsx2.com"
+  got <- has_hl$B[5]
+  expect_equal(exp, got)
+
+  # column B: hyperlink target url does not match hyperlink text
+  exp <- "https://github.com/JanMarvin/openxlsx2"
+  got <- not_hl$B[3]
+  expect_equal(exp, got)
+
+  exp <- "https://janmarvin.github.io/openxlsx2"
+  got <- has_hl$B[3]
+  expect_equal(exp, got)
+
+  # everything identical in column C
+  expect_equal(not_hl$C, has_hl$C)
+
+  # link to external file
+  exp <- "test"
+  got <- not_hl$D[1]
+  expect_equal(exp, got)
+
+  exp <- "hyperlink.xlsb"
+  got <- has_hl$D[1]
+  expect_equal(exp, got)
+})