Write Hyperlinks if required. closes #624 (#625)

* Write Hyperlinks if required. closes #624 * second attempt * exclude hyperlinks in missing reference check
JanMarvin · May 24, 2023 · 49e271d · 49e271d
1 parent ea858e7
commit 49e271d
Show file tree

Hide file tree

Showing 2 changed files with 23 additions and 3 deletions.
diff --git a/R/class-workbook.R b/R/class-workbook.R
@@ -2085,6 +2085,10 @@ wbWorkbook <- R6::R6Class(
             WR$tmpDirPartName <- paste0(tmpDir, "/xl/", folder, "/", WR$Target)
             WR$fileExists <- file.exists(WR$tmpDirPartName)
 
+            # exclude hyperlinks
+            WR$type <- basename(WR$Type)
+            WR <- WR[WR$type != "hyperlink", ]
+
             if (any(!WR$fileExists)) {
               missing_in_tmp <- WR$Target[!WR$fileExists]
               warning(
@@ -6886,7 +6890,7 @@ wbWorkbook <- R6::R6Class(
           write_xmlPtr(doc = sheet_xml, fl = file.path(xlworksheetsDir, sprintf("sheet%s.xml", i)))
 
           ## write worksheet rels
-          if (length(self$worksheets_rels[[i]])) {
+          if (length(self$worksheets_rels[[i]]) || hasHL) {
             ws_rels <- self$worksheets_rels[[i]]
             if (hasHL) {
               h_inds <- stri_join(seq_along(self$worksheets[[i]]$hyperlinks), "h")

diff --git a/tests/testthat/test-read_sources.R b/tests/testthat/test-read_sources.R
@@ -354,8 +354,6 @@ test_that("reading multiple slicers on a pivot table works", {
 
   skip_if_offline()
 
-  temp <- temp_xlsx()
-
   wb <- wb_load("https://github.com/JanMarvin/openxlsx-data/raw/main/gh_issue_504.xlsx")
 
   expect_equal(1L, length(wb$slicers))
@@ -386,3 +384,21 @@ test_that("reading multiple slicers on a pivot table works", {
   expect_equal(exp, got)
 
 })
+
+test_that("hyperlinks work", {
+
+  skip_if_offline()
+
+  tmp <- temp_xlsx()
+  wb_load("https://github.com/JanMarvin/openxlsx-data/raw/main/Single_hyperlink.xlsx")$save(tmp)
+
+  temp_uzip <- paste0(tempdir(), "/unzip_openxlsx2")
+  dir.create(temp_uzip)
+  unzip(tmp, exdir = temp_uzip)
+
+  exp <- "<Relationships xmlns=\"http://schemas.openxmlformats.org/package/2006/relationships\"><Relationship Id=\"rId1h\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink\" Target=\"https://www.github.com/JanMarvin/openxlsx2\" TargetMode=\"External\"/></Relationships>"
+  got <- read_xml(paste0(temp_uzip, "/xl/worksheets/_rels/sheet1.xml.rels"), pointer = FALSE)
+  expect_equal(exp, got)
+
+  unlink(temp_uzip, recursive = TRUE)
+})