Replace '&' with '&' when exporting to HTML or XML, except column…

… headers for XML where '&' and ' ' both get replaced by '.'. Fixes gesistsa#234
bokov · Dec 3, 2019 · b9c11fc · b9c11fc
1 parent 443bbef
commit b9c11fc
Show file tree

Hide file tree

Showing 4 changed files with 25 additions and 3 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -2,6 +2,7 @@
 
  * Additional pointers were added to indicate how to load .doc, .docx, and .pdf files (#210, h/t Bill Denney)
  * Ensure that tests only run if the corresponding package is installed.  (h/t Bill Denney)
+ * Escape ampersands for html and xml export (#234 Alex Bokov) 
 
 # rio 0.5.19
 

diff --git a/R/export_methods.R b/R/export_methods.R
@@ -256,6 +256,8 @@ export_delim <- function(file, x, fwrite = TRUE, sep = "\t", row.names = FALSE,
     }
     for (i in seq_along(x)) {
         x[[i]][] <- lapply(x[[i]], as.character)
+        x[[i]][] <- lapply(x[[i]], function(v) gsub('&','&amp;',v))
+        names(x[[i]]) <- gsub('&','&amp;',names(x[[i]]))
         tab <- xml2::xml_add_child(bod, "table")
         # add header row
         invisible(xml2::xml_add_child(tab, xml2::read_xml(paste0(twrap(paste0(twrap(names(x[[i]]), "th"), collapse = ""), "tr"), "\n"))))
@@ -276,6 +278,10 @@ export_delim <- function(file, x, fwrite = TRUE, sep = "\t", row.names = FALSE,
     for (a in seq_along(att)) {
         xml2::xml_attr(xml, names(att)[a]) <- att[[a]]
     }
+    # remove illegal characters
+    row.names(x) <- gsub('&', '&amp;', row.names(x))
+    colnames(x) <- gsub('[ &]', '.', colnames(x))
+    x[] <- lapply(x, function(v) gsub('&', '&amp;', v))
     # add data
     for (i in seq_len(nrow(x))) {
         thisrow <- xml2::xml_add_child(xml, "Observation")

diff --git a/tests/testthat/test_format_html.R b/tests/testthat/test_format_html.R
@@ -5,11 +5,20 @@ test_that("Export to HTML", {
     expect_true(export(iris, "iris.html") %in% dir(), label = "export to html works")
 })
 
+test_that("Export to HTML with ampersands",{
+  iris$`R & D` <- paste(sample(letters,nrow(iris),rep=T),
+                        '&',
+                        sample(LETTERS,nrow(iris),rep=TRUE))
+  expect_true(export(iris, "iris2.html") %in% dir(), 
+              label = "export to html with ampersands works")
+})
+
+
 test_that("Import from HTML", {
     expect_true(is.data.frame(import("iris.html")), label = "import from single-table html works")
     f <- system.file("examples", "twotables.html", package = "rio")
     expect_true(all(dim(import(f, which = 1)) == c(32, 11)), label = "import from two-table html works (which = 1)")
     expect_true(all(dim(import(f, which = 2)) == c(150, 5)), label = "import from two-table html works (which = 2)")
 })
 
-unlink("iris.html")
+unlink(c("iris.xml","iris2.xml"))
diff --git a/tests/testthat/test_format_xml.R b/tests/testthat/test_format_xml.R
@@ -2,11 +2,17 @@ context("XML imports/exports")
 require("datasets")
 
 test_that("Export to XML", {
-    expect_true(export(iris, "iris.xml") %in% dir())
+    expect_true(export(iris, "iris.xml") %in% dir())})
+
+test_that("Export to XML with ampersands",{
+    iris$`R & D` <- paste(sample(letters,nrow(iris),rep=T),
+                          '&',
+                          sample(LETTERS,nrow(iris),rep=TRUE))
+    expect_true(export(iris, "iris2.xml") %in% dir())
 })
 
 test_that("Import from XML", {
     expect_true(is.data.frame(import("iris.xml")))
 })
 
-unlink("iris.xml")
+unlink(c("iris.xml","iris2.xml"))