diff --git a/NEWS.md b/NEWS.md index 0d3b744..bcb3b35 100644 --- 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 index 20b53ab..4a08f49 100644 --- 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('&','&',v)) + names(x[[i]]) <- gsub('&','&',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('&', '&', row.names(x)) + colnames(x) <- gsub('[ &]', '.', colnames(x)) + x[] <- lapply(x, function(v) gsub('&', '&', 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 index 79aba92..cfd8bce 100644 --- a/tests/testthat/test_format_html.R +++ b/tests/testthat/test_format_html.R @@ -5,6 +5,15 @@ 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") @@ -12,4 +21,4 @@ test_that("Import from HTML", { 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 index e2c4624..0e389d7 100644 --- 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"))