From 86654e65cc579b022d94a4f7c027120e6d1d97b5 Mon Sep 17 00:00:00 2001 From: LiNk-NY Date: Wed, 3 Jun 2026 18:33:44 -0400 Subject: [PATCH 1/6] migrate XML to xml2 authored-by: gemini 3.5 flash --- DESCRIPTION | 6 +- NAMESPACE | 3 +- R/repository.R | 4 +- R/xml2_helpers.R | 171 +++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 177 insertions(+), 7 deletions(-) create mode 100644 R/xml2_helpers.R diff --git a/DESCRIPTION b/DESCRIPTION index 3f48b66..6aabe7c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -20,13 +20,13 @@ Authors@R: c( "maintainer@bioconductor.org", "cre")) Depends: R (>= 4.6.0) Imports: Biobase, graph (>= 1.9.26), methods, RBGL (>= 1.13.5), tools, - utils, XML, RCurl, RUnit, BiocManager + utils, xml2, RCurl, RUnit, BiocManager Suggests: BiocGenerics, BiocPkgTools, knitr, commonmark, BiocStyle -Collate: AllClasses.R AllGenerics.R as-methods.R htmlDoc-methods.R +Collate: AllClasses.R AllGenerics.R xml2_helpers.R as-methods.R htmlDoc-methods.R htmlFilename-methods.R htmlValue-methods.R show-methods.R getPackNames.R packageDetails.R pump.R repository.R showvoc.R getPackageNEWS.R validation_tests.R recommendBiocViews.R dump_concept.R build_dbs.R VignetteBuilder: knitr -RoxygenNote: 7.3.2 Encoding: UTF-8 +Config/roxygen2/version: 8.0.0 diff --git a/NAMESPACE b/NAMESPACE index f0c1160..0add27d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -16,9 +16,8 @@ importFrom(utils, download.file, Stangle, available.packages, capture.output, contrib.url, data, file_test, head, packageDescription, readCitationFile, untar) -importMethodsFrom(XML, saveXML) +importFrom(xml2, read_html, xml_find_all, xml_text) -importFrom(XML, xmlNode, xmlOutputDOM, xmlTree, htmlParse, xpathApply, xmlValue) importFrom(RCurl, getURL) diff --git a/R/repository.R b/R/repository.R index c9edae5..b3aad8f 100644 --- a/R/repository.R +++ b/R/repository.R @@ -519,8 +519,8 @@ getHtmlTitle <- function(doc, src) { title <- getVignetteIndexEntry(src) if (is.na(title)) { ## now look for an HTML title - doc <- htmlParse(doc) - res <- xpathApply(doc, "//title", xmlValue) + doc <- xml2::read_html(doc) + res <- lapply(xml2::xml_find_all(doc, "//title"), xml2::xml_text) if (length(res)) title <- res[[1L]] } diff --git a/R/xml2_helpers.R b/R/xml2_helpers.R new file mode 100644 index 0000000..fdd40ef --- /dev/null +++ b/R/xml2_helpers.R @@ -0,0 +1,171 @@ +## xml2_helpers.R +## +## Compatibility wrappers that replicate the XML package's stateful DOM builder +## (xmlOutputDOM / xmlTree) and xmlNode / saveXML on top of xml2. +## +## The original code used three XML idioms: +## +## 1. xmlOutputDOM(tag, attrs) / xmlTree(tag) -- stateful builder +## Builder methods: $addTag(), $addNode(), $closeTag(), $value() +## +## 2. xmlNode(tag, ..., attrs) -- create a standalone xml2 node +## +## 3. saveXML(node, file, prefix="") -- serialize to file or string +## +## All three are re-implemented below so that the rest of the source code +## needs only minimal mechanical edits. + +## --------------------------------------------------------------------------- +## 1. xmlNode() replacement +## --------------------------------------------------------------------------- +## XML::xmlNode(name, ..., attrs = NULL) +## children / text content are passed as un-named or named '...' arguments. +## 'attrs' is a named character vector. +## +## We return an xml2 node (xml_node). Because xml2 builds nodes as part of a +## document, we keep a lightweight parent document. + +xmlNode <- function(name, ..., attrs = NULL) { + doc <- xml2::xml_new_document() + root <- xml2::xml_add_child(doc, name) + + if (!is.null(attrs) && length(attrs) > 0) { + for (nm in names(attrs)) + xml2::xml_attr(root, nm) <- attrs[[nm]] + } + + args <- list(...) + ## If there is only a single character child and no xml_node children, + ## use xml_set_text (produces a plain text node). When the args are mixed + ## (character + xml_node), wrap bare character strings in so that + ## inline separators (e.g. ", ") are preserved in the HTML output. + node_children <- vapply(args, inherits, logical(1), "xml_node") + mixed <- any(node_children) && any(!node_children) + for (child in args) { + if (inherits(child, "xml_node")) { + xml2::xml_add_child(root, child) + } else if (is.character(child) && nzchar(child)) { + if (mixed) { + sp <- xml2::xml_add_child(root, "span") + xml2::xml_set_text(sp, child) + } else { + xml2::xml_set_text(root, child) + } + } + } + root +} + +## --------------------------------------------------------------------------- +## 2. xmlOutputDOM() / xmlTree() replacement +## --------------------------------------------------------------------------- +## Both functions return an environment that exposes: +## $addTag(name, ..., attrs, close) -- open (and optionally close) a tag +## $addNode(node) -- append an xml_node child +## $closeTag() -- close the most-recently opened tag +## $value() -- return the root xml_node +## +## The stateful part is a stack of open nodes held in the environment. + +.makeXmlDomBuilder <- function(rootTag, attrs = NULL) { + doc <- xml2::xml_new_document() + root <- xml2::xml_add_child(doc, rootTag) + + if (!is.null(attrs) && length(attrs)) { + for (nm in names(attrs)) + xml2::xml_attr(root, nm) <- attrs[[nm]] + } + + ## stack: top of stack is the currently open node + stack <- list(root) + + current <- function() stack[[length(stack)]] + push <- function(n) stack[[length(stack) + 1L]] <<- n + pop <- function() stack[[length(stack)]] <<- NULL + + ## addTag(name, text?, attrs = NULL, close = TRUE) + addTag <- function(name, ..., attrs = NULL, close = TRUE) { + node <- xml2::xml_add_child(current(), name) + + if (!is.null(attrs) && length(attrs) > 0) { + for (nm in names(attrs)) + xml2::xml_attr(node, nm) <- attrs[[nm]] + } + + args <- list(...) + for (child in args) { + if (inherits(child, "xml_node")) { + xml2::xml_add_child(node, child) + } else if (is.character(child) && nzchar(child)) { + xml2::xml_set_text(node, child) + } + } + + if (!close) { + push(node) + } + invisible(NULL) + } + + ## addNode(node) -- append a pre-built xml_node + addNode <- function(node) { + if (inherits(node, "xml_node")) { + xml2::xml_add_child(current(), node) + } + invisible(NULL) + } + + ## closeTag() -- pop the stack (close the most-recently opened tag) + closeTag <- function() { + if (length(stack) > 1L) + pop() + invisible(NULL) + } + + ## value() -- return the root node + value <- function() root + + list( + addTag = addTag, + addNode = addNode, + closeTag = closeTag, + value = value + ) +} + +xmlOutputDOM <- function(tag = "doc", attrs = NULL, ...) { + .makeXmlDomBuilder(tag, attrs) +} + +## xmlTree is used identically to xmlOutputDOM in biocViews +xmlTree <- function(tag = "doc", attrs = NULL, ...) { + .makeXmlDomBuilder(tag, attrs) +} + +## --------------------------------------------------------------------------- +## 3. saveXML() replacement +## --------------------------------------------------------------------------- +## XML::saveXML(doc, file = NULL, prefix = "", ...) +## * When 'file' is NULL/missing, returns the serialised string. +## * When 'file' is a connection or path, writes to it. +## * 'prefix' is prepended to the output (used for DOCTYPE in biocViews). +## +## xml2::as_xml_document() / xml2::write_html() / xml2::write_xml() are used. + +saveXML <- function(doc, file = NULL, prefix = "", ...) { + if (!inherits(doc, "xml_node")) + stop("saveXML: 'doc' must be an xml_node") + + txt <- as.character(doc) + + ## Prepend any requested prefix (e.g. DOCTYPE declaration) + if (nzchar(prefix)) + txt <- paste0(prefix, "\n", txt) + + if (is.null(file)) { + return(txt) + } else { + writeLines(txt, con = file, sep = "") + invisible(txt) + } +} From d7a9acfe141e1221aaa5b071864e08a0ff563dad Mon Sep 17 00:00:00 2001 From: LiNk-NY Date: Wed, 3 Jun 2026 18:34:29 -0400 Subject: [PATCH 2/6] add unit tests for getHtmlTitle, getDocumentTitles, and getVignetteIndexEntry --- inst/extdata/vignette.Rmd | 23 ++++++++++++++ inst/extdata/vignette.html | 7 +++++ inst/unitTests/test_repository.R | 54 ++++++++++++++++++++++++++++++++ 3 files changed, 84 insertions(+) create mode 100644 inst/extdata/vignette.Rmd create mode 100644 inst/extdata/vignette.html create mode 100644 inst/unitTests/test_repository.R diff --git a/inst/extdata/vignette.Rmd b/inst/extdata/vignette.Rmd new file mode 100644 index 0000000..8f1b5e4 --- /dev/null +++ b/inst/extdata/vignette.Rmd @@ -0,0 +1,23 @@ +--- +title: "The Vignette Package" +author: "Vignette Author" +date: "`r format(Sys.Date(), '%A, %B %d, %Y')`" +always_allow_html: yes +output: + BiocStyle::html_document: + df_print: paged + toc_float: true +vignette: > + %\VignetteIndexEntry{Vignette for beginners} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r init, results='hide', echo=FALSE, warning=FALSE, message=FALSE} +library(knitr) +opts_chunk$set(warning=FALSE, message=FALSE) +``` + + +# What is a vignette? + diff --git a/inst/extdata/vignette.html b/inst/extdata/vignette.html new file mode 100644 index 0000000..c440e85 --- /dev/null +++ b/inst/extdata/vignette.html @@ -0,0 +1,7 @@ + + + + +The Vignette Package + + diff --git a/inst/unitTests/test_repository.R b/inst/unitTests/test_repository.R new file mode 100644 index 0000000..aa4981a --- /dev/null +++ b/inst/unitTests/test_repository.R @@ -0,0 +1,54 @@ +test_getHtmlTitle <- function() { + doc <- system.file( + "htmlfrags", + "topfrag.html", + package = "biocViews", + mustWork = TRUE + ) + src <- system.file( + "extdata", + "vignette.Rmd", + package = "biocViews", + mustWork = TRUE + ) + checkIdentical( + getVignetteIndexEntry(src), + "Vignette for beginners" + ) + checkIdentical( + getHtmlTitle(doc, src), + "Vignette for beginners" + ) + checkIdentical( + suppressWarnings({ + getHtmlTitle(doc, "") + }), + "Bioconductor Task View: top level views" + ) +} + +test_getDocumentTitles <- function() { + htmlDocs <- system.file("extdata", package = "biocViews") |> + list.files(pattern = "\\.[Hh][Tt][Mm][Ll]$", full.names = TRUE) + + checkIdentical( + getDocumentTitles( + basename(htmlDocs), + ext = "html", + src = c("Rmd", "Rhtml"), + dirname(htmlDocs), + getHtmlTitle + ), + "Vignette for beginners" + ) +} + +test_getVignetteIndexEntry <- function() { + rmdDocs <- system.file("extdata", package = "biocViews") |> + list.files(pattern = "\\.[Rr][Mm][Dd]$", full.names = TRUE) + + checkIdentical( + getVignetteIndexEntry(rmdDocs), + "Vignette for beginners" + ) +} From c38a3dbae609b2e3123f699aaaf2003a3639ac28 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcel=20Ramos=20P=C3=A9rez?= Date: Tue, 7 Jul 2026 16:43:57 -0400 Subject: [PATCH 3/6] support accumulating text when using xml2::xml_set_text Co-authored-by: Copilot Autofix powered by AI <175728472+Copilot@users.noreply.github.com> --- R/xml2_helpers.R | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/R/xml2_helpers.R b/R/xml2_helpers.R index fdd40ef..021d85c 100644 --- a/R/xml2_helpers.R +++ b/R/xml2_helpers.R @@ -41,18 +41,26 @@ xmlNode <- function(name, ..., attrs = NULL) { ## inline separators (e.g. ", ") are preserved in the HTML output. node_children <- vapply(args, inherits, logical(1), "xml_node") mixed <- any(node_children) && any(!node_children) + + txt_acc <- character() for (child in args) { if (inherits(child, "xml_node")) { xml2::xml_add_child(root, child) - } else if (is.character(child) && nzchar(child)) { - if (mixed) { - sp <- xml2::xml_add_child(root, "span") - xml2::xml_set_text(sp, child) - } else { - xml2::xml_set_text(root, child) + } else if (is.character(child)) { + txt <- paste0(child, collapse = "") + if (nzchar(txt)) { + if (mixed) { + sp <- xml2::xml_add_child(root, "span") + xml2::xml_set_text(sp, txt) + } else { + txt_acc <- c(txt_acc, txt) + } } } } + if (!mixed && length(txt_acc)) + xml2::xml_set_text(root, paste0(txt_acc, collapse = "")) + } root } From 5e9d56c99fd45862f29977f5bdc5fe7a2fda54ec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcel=20Ramos=20P=C3=A9rez?= Date: Tue, 7 Jul 2026 16:57:49 -0400 Subject: [PATCH 4/6] additional text accumulation changes Co-authored-by: Copilot Autofix powered by AI <175728472+Copilot@users.noreply.github.com> --- R/xml2_helpers.R | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/R/xml2_helpers.R b/R/xml2_helpers.R index 021d85c..e117302 100644 --- a/R/xml2_helpers.R +++ b/R/xml2_helpers.R @@ -101,13 +101,27 @@ xmlNode <- function(name, ..., attrs = NULL) { } args <- list(...) + node_children <- vapply(args, inherits, logical(1), "xml_node") + mixed <- any(node_children) && any(!node_children) + + txt_acc <- character() for (child in args) { if (inherits(child, "xml_node")) { xml2::xml_add_child(node, child) - } else if (is.character(child) && nzchar(child)) { - xml2::xml_set_text(node, child) + } else if (is.character(child)) { + txt <- paste0(child, collapse = "") + if (nzchar(txt)) { + if (mixed) { + sp <- xml2::xml_add_child(node, "span") + xml2::xml_set_text(sp, txt) + } else { + txt_acc <- c(txt_acc, txt) + } + } } } + if (!mixed && length(txt_acc)) + xml2::xml_set_text(node, paste0(txt_acc, collapse = "")) if (!close) { push(node) From 1093983f0764b25320bbad3ef6e59607594758d5 Mon Sep 17 00:00:00 2001 From: LiNk-NY Date: Tue, 7 Jul 2026 16:58:40 -0400 Subject: [PATCH 5/6] add opening bracket --- R/xml2_helpers.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/xml2_helpers.R b/R/xml2_helpers.R index e117302..94e2a39 100644 --- a/R/xml2_helpers.R +++ b/R/xml2_helpers.R @@ -58,7 +58,7 @@ xmlNode <- function(name, ..., attrs = NULL) { } } } - if (!mixed && length(txt_acc)) + if (!mixed && length(txt_acc)) { xml2::xml_set_text(root, paste0(txt_acc, collapse = "")) } root From 7dad4191e15e557fdce277fb3df737a89be7b210 Mon Sep 17 00:00:00 2001 From: LiNk-NY Date: Tue, 7 Jul 2026 17:45:16 -0400 Subject: [PATCH 6/6] add importFrom in NAMESPACE and remove qualified calls --- NAMESPACE | 8 +++++++- R/repository.R | 4 ++-- R/xml2_helpers.R | 34 +++++++++++++++++----------------- 3 files changed, 26 insertions(+), 20 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 0add27d..cf05a76 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -16,7 +16,13 @@ importFrom(utils, download.file, Stangle, available.packages, capture.output, contrib.url, data, file_test, head, packageDescription, readCitationFile, untar) -importFrom(xml2, read_html, xml_find_all, xml_text) +importFrom( + xml2, + read_html, + xml_find_all, xml_text, xml_new_document, + xml_add_child, xml_set_text + xml_attr, `xml_attr<-`, +) importFrom(RCurl, getURL) diff --git a/R/repository.R b/R/repository.R index b3aad8f..23c020e 100644 --- a/R/repository.R +++ b/R/repository.R @@ -519,8 +519,8 @@ getHtmlTitle <- function(doc, src) { title <- getVignetteIndexEntry(src) if (is.na(title)) { ## now look for an HTML title - doc <- xml2::read_html(doc) - res <- lapply(xml2::xml_find_all(doc, "//title"), xml2::xml_text) + doc <- read_html(doc) + res <- lapply(xml_find_all(doc, "//title"), xml_text) if (length(res)) title <- res[[1L]] } diff --git a/R/xml2_helpers.R b/R/xml2_helpers.R index 94e2a39..3856e0a 100644 --- a/R/xml2_helpers.R +++ b/R/xml2_helpers.R @@ -26,12 +26,12 @@ ## document, we keep a lightweight parent document. xmlNode <- function(name, ..., attrs = NULL) { - doc <- xml2::xml_new_document() - root <- xml2::xml_add_child(doc, name) + doc <- xml_new_document() + root <- xml_add_child(doc, name) if (!is.null(attrs) && length(attrs) > 0) { for (nm in names(attrs)) - xml2::xml_attr(root, nm) <- attrs[[nm]] + xml_attr(root, nm) <- attrs[[nm]] } args <- list(...) @@ -45,13 +45,13 @@ xmlNode <- function(name, ..., attrs = NULL) { txt_acc <- character() for (child in args) { if (inherits(child, "xml_node")) { - xml2::xml_add_child(root, child) + xml_add_child(root, child) } else if (is.character(child)) { txt <- paste0(child, collapse = "") if (nzchar(txt)) { if (mixed) { - sp <- xml2::xml_add_child(root, "span") - xml2::xml_set_text(sp, txt) + sp <- xml_add_child(root, "span") + xml_set_text(sp, txt) } else { txt_acc <- c(txt_acc, txt) } @@ -59,7 +59,7 @@ xmlNode <- function(name, ..., attrs = NULL) { } } if (!mixed && length(txt_acc)) { - xml2::xml_set_text(root, paste0(txt_acc, collapse = "")) + xml_set_text(root, paste0(txt_acc, collapse = "")) } root } @@ -76,12 +76,12 @@ xmlNode <- function(name, ..., attrs = NULL) { ## The stateful part is a stack of open nodes held in the environment. .makeXmlDomBuilder <- function(rootTag, attrs = NULL) { - doc <- xml2::xml_new_document() - root <- xml2::xml_add_child(doc, rootTag) + doc <- xml_new_document() + root <- xml_add_child(doc, rootTag) if (!is.null(attrs) && length(attrs)) { for (nm in names(attrs)) - xml2::xml_attr(root, nm) <- attrs[[nm]] + xml_attr(root, nm) <- attrs[[nm]] } ## stack: top of stack is the currently open node @@ -93,11 +93,11 @@ xmlNode <- function(name, ..., attrs = NULL) { ## addTag(name, text?, attrs = NULL, close = TRUE) addTag <- function(name, ..., attrs = NULL, close = TRUE) { - node <- xml2::xml_add_child(current(), name) + node <- xml_add_child(current(), name) if (!is.null(attrs) && length(attrs) > 0) { for (nm in names(attrs)) - xml2::xml_attr(node, nm) <- attrs[[nm]] + xml_attr(node, nm) <- attrs[[nm]] } args <- list(...) @@ -107,13 +107,13 @@ xmlNode <- function(name, ..., attrs = NULL) { txt_acc <- character() for (child in args) { if (inherits(child, "xml_node")) { - xml2::xml_add_child(node, child) + xml_add_child(node, child) } else if (is.character(child)) { txt <- paste0(child, collapse = "") if (nzchar(txt)) { if (mixed) { - sp <- xml2::xml_add_child(node, "span") - xml2::xml_set_text(sp, txt) + sp <- xml_add_child(node, "span") + xml_set_text(sp, txt) } else { txt_acc <- c(txt_acc, txt) } @@ -121,7 +121,7 @@ xmlNode <- function(name, ..., attrs = NULL) { } } if (!mixed && length(txt_acc)) - xml2::xml_set_text(node, paste0(txt_acc, collapse = "")) + xml_set_text(node, paste0(txt_acc, collapse = "")) if (!close) { push(node) @@ -132,7 +132,7 @@ xmlNode <- function(name, ..., attrs = NULL) { ## addNode(node) -- append a pre-built xml_node addNode <- function(node) { if (inherits(node, "xml_node")) { - xml2::xml_add_child(current(), node) + xml_add_child(current(), node) } invisible(NULL) }