diff --git a/DESCRIPTION b/DESCRIPTION index bbe806a..c9d9a75 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -42,6 +42,7 @@ Collate: 'xml_parse.R' 'as_xml_document.R' 'classes.R' + 'cpp11.R' 'format.R' 'import-standalone-obj-type.R' 'import-standalone-purrr.R' @@ -71,3 +72,5 @@ Collate: 'xml_write.R' 'zzz.R' Config/testthat/edition: 3 +LinkingTo: + cpp11 diff --git a/R/as_xml_document.R b/R/as_xml_document.R index 2b147c3..fad529f 100644 --- a/R/as_xml_document.R +++ b/R/as_xml_document.R @@ -46,7 +46,7 @@ as_xml_document.list <- function(x, ...) { add_node <- function(x, parent, tag = NULL) { if (is.atomic(x)) { - return(.Call(node_new_text, parent$node, as.character(x))) + return(node_new_text(parent$node, as.character(x))) } if (!is.null(tag)) { parent <- xml_add_child(parent, tag) diff --git a/R/cpp11.R b/R/cpp11.R new file mode 100644 index 0000000..73c9b6e --- /dev/null +++ b/R/cpp11.R @@ -0,0 +1,253 @@ +# Generated by cpp11: do not edit by hand + +read_connection_ <- function(con_sxp, read_size_sxp) { + .Call(`_xml2_read_connection_`, con_sxp, read_size_sxp) +} + +xml_parse_options_ <- function() { + .Call(`_xml2_xml_parse_options_`) +} + +doc_parse_file <- function(path_sxp, encoding_sxp, as_html_sxp, options_sxp) { + .Call(`_xml2_doc_parse_file`, path_sxp, encoding_sxp, as_html_sxp, options_sxp) +} + +doc_parse_raw <- function(x, encoding_sxp, base_url_sxp, as_html_sxp, options_sxp) { + .Call(`_xml2_doc_parse_raw`, x, encoding_sxp, base_url_sxp, as_html_sxp, options_sxp) +} + +doc_root <- function(x) { + .Call(`_xml2_doc_root`, x) +} + +doc_has_root <- function(x_sxp) { + .Call(`_xml2_doc_has_root`, x_sxp) +} + +doc_url <- function(doc_sxp) { + .Call(`_xml2_doc_url`, doc_sxp) +} + +doc_new <- function(version_sxp, encoding_sxp) { + .Call(`_xml2_doc_new`, version_sxp, encoding_sxp) +} + +doc_set_root <- function(doc_sxp, root_sxp) { + .Call(`_xml2_doc_set_root`, doc_sxp, root_sxp) +} + +doc_is_html <- function(doc_sxp) { + .Call(`_xml2_doc_is_html`, doc_sxp) +} + +init_libxml2 <- function() { + .Call(`_xml2_init_libxml2`) +} + +libxml2_version_ <- function() { + .Call(`_xml2_libxml2_version_`) +} + +unique_ns <- function(ns) { + .Call(`_xml2_unique_ns`, ns) +} + +doc_namespaces <- function(doc_sxp) { + .Call(`_xml2_doc_namespaces`, doc_sxp) +} + +ns_lookup_uri <- function(doc_sxp, node_sxp, uri_sxp) { + .Call(`_xml2_ns_lookup_uri`, doc_sxp, node_sxp, uri_sxp) +} + +ns_lookup <- function(doc_sxp, node_sxp, prefix_sxp) { + .Call(`_xml2_ns_lookup`, doc_sxp, node_sxp, prefix_sxp) +} + +node_name <- function(x, nsMap) { + .Call(`_xml2_node_name`, x, nsMap) +} + +node_set_name <- function(node_sxp, value) { + .Call(`_xml2_node_set_name`, node_sxp, value) +} + +node_text <- function(x) { + .Call(`_xml2_node_text`, x) +} + +node_attr <- function(x, name_sxp, missing_sxp, nsMap_sxp) { + .Call(`_xml2_node_attr`, x, name_sxp, missing_sxp, nsMap_sxp) +} + +node_attrs <- function(x, nsMap_sxp) { + .Call(`_xml2_node_attrs`, x, nsMap_sxp) +} + +node_set_attr <- function(node_sxp, name_sxp, value, nsMap) { + .Call(`_xml2_node_set_attr`, node_sxp, name_sxp, value, nsMap) +} + +node_remove_attr <- function(node_sxp, name_sxp, nsMap) { + .Call(`_xml2_node_remove_attr`, node_sxp, name_sxp, nsMap) +} + +node_children <- function(node_sxp, only_node_sxp) { + .Call(`_xml2_node_children`, node_sxp, only_node_sxp) +} + +node_length <- function(x, only_node_sxp) { + .Call(`_xml2_node_length`, x, only_node_sxp) +} + +node_has_children <- function(node_sxp, only_node_sxp) { + .Call(`_xml2_node_has_children`, node_sxp, only_node_sxp) +} + +node_parents <- function(node_sxp) { + .Call(`_xml2_node_parents`, node_sxp) +} + +node_siblings <- function(node_sxp, only_node_sxp) { + .Call(`_xml2_node_siblings`, node_sxp, only_node_sxp) +} + +node_parent <- function(node_sxp) { + .Call(`_xml2_node_parent`, node_sxp) +} + +node_path <- function(x) { + .Call(`_xml2_node_path`, x) +} + +nodes_duplicated <- function(nodes) { + .Call(`_xml2_nodes_duplicated`, nodes) +} + +node_type <- function(x) { + .Call(`_xml2_node_type`, x) +} + +node_copy <- function(node_sxp) { + .Call(`_xml2_node_copy`, node_sxp) +} + +node_set_content <- function(node_sxp, content) { + .Call(`_xml2_node_set_content`, node_sxp, content) +} + +node_append_content <- function(node_sxp, content) { + .Call(`_xml2_node_append_content`, node_sxp, content) +} + +node_new_text <- function(node_sxp, content) { + .Call(`_xml2_node_new_text`, node_sxp, content) +} + +node_append_child <- function(parent_sxp, cur_sxp) { + .Call(`_xml2_node_append_child`, parent_sxp, cur_sxp) +} + +node_prepend_child <- function(parent_sxp, cur_sxp) { + .Call(`_xml2_node_prepend_child`, parent_sxp, cur_sxp) +} + +node_prepend_sibling <- function(cur_sxp, elem_sxp) { + .Call(`_xml2_node_prepend_sibling`, cur_sxp, elem_sxp) +} + +node_append_sibling <- function(cur_sxp, elem_sxp) { + .Call(`_xml2_node_append_sibling`, cur_sxp, elem_sxp) +} + +node_replace <- function(old_sxp, cur_sxp) { + .Call(`_xml2_node_replace`, old_sxp, cur_sxp) +} + +node_remove <- function(node_sxp, free_sxp) { + .Call(`_xml2_node_remove`, node_sxp, free_sxp) +} + +node_new <- function(name) { + .Call(`_xml2_node_new`, name) +} + +node_cdata_new <- function(doc_sxp, content_sxp) { + .Call(`_xml2_node_cdata_new`, doc_sxp, content_sxp) +} + +node_comment_new <- function(content) { + .Call(`_xml2_node_comment_new`, content) +} + +node_new_ns <- function(name, ns_sxp) { + .Call(`_xml2_node_new_ns`, name, ns_sxp) +} + +node_set_namespace_uri <- function(doc_sxp, node_sxp, uri) { + .Call(`_xml2_node_set_namespace_uri`, doc_sxp, node_sxp, uri) +} + +node_set_namespace_prefix <- function(doc_sxp, node_sxp, prefix_sxp) { + .Call(`_xml2_node_set_namespace_prefix`, doc_sxp, node_sxp, prefix_sxp) +} + +node_new_dtd <- function(doc_sxp, name_sxp, eid_sxp, sid_sxp) { + .Call(`_xml2_node_new_dtd`, doc_sxp, name_sxp, eid_sxp, sid_sxp) +} + +xml_save_options_ <- function() { + .Call(`_xml2_xml_save_options_`) +} + +doc_write_file <- function(doc_sxp, path_sxp, encoding_sxp, options_sxp) { + .Call(`_xml2_doc_write_file`, doc_sxp, path_sxp, encoding_sxp, options_sxp) +} + +doc_write_connection <- function(doc_sxp, connection, encoding_sxp, options_sxp) { + .Call(`_xml2_doc_write_connection`, doc_sxp, connection, encoding_sxp, options_sxp) +} + +doc_write_character <- function(doc_sxp, encoding_sxp, options_sxp) { + .Call(`_xml2_doc_write_character`, doc_sxp, encoding_sxp, options_sxp) +} + +node_write_file <- function(node_sxp, path_sxp, encoding_sxp, options_sxp) { + .Call(`_xml2_node_write_file`, node_sxp, path_sxp, encoding_sxp, options_sxp) +} + +node_write_connection <- function(node_sxp, connection, encoding_sxp, options_sxp) { + .Call(`_xml2_node_write_connection`, node_sxp, connection, encoding_sxp, options_sxp) +} + +node_write_character <- function(node_sxp, encoding_sxp, options_sxp) { + .Call(`_xml2_node_write_character`, node_sxp, encoding_sxp, options_sxp) +} + +doc_validate <- function(doc_sxp, schema_sxp) { + .Call(`_xml2_doc_validate`, doc_sxp, schema_sxp) +} + +url_absolute_ <- function(x_sxp, base_sxp) { + .Call(`_xml2_url_absolute_`, x_sxp, base_sxp) +} + +url_relative_ <- function(x_sxp, base_sxp) { + .Call(`_xml2_url_relative_`, x_sxp, base_sxp) +} + +url_parse_ <- function(x_sxp) { + .Call(`_xml2_url_parse_`, x_sxp) +} + +url_escape_ <- function(x_sxp, reserved_sxp) { + .Call(`_xml2_url_escape_`, x_sxp, reserved_sxp) +} + +url_unescape_ <- function(x_sxp) { + .Call(`_xml2_url_unescape_`, x_sxp) +} + +xpath_search <- function(node_sxp, doc_sxp, xpath_sxp, nsMap_sxp, num_results_sxp) { + .Call(`_xml2_xpath_search`, node_sxp, doc_sxp, xpath_sxp, nsMap_sxp, num_results_sxp) +} diff --git a/R/init.R b/R/init.R index b137315..39b3157 100644 --- a/R/init.R +++ b/R/init.R @@ -1,15 +1,15 @@ .onLoad <- function(lib, pkg) { - .Call(init_libxml2) + init_libxml2() } libxml2_version <- function() { - as.numeric_version(.Call(libxml2_version_)) + as.numeric_version(libxml2_version_()) } xml_parse_options <- function() { - .Call(xml_parse_options_) + xml_parse_options_() } xml_save_options <- function() { - .Call(xml_save_options_) + xml_save_options_() } diff --git a/R/xml2-package.R b/R/xml2-package.R index d248733..5f48cbd 100644 --- a/R/xml2-package.R +++ b/R/xml2-package.R @@ -3,5 +3,6 @@ ## usethis namespace: start #' @import rlang +#' @useDynLib xml2, .registration = TRUE ## usethis namespace: end NULL diff --git a/R/xml_attr.R b/R/xml_attr.R index 804a378..2f1dca1 100644 --- a/R/xml_attr.R +++ b/R/xml_attr.R @@ -60,7 +60,7 @@ #' xml_attrs(doc) <- c("b:id" = "one", "f:id" = "two", "id" = "three") #' xml_set_attrs(doc, c("b:id" = "one", "f:id" = "two", "id" = "three")) xml_attr <- function(x, attr, ns = character(), default = NA_character_) { - .Call(node_attr, x, attr, as.character(default), ns) + node_attr(x, attr, as.character(default), ns) } #' @export @@ -72,7 +72,7 @@ xml_has_attr <- function(x, attr, ns = character()) { #' @export #' @rdname xml_attr xml_attrs <- function(x, ns = character()) { - .Call(node_attrs, x, nsMap = ns) + node_attrs(x, nsMap_sxp = ns) } #' @param value character vector of new value. @@ -85,10 +85,10 @@ xml_attrs <- function(x, ns = character()) { #' @export `xml_attr<-.xml_node` <- function(x, attr, ns = character(), value) { if (is.null(value)) { - .Call(node_remove_attr, x$node, attr, ns) + node_remove_attr(x$node, attr, ns) } else { value <- as.character(value) - .Call(node_set_attr, x$node, attr, value, ns) + node_set_attr(x$node, attr, value, ns) } x } diff --git a/R/xml_children.R b/R/xml_children.R index dc34ecf..b1412e4 100644 --- a/R/xml_children.R +++ b/R/xml_children.R @@ -38,7 +38,7 @@ #' xml_child(x, 2) #' xml_child(x, "baz") xml_children <- function(x) { - nodeset_apply(x, function(x) .Call(node_children, x, TRUE)) + nodeset_apply(x, function(x) node_children(x, TRUE)) } #' @export @@ -60,19 +60,19 @@ xml_child <- function(x, search = 1, ns = xml_ns(x)) { #' @export #' @rdname xml_children xml_contents <- function(x) { - nodeset_apply(x, function(x) .Call(node_children, x, FALSE)) + nodeset_apply(x, function(x) node_children(x, FALSE)) } #' @export #' @rdname xml_children xml_parents <- function(x) { - nodeset_apply(x, function(x) .Call(node_parents, x)) + nodeset_apply(x, function(x) node_parents(x)) } #' @export #' @rdname xml_children xml_siblings <- function(x) { - nodeset_apply(x, function(x) .Call(node_siblings, x, TRUE)) + nodeset_apply(x, function(x) node_siblings(x, TRUE)) } #' @export @@ -88,19 +88,19 @@ xml_parent.xml_missing <- function(x) { #' @export xml_parent.xml_node <- function(x) { - xml_node(.Call(node_parent, x$node), x$doc) + xml_node(node_parent(x$node), x$doc) } #' @export xml_parent.xml_nodeset <- function(x) { - nodeset_apply(x, function(x) .Call(node_parent, x)) + nodeset_apply(x, function(x) node_parent(x)) } #' @export #' @rdname xml_children xml_length <- function(x, only_elements = TRUE) { - .Call(node_length, x, only_elements) + node_length(x, only_elements) } #' @export @@ -115,7 +115,7 @@ xml_root <- function(x) { return(xml_root(x[[1]])) } } - if (!.Call(doc_has_root, x$doc)) { + if (!doc_has_root(x$doc)) { xml_missing() } else { xml_document(x$doc) diff --git a/R/xml_document.R b/R/xml_document.R index 527524b..f15fc59 100644 --- a/R/xml_document.R +++ b/R/xml_document.R @@ -1,6 +1,6 @@ xml_document <- function(doc) { - if (.Call(doc_has_root, doc)) { - x <- xml_node(.Call(doc_root, doc), doc) + if (doc_has_root(doc)) { + x <- xml_node(doc_root(doc), doc) class(x) <- c("xml_document", class(x)) x } else { @@ -14,7 +14,7 @@ doc_type <- function(x) { if (is.null(x$doc)) { return("xml") } - if (.Call(doc_is_html, x$doc)) { + if (doc_is_html(x$doc)) { "html" } else { "xml" @@ -34,5 +34,5 @@ print.xml_document <- function(x, width = getOption("width"), max_n = 20, ...) { #' @export as.character.xml_document <- function(x, ..., options = "format", encoding = "UTF-8") { options <- parse_options(options, xml_save_options()) - .Call(doc_write_character, x$doc, encoding, options) + doc_write_character(x$doc, encoding, options) } diff --git a/R/xml_find.R b/R/xml_find.R index 4dac21c..84ce7d8 100644 --- a/R/xml_find.R +++ b/R/xml_find.R @@ -85,7 +85,7 @@ xml_find_all.xml_missing <- function(x, xpath, ns = xml_ns(x), ...) { #' @export xml_find_all.xml_node <- function(x, xpath, ns = xml_ns(x), ...) { - nodes <- .Call(xpath_search, x$node, x$doc, xpath, ns, Inf) + nodes <- xpath_search(x$node, x$doc, xpath, ns, Inf) xml_nodeset(nodes) } @@ -98,7 +98,7 @@ xml_find_all.xml_nodeset <- function(x, xpath, ns = xml_ns(x), flatten = TRUE, . return(xml_nodeset()) } - res <- lapply(x, function(x) .Call(xpath_search, x$node, x$doc, xpath, ns, Inf)) + res <- lapply(x, function(x) xpath_search(x$node, x$doc, xpath, ns, Inf)) if (isTRUE(flatten)) { return(xml_nodeset(unlist(recursive = FALSE, res))) @@ -121,7 +121,7 @@ xml_find_first.xml_missing <- function(x, xpath, ns = xml_ns(x)) { #' @export xml_find_first.xml_node <- function(x, xpath, ns = xml_ns(x)) { - res <- .Call(xpath_search, x$node, x$doc, xpath, ns, 1) + res <- xpath_search(x$node, x$doc, xpath, ns, 1) if (length(res) == 1) { res[[1]] } else { @@ -155,7 +155,7 @@ xml_find_num <- function(x, xpath, ns = xml_ns(x)) { #' @export xml_find_num.xml_node <- function(x, xpath, ns = xml_ns(x)) { - res <- .Call(xpath_search, x$node, x$doc, xpath, ns, Inf) + res <- xpath_search(x$node, x$doc, xpath, ns, Inf) if (is.numeric(res) && is.nan(res)) { return(res) } @@ -186,7 +186,7 @@ xml_find_chr <- function(x, xpath, ns = xml_ns(x)) { #' @export xml_find_chr.xml_node <- function(x, xpath, ns = xml_ns(x)) { - res <- .Call(xpath_search, x$node, x$doc, xpath, ns, Inf) + res <- xpath_search(x$node, x$doc, xpath, ns, Inf) check_string(res, arg = I(paste0("Element at path `", xpath, "`"))) res } @@ -213,7 +213,7 @@ xml_find_lgl <- function(x, xpath, ns = xml_ns(x)) { #' @export xml_find_lgl.xml_node <- function(x, xpath, ns = xml_ns(x)) { - res <- .Call(xpath_search, x$node, x$doc, xpath, ns, Inf) + res <- xpath_search(x$node, x$doc, xpath, ns, Inf) check_bool(res, arg = I(paste0("Element at path `", xpath, "`"))) res } diff --git a/R/xml_modify.R b/R/xml_modify.R index 7411f83..fb28346 100644 --- a/R/xml_modify.R +++ b/R/xml_modify.R @@ -29,7 +29,7 @@ xml_replace <- function(.x, .value, ..., .copy = TRUE) { xml_replace.xml_node <- function(.x, .value, ..., .copy = TRUE) { node <- create_node(.value, .parent = .x, .copy = .copy, ...) - .x$node <- .Call(node_replace, .x$node, node$node) + .x$node <- node_replace(.x$node, node$node) node } @@ -65,8 +65,8 @@ xml_add_sibling.xml_node <- function(.x, .value, ..., .where = c("after", "befor node <- create_node(.value, .parent = .x, .copy = .copy, ...) .x$node <- switch(.where, - before = .Call(node_prepend_sibling, .x$node, node$node), - after = .Call(node_append_sibling, .x$node, node$node) + before = node_prepend_sibling(.x$node, node$node), + after = node_append_sibling(.x$node, node$node) ) invisible(.x) @@ -97,21 +97,21 @@ xml_add_sibling.xml_missing <- function(.x, .value, ..., .where = c("after", "be create_node <- function(.value, ..., .parent, .copy) { if (inherits(.value, "xml_node")) { if (isTRUE(.copy)) { - .value$node <- .Call(node_copy, .value$node) + .value$node <- node_copy(.value$node) } return(.value) } if (inherits(.value, "xml_cdata")) { - return(xml_node(.Call(node_cdata_new, .parent$doc, .value), doc = .parent$doc)) + return(xml_node(node_cdata_new(.parent$doc, .value), doc = .parent$doc)) } if (inherits(.value, "xml_comment")) { - return(xml_node(.Call(node_comment_new, .value), doc = .parent$doc)) + return(xml_node(node_comment_new(.value), doc = .parent$doc)) } if (inherits(.value, "xml_dtd")) { - .Call(node_new_dtd, .parent$doc, .value$name, .value$external_id, .value$system_id) + node_new_dtd(.parent$doc, .value$name, .value$external_id, .value$system_id) return() } @@ -119,10 +119,10 @@ create_node <- function(.value, ..., .parent, .copy) { parts <- strsplit(.value, ":")[[1]] if (length(parts) == 2 && !is.null(.parent$node)) { - namespace <- .Call(ns_lookup, .parent$doc, .parent$node, parts[[1]]) - node <- list(node = .Call(node_new_ns, parts[[2]], namespace), doc = .parent$doc) + namespace <- ns_lookup(.parent$doc, .parent$node, parts[[1]]) + node <- list(node = node_new_ns(parts[[2]], namespace), doc = .parent$doc) } else { - node <- list(node = .Call(node_new, .value), doc = .parent$doc) + node <- list(node = node_new(.value), doc = .parent$doc) } class(node) <- "xml_node" @@ -145,17 +145,17 @@ xml_add_child.xml_node <- function(.x, .value, ..., .where = length(xml_children node <- create_node(.value, .parent = .x, .copy = .copy, ...) if (.where == 0L) { - if (.Call(node_has_children, .x$node, TRUE)) { - .Call(node_prepend_child, .x$node, node$node) + if (node_has_children(.x$node, TRUE)) { + node_prepend_child(.x$node, node$node) } else { - .Call(node_append_child, .x$node, node$node) + node_append_child(.x$node, node$node) } } else { num_children <- length(xml_children(.x)) if (.where >= num_children) { - .Call(node_append_child, .x$node, node$node) + node_append_child(.x$node, node$node) } else { - .Call(node_append_sibling, xml_child(.x, search = .where)$node, node$node) + node_append_sibling(xml_child(.x, search = .where)$node, node$node) } } @@ -169,10 +169,10 @@ xml_add_child.xml_document <- function(.x, .value, ..., .where = length(xml_chil } else { node <- create_node(.value, .parent = .x, .copy = .copy, ...) if (!is.null(node)) { - if (!.Call(doc_has_root, .x$doc)) { - .Call(doc_set_root, .x$doc, node$node) + if (!doc_has_root(.x$doc)) { + doc_set_root(.x$doc, node$node) } - .Call(node_append_child, .Call(doc_root, .x$doc), node$node) + node_append_child(doc_root(.x$doc), node$node) } invisible(xml_document(.x$doc)) } @@ -240,7 +240,7 @@ xml_remove <- function(.x, free = FALSE) { #' @export xml_remove.xml_node <- function(.x, free = FALSE) { - .Call(node_remove, .x$node, free) + node_remove(.x$node, free) invisible(.x) } @@ -272,9 +272,9 @@ xml_set_namespace <- function(.x, prefix = "", uri = "") { stopifnot(inherits(.x, "xml_node")) if (nzchar(uri)) { - .Call(node_set_namespace_uri, .x$doc, .x$node, uri) + node_set_namespace_uri(.x$doc, .x$node, uri) } else { - .Call(node_set_namespace_prefix, .x$doc, .x$node, prefix) + node_set_namespace_prefix(.x$doc, .x$node, prefix) } invisible(.x) } @@ -292,7 +292,7 @@ xml_set_namespace <- function(.x, prefix = "", uri = "") { #' @export # TODO: jimhester 2016-12-16 Deprecate this in the future? xml_new_document <- function(version = "1.0", encoding = "UTF-8") { - doc <- .Call(doc_new, version, encoding) + doc <- doc_new(version, encoding) out <- list(doc = doc) class(out) <- "xml_document" out diff --git a/R/xml_name.R b/R/xml_name.R index 812a690..8a0388a 100644 --- a/R/xml_name.R +++ b/R/xml_name.R @@ -18,7 +18,7 @@ #' z <- xml_children(y) #' xml_name(xml_children(y)) xml_name <- function(x, ns = character()) { - .Call(node_name, x, ns) + node_name(x, ns) } #' Modify the (tag) name of an element @@ -32,7 +32,7 @@ xml_name <- function(x, ns = character()) { #' @export `xml_name<-.xml_node` <- function(x, ns = character(), value) { - .Call(node_set_name, x$node, value) + node_set_name(x$node, value) x } diff --git a/R/xml_namespaces.R b/R/xml_namespaces.R index 78c289c..de9b77e 100644 --- a/R/xml_namespaces.R +++ b/R/xml_namespaces.R @@ -48,7 +48,7 @@ xml_ns.xml_document <- function(x) { stopifnot(inherits(x, "xml_document")) doc <- x$doc - x <- .Call(doc_namespaces, doc) + x <- doc_namespaces(doc) # Number default namespaces is_default <- names(x) == "" diff --git a/R/xml_node.R b/R/xml_node.R index aedaad1..91631af 100644 --- a/R/xml_node.R +++ b/R/xml_node.R @@ -13,7 +13,7 @@ xml_node <- function(node = NULL, doc = NULL) { #' @export as.character.xml_node <- function(x, ..., options = "format", encoding = "UTF-8") { options <- parse_options(options, xml_save_options()) - .Call(node_write_character, x$node, encoding, options) + node_write_character(x$node, encoding, options) } #' @export diff --git a/R/xml_nodeset.R b/R/xml_nodeset.R index a65e7d5..1832f10 100644 --- a/R/xml_nodeset.R +++ b/R/xml_nodeset.R @@ -1,6 +1,6 @@ xml_nodeset <- function(nodes = list(), deduplicate = TRUE) { if (isTRUE(deduplicate)) { - nodes <- nodes[!.Call(nodes_duplicated, nodes)] + nodes <- nodes[!nodes_duplicated(nodes)] } class(nodes) <- "xml_nodeset" nodes diff --git a/R/xml_parse.R b/R/xml_parse.R index faa92e0..b2448b5 100644 --- a/R/xml_parse.R +++ b/R/xml_parse.R @@ -117,9 +117,11 @@ read_xml.character <- function(x, base_url = x, options = options ) } else { - doc <- .Call(doc_parse_file, con, - encoding = encoding, as_html = as_html, - options = options + doc <- doc_parse_file( + con, + encoding_sxp = encoding, + as_html_sxp = as_html, + options_sxp = options ) xml_document(doc) } @@ -136,7 +138,7 @@ read_xml.raw <- function(x, options = "NOBLANKS") { options <- parse_options(options, xml_parse_options()) - doc <- .Call(doc_parse_raw, x, encoding, base_url, as_html, options) + doc <- doc_parse_raw(x, encoding, base_url, as_html, options) xml_document(doc) } @@ -157,7 +159,7 @@ read_xml.connection <- function(x, on.exit(close(x)) } - raw <- .Call(read_connection_, x, n) + raw <- read_connection_(x, n) read_xml.raw(raw, encoding = encoding, base_url = base_url, as_html = as_html, options = options diff --git a/R/xml_path.R b/R/xml_path.R index 7e233a5..9432ac1 100644 --- a/R/xml_path.R +++ b/R/xml_path.R @@ -10,5 +10,5 @@ #' x <- read_xml("") #' xml_path(xml_find_all(x, ".//baz")) xml_path <- function(x) { - .Call(node_path, x) + node_path(x) } diff --git a/R/xml_schema.R b/R/xml_schema.R index 75c92a3..84a934f 100644 --- a/R/xml_schema.R +++ b/R/xml_schema.R @@ -17,5 +17,5 @@ xml_validate <- function(x, schema) { #' @export xml_validate.xml_document <- function(x, schema) { stopifnot(inherits(schema, "xml_document")) - .Call(doc_validate, x$doc, schema$doc) + doc_validate(x$doc, schema$doc) } diff --git a/R/xml_text.R b/R/xml_text.R index be2b173..a2904fa 100644 --- a/R/xml_text.R +++ b/R/xml_text.R @@ -22,7 +22,7 @@ #' xml_integer(xml_find_all(x, "//@x")) #' @export xml_text <- function(x, trim = FALSE) { - res <- .Call(node_text, x) + res <- node_text(x) if (isTRUE(trim)) { res <- trim_text(res) } @@ -60,12 +60,12 @@ trim_text <- function(x) { if (xml_type(x) != "text") { text_child <- xml_find_first(x, ".//text()[1]", ns = character()) if (inherits(text_child, "xml_missing")) { - .Call(node_append_content, x$node, value) + node_append_content(x$node, value) } else { - .Call(node_set_content, text_child$node, value) + node_set_content(text_child$node, value) } } else { - .Call(node_set_content, x$node, value) + node_set_content(x$node, value) } x diff --git a/R/xml_type.R b/R/xml_type.R index d5aac52..124613f 100644 --- a/R/xml_type.R +++ b/R/xml_type.R @@ -7,7 +7,7 @@ #' xml_type(x) #' xml_type(xml_contents(x)) xml_type <- function(x) { - types <- .Call(node_type, x) + types <- node_type(x) xmlElementType[types] } diff --git a/R/xml_url.R b/R/xml_url.R index 8ee6cb0..e5c3f96 100644 --- a/R/xml_url.R +++ b/R/xml_url.R @@ -23,12 +23,12 @@ xml_url.xml_missing <- function(x) { #' @export xml_url.xml_node <- function(x) { - .Call(doc_url, x$doc) + doc_url(x$doc) } #' @export xml_url.xml_nodeset <- function(x) { - vapply(x, function(x) .Call(doc_url, x), character(1)) + vapply(x, function(x) doc_url(x), character(1)) } #' Convert between relative and absolute urls. @@ -47,13 +47,13 @@ xml_url.xml_nodeset <- function(x) { #' url_relative("http://hadley.nz/a/c", "http://hadley.nz/a/b/") #' @export url_absolute <- function(x, base) { - .Call(url_absolute_, x, base) + url_absolute_(x, base) } #' @rdname url_absolute #' @export url_relative <- function(x, base) { - .Call(url_relative_, x, base) + url_relative_(x, base) } #' Escape and unescape urls. @@ -68,13 +68,13 @@ url_relative <- function(x, base) { #' url_unescape("a%20b%2fc") #' url_unescape("%C2%B5") url_escape <- function(x, reserved = "") { - .Call(url_escape_, x, reserved) + url_escape_(x, reserved) } #' @rdname url_escape #' @export url_unescape <- function(x) { - .Call(url_unescape_, x) + url_unescape_(x) } #' Parse a url into its component pieces. @@ -89,5 +89,5 @@ url_unescape <- function(x) { #' url_parse("http://had.co.nz:1234/?a=1&b=2") #' url_parse("http://had.co.nz:1234/?a=1&b=2#def") url_parse <- function(x) { - .Call(url_parse_, x) + url_parse_(x) } diff --git a/R/xml_write.R b/R/xml_write.R index 35448f1..39bd9e9 100644 --- a/R/xml_write.R +++ b/R/xml_write.R @@ -44,10 +44,10 @@ write_xml.xml_document <- function(x, file, ..., options = "format", encoding = open(file, "wb") on.exit(close(file)) } - .Call(doc_write_connection, x$doc, file, encoding, options) + doc_write_connection(x$doc, file, encoding, options) } else { check_string(file) - .Call(doc_write_file, x$doc, file, encoding, options) + doc_write_file(x$doc, file, encoding, options) } invisible() @@ -67,10 +67,10 @@ write_xml.xml_nodeset <- function(x, file, ..., options = "format", encoding = " open(file, "wb") on.exit(close(file)) } - .Call(node_write_connection, x[[1]]$node, file, encoding, options) + node_write_connection(x[[1]]$node, file, encoding, options) } else { check_string(file) - .Call(node_write_file, x[[1]]$node, file, encoding, options) + node_write_file(x[[1]]$node, file, encoding, options) } invisible() @@ -86,10 +86,10 @@ write_xml.xml_node <- function(x, file, ..., options = "format", encoding = "UTF open(file, "wb") on.exit(close(file)) } - .Call(node_write_connection, x$node, file, encoding, options) + node_write_connection(x$node, file, encoding, options) } else { check_string(file) - .Call(node_write_file, x$node, file, encoding, options) + node_write_file(x$node, file, encoding, options) } invisible() diff --git a/inst/include/xml2_types.h b/inst/include/xml2_types.h index 8835602..60a0212 100644 --- a/inst/include/xml2_types.h +++ b/inst/include/xml2_types.h @@ -1,6 +1,8 @@ #ifndef __XML2_XML2_TYPES__ #define __XML2_XML2_TYPES__ +#include + #include #define R_NO_REMAP #include @@ -92,4 +94,7 @@ class XPtrDoc : public ::XPtr { typedef ::XPtr XPtrNode; typedef ::XPtr XPtrNs; +using node_pointer = cpp11::external_pointer; +using doc_pointer = cpp11::external_pointer; + #endif diff --git a/src/connection.cpp b/src/connection.cpp index 736ada9..037fc9c 100644 --- a/src/connection.cpp +++ b/src/connection.cpp @@ -1,3 +1,5 @@ +#include + #define R_NO_REMAP #include #undef R_NO_REMAP @@ -6,52 +8,39 @@ #include #include "xml2_utils.h" +using namespace cpp11::literals; // so we can use ""_nm syntax + // Wrapper around R's read_bin function -SEXP read_bin(SEXP con, size_t bytes) { - SEXP e; - SEXP raw_sxp = PROTECT(Rf_mkString("raw")); - SEXP bytes_sxp = PROTECT(Rf_ScalarInteger(bytes)); - PROTECT(e = Rf_lang4(Rf_install("readBin"), con, raw_sxp, bytes_sxp)); - SEXP res = Rf_eval(e, R_GlobalEnv); - UNPROTECT(3); +SEXP read_bin(SEXP con, cpp11::doubles bytes_sxp) { + cpp11::strings raw_sxp({"raw"}); + + auto readBin = cpp11::package("base")["readBin"]; + cpp11::sexp res = readBin("con"_nm = con, "what"_nm = raw_sxp, "n"_nm = bytes_sxp); return res; } // Wrapper around R's write_bin function -SEXP write_bin(SEXP data, SEXP con) { - SEXP e; - PROTECT(e = Rf_lang3(Rf_install("writeBin"), data, con)); - SEXP res = Rf_eval(e, R_GlobalEnv); - UNPROTECT(1); - return res; +cpp11::sexp write_bin(cpp11::sexp data, cpp11::sexp con) { + cpp11::function write_bin = cpp11::package("base")["writeBin"]; + return write_bin(data, con); } // Read data from a connection in chunks and then combine into a single // raw vector. // -// [[export]] -extern "C" SEXP read_connection_(SEXP con_sxp, SEXP read_size_sxp) { - - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp read_connection_(cpp11::sexp con_sxp, cpp11::doubles read_size_sxp) { std::vector buffer; - size_t read_size = REAL(read_size_sxp)[0]; - SEXP chunk = read_bin(con_sxp, read_size); + cpp11::sexp chunk = read_bin(con_sxp, read_size_sxp); R_xlen_t chunk_size = Rf_xlength(chunk); while(chunk_size > 0) { std::copy(RAW(chunk), RAW(chunk) + chunk_size, std::back_inserter(buffer)); - chunk = read_bin(con_sxp, read_size); + chunk = read_bin(con_sxp, read_size_sxp); chunk_size = Rf_xlength(chunk); } - size_t size = buffer.size(); - - SEXP out = PROTECT(Rf_allocVector(RAWSXP, size)); - std::copy(buffer.begin(), buffer.end(), RAW(out)); - - UNPROTECT(1); + cpp11::raws out(buffer); return out; - - END_CPP } diff --git a/src/connection.h b/src/connection.h index 41b400a..43a78c7 100644 --- a/src/connection.h +++ b/src/connection.h @@ -1,5 +1,7 @@ #pragma once +#include + #define R_NO_REMAP #include #undef R_NO_REMAP @@ -7,31 +9,12 @@ #include #include -SEXP read_bin(SEXP con, size_t bytes = 64 * 1024); -SEXP write_bin(SEXP data, SEXP con); - -inline SEXP R_GetConnection(SEXP con) { return con; } - -inline size_t R_ReadConnection(SEXP con, void* buf, size_t n) { - SEXP res = PROTECT(read_bin(con, n)); - - R_xlen_t size = Rf_xlength(res); - - memcpy(buf, RAW(res), size); - - UNPROTECT(1); - - return Rf_xlength(res); -} - -inline size_t R_WriteConnection(SEXP con, void* buf, size_t n) { - SEXP payload = PROTECT(Rf_allocVector(RAWSXP, n)); +cpp11::sexp write_bin(cpp11::sexp data, cpp11::sexp con); +inline size_t R_WriteConnection(cpp11::sexp con, void* buf, size_t n) { + cpp11::writable::raws payload(n); memcpy(RAW(payload), buf, n); - write_bin(payload, con); - UNPROTECT(1); - return n; } diff --git a/src/cpp11.cpp b/src/cpp11.cpp new file mode 100644 index 0000000..d3ea268 --- /dev/null +++ b/src/cpp11.cpp @@ -0,0 +1,523 @@ +// Generated by cpp11: do not edit by hand +// clang-format off + +#include "xml2_types.h" +#include "cpp11/declarations.hpp" +#include + +// connection.cpp +cpp11::sexp read_connection_(cpp11::sexp con_sxp, cpp11::doubles read_size_sxp); +extern "C" SEXP _xml2_read_connection_(SEXP con_sxp, SEXP read_size_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(read_connection_(cpp11::as_cpp>(con_sxp), cpp11::as_cpp>(read_size_sxp))); + END_CPP11 +} +// xml2_doc.cpp +cpp11::sexp xml_parse_options_(); +extern "C" SEXP _xml2_xml_parse_options_() { + BEGIN_CPP11 + return cpp11::as_sexp(xml_parse_options_()); + END_CPP11 +} +// xml2_doc.cpp +cpp11::sexp doc_parse_file(cpp11::strings path_sxp, cpp11::strings encoding_sxp, cpp11::logicals as_html_sxp, cpp11::integers options_sxp); +extern "C" SEXP _xml2_doc_parse_file(SEXP path_sxp, SEXP encoding_sxp, SEXP as_html_sxp, SEXP options_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(doc_parse_file(cpp11::as_cpp>(path_sxp), cpp11::as_cpp>(encoding_sxp), cpp11::as_cpp>(as_html_sxp), cpp11::as_cpp>(options_sxp))); + END_CPP11 +} +// xml2_doc.cpp +cpp11::sexp doc_parse_raw(cpp11::raws x, cpp11::strings encoding_sxp, cpp11::strings base_url_sxp, cpp11::logicals as_html_sxp, cpp11::integers options_sxp); +extern "C" SEXP _xml2_doc_parse_raw(SEXP x, SEXP encoding_sxp, SEXP base_url_sxp, SEXP as_html_sxp, SEXP options_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(doc_parse_raw(cpp11::as_cpp>(x), cpp11::as_cpp>(encoding_sxp), cpp11::as_cpp>(base_url_sxp), cpp11::as_cpp>(as_html_sxp), cpp11::as_cpp>(options_sxp))); + END_CPP11 +} +// xml2_doc.cpp +cpp11::sexp doc_root(cpp11::sexp x); +extern "C" SEXP _xml2_doc_root(SEXP x) { + BEGIN_CPP11 + return cpp11::as_sexp(doc_root(cpp11::as_cpp>(x))); + END_CPP11 +} +// xml2_doc.cpp +cpp11::logicals doc_has_root(cpp11::sexp x_sxp); +extern "C" SEXP _xml2_doc_has_root(SEXP x_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(doc_has_root(cpp11::as_cpp>(x_sxp))); + END_CPP11 +} +// xml2_doc.cpp +cpp11::strings doc_url(cpp11::sexp doc_sxp); +extern "C" SEXP _xml2_doc_url(SEXP doc_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(doc_url(cpp11::as_cpp>(doc_sxp))); + END_CPP11 +} +// xml2_doc.cpp +cpp11::sexp doc_new(cpp11::strings version_sxp, cpp11::strings encoding_sxp); +extern "C" SEXP _xml2_doc_new(SEXP version_sxp, SEXP encoding_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(doc_new(cpp11::as_cpp>(version_sxp), cpp11::as_cpp>(encoding_sxp))); + END_CPP11 +} +// xml2_doc.cpp +cpp11::sexp doc_set_root(cpp11::sexp doc_sxp, cpp11::sexp root_sxp); +extern "C" SEXP _xml2_doc_set_root(SEXP doc_sxp, SEXP root_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(doc_set_root(cpp11::as_cpp>(doc_sxp), cpp11::as_cpp>(root_sxp))); + END_CPP11 +} +// xml2_doc.cpp +cpp11::sexp doc_is_html(cpp11::sexp doc_sxp); +extern "C" SEXP _xml2_doc_is_html(SEXP doc_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(doc_is_html(cpp11::as_cpp>(doc_sxp))); + END_CPP11 +} +// xml2_init.cpp +cpp11::sexp init_libxml2(); +extern "C" SEXP _xml2_init_libxml2() { + BEGIN_CPP11 + return cpp11::as_sexp(init_libxml2()); + END_CPP11 +} +// xml2_init.cpp +cpp11::strings libxml2_version_(); +extern "C" SEXP _xml2_libxml2_version_() { + BEGIN_CPP11 + return cpp11::as_sexp(libxml2_version_()); + END_CPP11 +} +// xml2_namespace.cpp +cpp11::sexp unique_ns(SEXP ns); +extern "C" SEXP _xml2_unique_ns(SEXP ns) { + BEGIN_CPP11 + return cpp11::as_sexp(unique_ns(cpp11::as_cpp>(ns))); + END_CPP11 +} +// xml2_namespace.cpp +cpp11::sexp doc_namespaces(doc_pointer doc_sxp); +extern "C" SEXP _xml2_doc_namespaces(SEXP doc_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(doc_namespaces(cpp11::as_cpp>(doc_sxp))); + END_CPP11 +} +// xml2_namespace.cpp +cpp11::sexp ns_lookup_uri(doc_pointer doc_sxp, node_pointer node_sxp, cpp11::strings uri_sxp); +extern "C" SEXP _xml2_ns_lookup_uri(SEXP doc_sxp, SEXP node_sxp, SEXP uri_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(ns_lookup_uri(cpp11::as_cpp>(doc_sxp), cpp11::as_cpp>(node_sxp), cpp11::as_cpp>(uri_sxp))); + END_CPP11 +} +// xml2_namespace.cpp +cpp11::sexp ns_lookup(doc_pointer doc_sxp, node_pointer node_sxp, cpp11::strings prefix_sxp); +extern "C" SEXP _xml2_ns_lookup(SEXP doc_sxp, SEXP node_sxp, SEXP prefix_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(ns_lookup(cpp11::as_cpp>(doc_sxp), cpp11::as_cpp>(node_sxp), cpp11::as_cpp>(prefix_sxp))); + END_CPP11 +} +// xml2_node.cpp +cpp11::strings node_name(cpp11::list x, cpp11::strings nsMap); +extern "C" SEXP _xml2_node_name(SEXP x, SEXP nsMap) { + BEGIN_CPP11 + return cpp11::as_sexp(node_name(cpp11::as_cpp>(x), cpp11::as_cpp>(nsMap))); + END_CPP11 +} +// xml2_node.cpp +SEXP node_set_name(node_pointer node_sxp, cpp11::strings value); +extern "C" SEXP _xml2_node_set_name(SEXP node_sxp, SEXP value) { + BEGIN_CPP11 + return cpp11::as_sexp(node_set_name(cpp11::as_cpp>(node_sxp), cpp11::as_cpp>(value))); + END_CPP11 +} +// xml2_node.cpp +cpp11::strings node_text(cpp11::list x); +extern "C" SEXP _xml2_node_text(SEXP x) { + BEGIN_CPP11 + return cpp11::as_sexp(node_text(cpp11::as_cpp>(x))); + END_CPP11 +} +// xml2_node.cpp +cpp11::strings node_attr(cpp11::list x, cpp11::strings name_sxp, cpp11::strings missing_sxp, cpp11::strings nsMap_sxp); +extern "C" SEXP _xml2_node_attr(SEXP x, SEXP name_sxp, SEXP missing_sxp, SEXP nsMap_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(node_attr(cpp11::as_cpp>(x), cpp11::as_cpp>(name_sxp), cpp11::as_cpp>(missing_sxp), cpp11::as_cpp>(nsMap_sxp))); + END_CPP11 +} +// xml2_node.cpp +cpp11::sexp node_attrs(cpp11::list x, cpp11::strings nsMap_sxp); +extern "C" SEXP _xml2_node_attrs(SEXP x, SEXP nsMap_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(node_attrs(cpp11::as_cpp>(x), cpp11::as_cpp>(nsMap_sxp))); + END_CPP11 +} +// xml2_node.cpp +cpp11::sexp node_set_attr(node_pointer node_sxp, cpp11::strings name_sxp, cpp11::strings value, cpp11::strings nsMap); +extern "C" SEXP _xml2_node_set_attr(SEXP node_sxp, SEXP name_sxp, SEXP value, SEXP nsMap) { + BEGIN_CPP11 + return cpp11::as_sexp(node_set_attr(cpp11::as_cpp>(node_sxp), cpp11::as_cpp>(name_sxp), cpp11::as_cpp>(value), cpp11::as_cpp>(nsMap))); + END_CPP11 +} +// xml2_node.cpp +cpp11::sexp node_remove_attr(node_pointer node_sxp, cpp11::strings name_sxp, cpp11::strings nsMap); +extern "C" SEXP _xml2_node_remove_attr(SEXP node_sxp, SEXP name_sxp, SEXP nsMap) { + BEGIN_CPP11 + return cpp11::as_sexp(node_remove_attr(cpp11::as_cpp>(node_sxp), cpp11::as_cpp>(name_sxp), cpp11::as_cpp>(nsMap))); + END_CPP11 +} +// xml2_node.cpp +cpp11::list node_children(node_pointer node_sxp, cpp11::logicals only_node_sxp); +extern "C" SEXP _xml2_node_children(SEXP node_sxp, SEXP only_node_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(node_children(cpp11::as_cpp>(node_sxp), cpp11::as_cpp>(only_node_sxp))); + END_CPP11 +} +// xml2_node.cpp +cpp11::integers node_length(cpp11::list x, cpp11::logicals only_node_sxp); +extern "C" SEXP _xml2_node_length(SEXP x, SEXP only_node_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(node_length(cpp11::as_cpp>(x), cpp11::as_cpp>(only_node_sxp))); + END_CPP11 +} +// xml2_node.cpp +cpp11::logicals node_has_children(node_pointer node_sxp, cpp11::logicals only_node_sxp); +extern "C" SEXP _xml2_node_has_children(SEXP node_sxp, SEXP only_node_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(node_has_children(cpp11::as_cpp>(node_sxp), cpp11::as_cpp>(only_node_sxp))); + END_CPP11 +} +// xml2_node.cpp +cpp11::list node_parents(node_pointer node_sxp); +extern "C" SEXP _xml2_node_parents(SEXP node_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(node_parents(cpp11::as_cpp>(node_sxp))); + END_CPP11 +} +// xml2_node.cpp +cpp11::list node_siblings(node_pointer node_sxp, cpp11::logicals only_node_sxp); +extern "C" SEXP _xml2_node_siblings(SEXP node_sxp, SEXP only_node_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(node_siblings(cpp11::as_cpp>(node_sxp), cpp11::as_cpp>(only_node_sxp))); + END_CPP11 +} +// xml2_node.cpp +node_pointer node_parent(node_pointer node_sxp); +extern "C" SEXP _xml2_node_parent(SEXP node_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(node_parent(cpp11::as_cpp>(node_sxp))); + END_CPP11 +} +// xml2_node.cpp +cpp11::strings node_path(cpp11::list x); +extern "C" SEXP _xml2_node_path(SEXP x) { + BEGIN_CPP11 + return cpp11::as_sexp(node_path(cpp11::as_cpp>(x))); + END_CPP11 +} +// xml2_node.cpp +cpp11::logicals nodes_duplicated(cpp11::list nodes); +extern "C" SEXP _xml2_nodes_duplicated(SEXP nodes) { + BEGIN_CPP11 + return cpp11::as_sexp(nodes_duplicated(cpp11::as_cpp>(nodes))); + END_CPP11 +} +// xml2_node.cpp +cpp11::integers node_type(cpp11::list x); +extern "C" SEXP _xml2_node_type(SEXP x) { + BEGIN_CPP11 + return cpp11::as_sexp(node_type(cpp11::as_cpp>(x))); + END_CPP11 +} +// xml2_node.cpp +node_pointer node_copy(node_pointer node_sxp); +extern "C" SEXP _xml2_node_copy(SEXP node_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(node_copy(cpp11::as_cpp>(node_sxp))); + END_CPP11 +} +// xml2_node.cpp +cpp11::sexp node_set_content(node_pointer node_sxp, cpp11::strings content); +extern "C" SEXP _xml2_node_set_content(SEXP node_sxp, SEXP content) { + BEGIN_CPP11 + return cpp11::as_sexp(node_set_content(cpp11::as_cpp>(node_sxp), cpp11::as_cpp>(content))); + END_CPP11 +} +// xml2_node.cpp +cpp11::sexp node_append_content(node_pointer node_sxp, cpp11::strings content); +extern "C" SEXP _xml2_node_append_content(SEXP node_sxp, SEXP content) { + BEGIN_CPP11 + return cpp11::as_sexp(node_append_content(cpp11::as_cpp>(node_sxp), cpp11::as_cpp>(content))); + END_CPP11 +} +// xml2_node.cpp +cpp11::sexp node_new_text(node_pointer node_sxp, cpp11::strings content); +extern "C" SEXP _xml2_node_new_text(SEXP node_sxp, SEXP content) { + BEGIN_CPP11 + return cpp11::as_sexp(node_new_text(cpp11::as_cpp>(node_sxp), cpp11::as_cpp>(content))); + END_CPP11 +} +// xml2_node.cpp +node_pointer node_append_child(node_pointer parent_sxp, node_pointer cur_sxp); +extern "C" SEXP _xml2_node_append_child(SEXP parent_sxp, SEXP cur_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(node_append_child(cpp11::as_cpp>(parent_sxp), cpp11::as_cpp>(cur_sxp))); + END_CPP11 +} +// xml2_node.cpp +node_pointer node_prepend_child(node_pointer parent_sxp, node_pointer cur_sxp); +extern "C" SEXP _xml2_node_prepend_child(SEXP parent_sxp, SEXP cur_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(node_prepend_child(cpp11::as_cpp>(parent_sxp), cpp11::as_cpp>(cur_sxp))); + END_CPP11 +} +// xml2_node.cpp +node_pointer node_prepend_sibling(node_pointer cur_sxp, node_pointer elem_sxp); +extern "C" SEXP _xml2_node_prepend_sibling(SEXP cur_sxp, SEXP elem_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(node_prepend_sibling(cpp11::as_cpp>(cur_sxp), cpp11::as_cpp>(elem_sxp))); + END_CPP11 +} +// xml2_node.cpp +node_pointer node_append_sibling(node_pointer cur_sxp, node_pointer elem_sxp); +extern "C" SEXP _xml2_node_append_sibling(SEXP cur_sxp, SEXP elem_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(node_append_sibling(cpp11::as_cpp>(cur_sxp), cpp11::as_cpp>(elem_sxp))); + END_CPP11 +} +// xml2_node.cpp +node_pointer node_replace(node_pointer old_sxp, node_pointer cur_sxp); +extern "C" SEXP _xml2_node_replace(SEXP old_sxp, SEXP cur_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(node_replace(cpp11::as_cpp>(old_sxp), cpp11::as_cpp>(cur_sxp))); + END_CPP11 +} +// xml2_node.cpp +cpp11::sexp node_remove(node_pointer node_sxp, cpp11::logicals free_sxp); +extern "C" SEXP _xml2_node_remove(SEXP node_sxp, SEXP free_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(node_remove(cpp11::as_cpp>(node_sxp), cpp11::as_cpp>(free_sxp))); + END_CPP11 +} +// xml2_node.cpp +cpp11::sexp node_new(cpp11::strings name); +extern "C" SEXP _xml2_node_new(SEXP name) { + BEGIN_CPP11 + return cpp11::as_sexp(node_new(cpp11::as_cpp>(name))); + END_CPP11 +} +// xml2_node.cpp +cpp11::sexp node_cdata_new(cpp11::sexp doc_sxp, cpp11::strings content_sxp); +extern "C" SEXP _xml2_node_cdata_new(SEXP doc_sxp, SEXP content_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(node_cdata_new(cpp11::as_cpp>(doc_sxp), cpp11::as_cpp>(content_sxp))); + END_CPP11 +} +// xml2_node.cpp +node_pointer node_comment_new(cpp11::strings content); +extern "C" SEXP _xml2_node_comment_new(SEXP content) { + BEGIN_CPP11 + return cpp11::as_sexp(node_comment_new(cpp11::as_cpp>(content))); + END_CPP11 +} +// xml2_node.cpp +node_pointer node_new_ns(cpp11::strings name, cpp11::external_pointer ns_sxp); +extern "C" SEXP _xml2_node_new_ns(SEXP name, SEXP ns_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(node_new_ns(cpp11::as_cpp>(name), cpp11::as_cpp>>(ns_sxp))); + END_CPP11 +} +// xml2_node.cpp +cpp11::sexp node_set_namespace_uri(doc_pointer doc_sxp, node_pointer node_sxp, cpp11::strings uri); +extern "C" SEXP _xml2_node_set_namespace_uri(SEXP doc_sxp, SEXP node_sxp, SEXP uri) { + BEGIN_CPP11 + return cpp11::as_sexp(node_set_namespace_uri(cpp11::as_cpp>(doc_sxp), cpp11::as_cpp>(node_sxp), cpp11::as_cpp>(uri))); + END_CPP11 +} +// xml2_node.cpp +cpp11::sexp node_set_namespace_prefix(doc_pointer doc_sxp, node_pointer node_sxp, cpp11::strings prefix_sxp); +extern "C" SEXP _xml2_node_set_namespace_prefix(SEXP doc_sxp, SEXP node_sxp, SEXP prefix_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(node_set_namespace_prefix(cpp11::as_cpp>(doc_sxp), cpp11::as_cpp>(node_sxp), cpp11::as_cpp>(prefix_sxp))); + END_CPP11 +} +// xml2_node.cpp +cpp11::sexp node_new_dtd(doc_pointer doc_sxp, cpp11::strings name_sxp, cpp11::strings eid_sxp, cpp11::strings sid_sxp); +extern "C" SEXP _xml2_node_new_dtd(SEXP doc_sxp, SEXP name_sxp, SEXP eid_sxp, SEXP sid_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(node_new_dtd(cpp11::as_cpp>(doc_sxp), cpp11::as_cpp>(name_sxp), cpp11::as_cpp>(eid_sxp), cpp11::as_cpp>(sid_sxp))); + END_CPP11 +} +// xml2_output.cpp +cpp11::writable::integers xml_save_options_(); +extern "C" SEXP _xml2_xml_save_options_() { + BEGIN_CPP11 + return cpp11::as_sexp(xml_save_options_()); + END_CPP11 +} +// xml2_output.cpp +cpp11::sexp doc_write_file(cpp11::sexp doc_sxp, cpp11::strings path_sxp, cpp11::strings encoding_sxp, cpp11::integers options_sxp); +extern "C" SEXP _xml2_doc_write_file(SEXP doc_sxp, SEXP path_sxp, SEXP encoding_sxp, SEXP options_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(doc_write_file(cpp11::as_cpp>(doc_sxp), cpp11::as_cpp>(path_sxp), cpp11::as_cpp>(encoding_sxp), cpp11::as_cpp>(options_sxp))); + END_CPP11 +} +// xml2_output.cpp +cpp11::sexp doc_write_connection(cpp11::sexp doc_sxp, cpp11::sexp connection, cpp11::strings encoding_sxp, cpp11::integers options_sxp); +extern "C" SEXP _xml2_doc_write_connection(SEXP doc_sxp, SEXP connection, SEXP encoding_sxp, SEXP options_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(doc_write_connection(cpp11::as_cpp>(doc_sxp), cpp11::as_cpp>(connection), cpp11::as_cpp>(encoding_sxp), cpp11::as_cpp>(options_sxp))); + END_CPP11 +} +// xml2_output.cpp +cpp11::writable::strings doc_write_character(cpp11::sexp doc_sxp, cpp11::strings encoding_sxp, cpp11::integers options_sxp); +extern "C" SEXP _xml2_doc_write_character(SEXP doc_sxp, SEXP encoding_sxp, SEXP options_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(doc_write_character(cpp11::as_cpp>(doc_sxp), cpp11::as_cpp>(encoding_sxp), cpp11::as_cpp>(options_sxp))); + END_CPP11 +} +// xml2_output.cpp +cpp11::sexp node_write_file(cpp11::sexp node_sxp, cpp11::strings path_sxp, cpp11::strings encoding_sxp, cpp11::integers options_sxp); +extern "C" SEXP _xml2_node_write_file(SEXP node_sxp, SEXP path_sxp, SEXP encoding_sxp, SEXP options_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(node_write_file(cpp11::as_cpp>(node_sxp), cpp11::as_cpp>(path_sxp), cpp11::as_cpp>(encoding_sxp), cpp11::as_cpp>(options_sxp))); + END_CPP11 +} +// xml2_output.cpp +cpp11::sexp node_write_connection(cpp11::sexp node_sxp, cpp11::sexp connection, cpp11::strings encoding_sxp, cpp11::integers options_sxp); +extern "C" SEXP _xml2_node_write_connection(SEXP node_sxp, SEXP connection, SEXP encoding_sxp, SEXP options_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(node_write_connection(cpp11::as_cpp>(node_sxp), cpp11::as_cpp>(connection), cpp11::as_cpp>(encoding_sxp), cpp11::as_cpp>(options_sxp))); + END_CPP11 +} +// xml2_output.cpp +cpp11::writable::strings node_write_character(cpp11::sexp node_sxp, cpp11::strings encoding_sxp, cpp11::integers options_sxp); +extern "C" SEXP _xml2_node_write_character(SEXP node_sxp, SEXP encoding_sxp, SEXP options_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(node_write_character(cpp11::as_cpp>(node_sxp), cpp11::as_cpp>(encoding_sxp), cpp11::as_cpp>(options_sxp))); + END_CPP11 +} +// xml2_schema.cpp +cpp11::logicals doc_validate(doc_pointer doc_sxp, doc_pointer schema_sxp); +extern "C" SEXP _xml2_doc_validate(SEXP doc_sxp, SEXP schema_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(doc_validate(cpp11::as_cpp>(doc_sxp), cpp11::as_cpp>(schema_sxp))); + END_CPP11 +} +// xml2_url.cpp +cpp11::strings url_absolute_(cpp11::strings x_sxp, cpp11::strings base_sxp); +extern "C" SEXP _xml2_url_absolute_(SEXP x_sxp, SEXP base_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(url_absolute_(cpp11::as_cpp>(x_sxp), cpp11::as_cpp>(base_sxp))); + END_CPP11 +} +// xml2_url.cpp +cpp11::strings url_relative_(cpp11::strings x_sxp, cpp11::strings base_sxp); +extern "C" SEXP _xml2_url_relative_(SEXP x_sxp, SEXP base_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(url_relative_(cpp11::as_cpp>(x_sxp), cpp11::as_cpp>(base_sxp))); + END_CPP11 +} +// xml2_url.cpp +cpp11::data_frame url_parse_(cpp11::strings x_sxp); +extern "C" SEXP _xml2_url_parse_(SEXP x_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(url_parse_(cpp11::as_cpp>(x_sxp))); + END_CPP11 +} +// xml2_url.cpp +cpp11::strings url_escape_(cpp11::strings x_sxp, cpp11::strings reserved_sxp); +extern "C" SEXP _xml2_url_escape_(SEXP x_sxp, SEXP reserved_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(url_escape_(cpp11::as_cpp>(x_sxp), cpp11::as_cpp>(reserved_sxp))); + END_CPP11 +} +// xml2_url.cpp +cpp11::strings url_unescape_(cpp11::strings x_sxp); +extern "C" SEXP _xml2_url_unescape_(SEXP x_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(url_unescape_(cpp11::as_cpp>(x_sxp))); + END_CPP11 +} +// xml2_xpath.cpp +cpp11::sexp xpath_search(node_pointer node_sxp, doc_pointer doc_sxp, cpp11::sexp xpath_sxp, cpp11::strings nsMap_sxp, cpp11::doubles num_results_sxp); +extern "C" SEXP _xml2_xpath_search(SEXP node_sxp, SEXP doc_sxp, SEXP xpath_sxp, SEXP nsMap_sxp, SEXP num_results_sxp) { + BEGIN_CPP11 + return cpp11::as_sexp(xpath_search(cpp11::as_cpp>(node_sxp), cpp11::as_cpp>(doc_sxp), cpp11::as_cpp>(xpath_sxp), cpp11::as_cpp>(nsMap_sxp), cpp11::as_cpp>(num_results_sxp))); + END_CPP11 +} + +extern "C" { +static const R_CallMethodDef CallEntries[] = { + {"_xml2_doc_has_root", (DL_FUNC) &_xml2_doc_has_root, 1}, + {"_xml2_doc_is_html", (DL_FUNC) &_xml2_doc_is_html, 1}, + {"_xml2_doc_namespaces", (DL_FUNC) &_xml2_doc_namespaces, 1}, + {"_xml2_doc_new", (DL_FUNC) &_xml2_doc_new, 2}, + {"_xml2_doc_parse_file", (DL_FUNC) &_xml2_doc_parse_file, 4}, + {"_xml2_doc_parse_raw", (DL_FUNC) &_xml2_doc_parse_raw, 5}, + {"_xml2_doc_root", (DL_FUNC) &_xml2_doc_root, 1}, + {"_xml2_doc_set_root", (DL_FUNC) &_xml2_doc_set_root, 2}, + {"_xml2_doc_url", (DL_FUNC) &_xml2_doc_url, 1}, + {"_xml2_doc_validate", (DL_FUNC) &_xml2_doc_validate, 2}, + {"_xml2_doc_write_character", (DL_FUNC) &_xml2_doc_write_character, 3}, + {"_xml2_doc_write_connection", (DL_FUNC) &_xml2_doc_write_connection, 4}, + {"_xml2_doc_write_file", (DL_FUNC) &_xml2_doc_write_file, 4}, + {"_xml2_init_libxml2", (DL_FUNC) &_xml2_init_libxml2, 0}, + {"_xml2_libxml2_version_", (DL_FUNC) &_xml2_libxml2_version_, 0}, + {"_xml2_node_append_child", (DL_FUNC) &_xml2_node_append_child, 2}, + {"_xml2_node_append_content", (DL_FUNC) &_xml2_node_append_content, 2}, + {"_xml2_node_append_sibling", (DL_FUNC) &_xml2_node_append_sibling, 2}, + {"_xml2_node_attr", (DL_FUNC) &_xml2_node_attr, 4}, + {"_xml2_node_attrs", (DL_FUNC) &_xml2_node_attrs, 2}, + {"_xml2_node_cdata_new", (DL_FUNC) &_xml2_node_cdata_new, 2}, + {"_xml2_node_children", (DL_FUNC) &_xml2_node_children, 2}, + {"_xml2_node_comment_new", (DL_FUNC) &_xml2_node_comment_new, 1}, + {"_xml2_node_copy", (DL_FUNC) &_xml2_node_copy, 1}, + {"_xml2_node_has_children", (DL_FUNC) &_xml2_node_has_children, 2}, + {"_xml2_node_length", (DL_FUNC) &_xml2_node_length, 2}, + {"_xml2_node_name", (DL_FUNC) &_xml2_node_name, 2}, + {"_xml2_node_new", (DL_FUNC) &_xml2_node_new, 1}, + {"_xml2_node_new_dtd", (DL_FUNC) &_xml2_node_new_dtd, 4}, + {"_xml2_node_new_ns", (DL_FUNC) &_xml2_node_new_ns, 2}, + {"_xml2_node_new_text", (DL_FUNC) &_xml2_node_new_text, 2}, + {"_xml2_node_parent", (DL_FUNC) &_xml2_node_parent, 1}, + {"_xml2_node_parents", (DL_FUNC) &_xml2_node_parents, 1}, + {"_xml2_node_path", (DL_FUNC) &_xml2_node_path, 1}, + {"_xml2_node_prepend_child", (DL_FUNC) &_xml2_node_prepend_child, 2}, + {"_xml2_node_prepend_sibling", (DL_FUNC) &_xml2_node_prepend_sibling, 2}, + {"_xml2_node_remove", (DL_FUNC) &_xml2_node_remove, 2}, + {"_xml2_node_remove_attr", (DL_FUNC) &_xml2_node_remove_attr, 3}, + {"_xml2_node_replace", (DL_FUNC) &_xml2_node_replace, 2}, + {"_xml2_node_set_attr", (DL_FUNC) &_xml2_node_set_attr, 4}, + {"_xml2_node_set_content", (DL_FUNC) &_xml2_node_set_content, 2}, + {"_xml2_node_set_name", (DL_FUNC) &_xml2_node_set_name, 2}, + {"_xml2_node_set_namespace_prefix", (DL_FUNC) &_xml2_node_set_namespace_prefix, 3}, + {"_xml2_node_set_namespace_uri", (DL_FUNC) &_xml2_node_set_namespace_uri, 3}, + {"_xml2_node_siblings", (DL_FUNC) &_xml2_node_siblings, 2}, + {"_xml2_node_text", (DL_FUNC) &_xml2_node_text, 1}, + {"_xml2_node_type", (DL_FUNC) &_xml2_node_type, 1}, + {"_xml2_node_write_character", (DL_FUNC) &_xml2_node_write_character, 3}, + {"_xml2_node_write_connection", (DL_FUNC) &_xml2_node_write_connection, 4}, + {"_xml2_node_write_file", (DL_FUNC) &_xml2_node_write_file, 4}, + {"_xml2_nodes_duplicated", (DL_FUNC) &_xml2_nodes_duplicated, 1}, + {"_xml2_ns_lookup", (DL_FUNC) &_xml2_ns_lookup, 3}, + {"_xml2_ns_lookup_uri", (DL_FUNC) &_xml2_ns_lookup_uri, 3}, + {"_xml2_read_connection_", (DL_FUNC) &_xml2_read_connection_, 2}, + {"_xml2_unique_ns", (DL_FUNC) &_xml2_unique_ns, 1}, + {"_xml2_url_absolute_", (DL_FUNC) &_xml2_url_absolute_, 2}, + {"_xml2_url_escape_", (DL_FUNC) &_xml2_url_escape_, 2}, + {"_xml2_url_parse_", (DL_FUNC) &_xml2_url_parse_, 1}, + {"_xml2_url_relative_", (DL_FUNC) &_xml2_url_relative_, 2}, + {"_xml2_url_unescape_", (DL_FUNC) &_xml2_url_unescape_, 1}, + {"_xml2_xml_parse_options_", (DL_FUNC) &_xml2_xml_parse_options_, 0}, + {"_xml2_xml_save_options_", (DL_FUNC) &_xml2_xml_save_options_, 0}, + {"_xml2_xpath_search", (DL_FUNC) &_xml2_xpath_search, 5}, + {NULL, NULL, 0} +}; +} + +extern "C" attribute_visible void R_init_xml2(DllInfo* dll){ + R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); + R_useDynamicSymbols(dll, FALSE); + R_forceSymbols(dll, TRUE); +} diff --git a/src/init.c b/src/init.c deleted file mode 100644 index 6b3f078..0000000 --- a/src/init.c +++ /dev/null @@ -1,148 +0,0 @@ -#define R_NO_REMAP -#include -#undef R_NO_REMAP - -#include // for NULL -#include - -/* FIXME: - Check these declarations against the C/Fortran source code. -*/ - -/* .Call calls */ -extern SEXP doc_has_root(SEXP); -extern SEXP doc_is_html(SEXP); -extern SEXP doc_namespaces(SEXP); -extern SEXP doc_new(SEXP, SEXP); -extern SEXP doc_parse_file(SEXP, SEXP, SEXP, SEXP); -extern SEXP doc_parse_raw(SEXP, SEXP, SEXP, SEXP, SEXP); -extern SEXP doc_root(SEXP); -extern SEXP doc_set_root(SEXP, SEXP); -extern SEXP doc_url(SEXP); -extern SEXP doc_validate(SEXP, SEXP); -extern SEXP doc_write_character(SEXP, SEXP, SEXP); -extern SEXP doc_write_connection(SEXP, SEXP, SEXP, SEXP); -extern SEXP doc_write_file(SEXP, SEXP, SEXP, SEXP); -extern SEXP init_libxml2(void); -extern SEXP libxml2_version_(void); -extern SEXP node_append_child(SEXP, SEXP); -extern SEXP node_append_content(SEXP, SEXP); -extern SEXP node_append_sibling(SEXP, SEXP); -extern SEXP node_attr(SEXP, SEXP, SEXP, SEXP); -extern SEXP node_attrs(SEXP, SEXP); -extern SEXP node_cdata_new(SEXP, SEXP); -extern SEXP node_children(SEXP, SEXP); -extern SEXP node_comment_new(SEXP); -extern SEXP node_copy(SEXP); -extern SEXP node_has_children(SEXP, SEXP); -extern SEXP node_length(SEXP, SEXP); -extern SEXP node_name(SEXP, SEXP); -extern SEXP node_new(SEXP); -extern SEXP node_new_dtd(SEXP, SEXP, SEXP, SEXP); -extern SEXP node_new_ns(SEXP, SEXP); -extern SEXP node_new_text(SEXP, SEXP); -extern SEXP node_parent(SEXP); -extern SEXP node_parents(SEXP); -extern SEXP node_path(SEXP); -extern SEXP node_prepend_child(SEXP, SEXP); -extern SEXP node_prepend_sibling(SEXP, SEXP); -extern SEXP node_remove(SEXP, SEXP); -extern SEXP node_remove_attr(SEXP, SEXP, SEXP); -extern SEXP node_replace(SEXP, SEXP); -extern SEXP node_set_attr(SEXP, SEXP, SEXP, SEXP); -extern SEXP node_set_content(SEXP, SEXP); -extern SEXP node_set_name(SEXP, SEXP); -extern SEXP node_set_namespace_prefix(SEXP, SEXP, SEXP); -extern SEXP node_set_namespace_uri(SEXP, SEXP, SEXP); -extern SEXP node_siblings(SEXP, SEXP); -extern SEXP node_text(SEXP); -extern SEXP node_type(SEXP); -extern SEXP node_write_character(SEXP, SEXP, SEXP); -extern SEXP node_write_connection(SEXP, SEXP, SEXP, SEXP); -extern SEXP node_write_file(SEXP, SEXP, SEXP, SEXP); -extern SEXP nodes_duplicated(SEXP); -extern SEXP ns_lookup(SEXP, SEXP, SEXP); -extern SEXP ns_lookup_uri(SEXP, SEXP, SEXP); -extern SEXP read_connection_(SEXP, SEXP); -extern SEXP unique_ns(SEXP); -extern SEXP url_absolute_(SEXP, SEXP); -extern SEXP url_escape_(SEXP, SEXP); -extern SEXP url_parse_(SEXP); -extern SEXP url_relative_(SEXP, SEXP); -extern SEXP url_unescape_(SEXP); -extern SEXP xml_parse_options_(void); -extern SEXP xml_save_options_(void); -extern SEXP xpath_search(SEXP, SEXP, SEXP, SEXP, SEXP); - -static const R_CallMethodDef CallEntries[] = { - {"doc_has_root", (DL_FUNC) &doc_has_root, 1}, - {"doc_is_html", (DL_FUNC) &doc_is_html, 1}, - {"doc_namespaces", (DL_FUNC) &doc_namespaces, 1}, - {"doc_new", (DL_FUNC) &doc_new, 2}, - {"doc_parse_file", (DL_FUNC) &doc_parse_file, 4}, - {"doc_parse_raw", (DL_FUNC) &doc_parse_raw, 5}, - {"doc_root", (DL_FUNC) &doc_root, 1}, - {"doc_set_root", (DL_FUNC) &doc_set_root, 2}, - {"doc_url", (DL_FUNC) &doc_url, 1}, - {"doc_validate", (DL_FUNC) &doc_validate, 2}, - {"doc_write_character", (DL_FUNC) &doc_write_character, 3}, - {"doc_write_connection", (DL_FUNC) &doc_write_connection, 4}, - {"doc_write_file", (DL_FUNC) &doc_write_file, 4}, - {"init_libxml2", (DL_FUNC) &init_libxml2, 0}, - {"libxml2_version_", (DL_FUNC) &libxml2_version_, 0}, - {"node_append_child", (DL_FUNC) &node_append_child, 2}, - {"node_append_content", (DL_FUNC) &node_append_content, 2}, - {"node_append_sibling", (DL_FUNC) &node_append_sibling, 2}, - {"node_attr", (DL_FUNC) &node_attr, 4}, - {"node_attrs", (DL_FUNC) &node_attrs, 2}, - {"node_cdata_new", (DL_FUNC) &node_cdata_new, 2}, - {"node_children", (DL_FUNC) &node_children, 2}, - {"node_comment_new", (DL_FUNC) &node_comment_new, 1}, - {"node_copy", (DL_FUNC) &node_copy, 1}, - {"node_has_children", (DL_FUNC) &node_has_children, 2}, - {"node_length", (DL_FUNC) &node_length, 2}, - {"node_name", (DL_FUNC) &node_name, 2}, - {"node_new", (DL_FUNC) &node_new, 1}, - {"node_new_dtd", (DL_FUNC) &node_new_dtd, 4}, - {"node_new_ns", (DL_FUNC) &node_new_ns, 2}, - {"node_new_text", (DL_FUNC) &node_new_text, 2}, - {"node_parent", (DL_FUNC) &node_parent, 1}, - {"node_parents", (DL_FUNC) &node_parents, 1}, - {"node_path", (DL_FUNC) &node_path, 1}, - {"node_prepend_child", (DL_FUNC) &node_prepend_child, 2}, - {"node_prepend_sibling", (DL_FUNC) &node_prepend_sibling, 2}, - {"node_remove", (DL_FUNC) &node_remove, 2}, - {"node_remove_attr", (DL_FUNC) &node_remove_attr, 3}, - {"node_replace", (DL_FUNC) &node_replace, 2}, - {"node_set_attr", (DL_FUNC) &node_set_attr, 4}, - {"node_set_content", (DL_FUNC) &node_set_content, 2}, - {"node_set_name", (DL_FUNC) &node_set_name, 2}, - {"node_set_namespace_prefix", (DL_FUNC) &node_set_namespace_prefix, 3}, - {"node_set_namespace_uri", (DL_FUNC) &node_set_namespace_uri, 3}, - {"node_siblings", (DL_FUNC) &node_siblings, 2}, - {"node_text", (DL_FUNC) &node_text, 1}, - {"node_type", (DL_FUNC) &node_type, 1}, - {"node_write_character", (DL_FUNC) &node_write_character, 3}, - {"node_write_connection", (DL_FUNC) &node_write_connection, 4}, - {"node_write_file", (DL_FUNC) &node_write_file, 4}, - {"nodes_duplicated", (DL_FUNC) &nodes_duplicated, 1}, - {"ns_lookup", (DL_FUNC) &ns_lookup, 3}, - {"ns_lookup_uri", (DL_FUNC) &ns_lookup_uri, 3}, - {"read_connection_", (DL_FUNC) &read_connection_, 2}, - {"unique_ns", (DL_FUNC) &unique_ns, 1}, - {"url_absolute_", (DL_FUNC) &url_absolute_, 2}, - {"url_escape_", (DL_FUNC) &url_escape_, 2}, - {"url_parse_", (DL_FUNC) &url_parse_, 1}, - {"url_relative_", (DL_FUNC) &url_relative_, 2}, - {"url_unescape_", (DL_FUNC) &url_unescape_, 1}, - {"xml_parse_options_", (DL_FUNC) &xml_parse_options_, 0}, - {"xml_save_options_", (DL_FUNC) &xml_save_options_, 0}, - {"xpath_search", (DL_FUNC) &xpath_search, 5}, - {NULL, NULL, 0} -}; - -void R_init_xml2(DllInfo *dll) -{ - R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); - R_useDynamicSymbols(dll, FALSE); -} diff --git a/src/xml2_doc.cpp b/src/xml2_doc.cpp index 5ff748d..7a911a0 100644 --- a/src/xml2_doc.cpp +++ b/src/xml2_doc.cpp @@ -1,3 +1,5 @@ +#include + #define R_NO_REMAP #include #undef R_NO_REMAP @@ -7,9 +9,10 @@ #include "xml2_types.h" #include "xml2_utils.h" #include +#include -// [[export]] -extern "C" SEXP xml_parse_options_() { +[[cpp11::register]] +cpp11::sexp xml_parse_options_() { #if defined(LIBXML_VERSION) && (LIBXML_VERSION >= 20700) #define HAS_OLD10 @@ -40,7 +43,7 @@ extern "C" SEXP xml_parse_options_() { #define HAS_BIG_LINES #endif - const char * names[] = { + std::vector names = { "RECOVER", "NOENT", "DTDLOAD", @@ -78,7 +81,7 @@ extern "C" SEXP xml_parse_options_() { #endif }; - const int values[] = { + std::vector values = { XML_PARSE_RECOVER, XML_PARSE_NOENT, XML_PARSE_DTDLOAD, @@ -116,7 +119,7 @@ extern "C" SEXP xml_parse_options_() { #endif }; - const char * descriptions[] = { + std::vector descriptions = { "recover on errors", "substitute entities", "load the external subset", @@ -154,22 +157,10 @@ extern "C" SEXP xml_parse_options_() { #endif }; - size_t size = sizeof(values) / sizeof(values[0]); - - SEXP out_values = PROTECT(Rf_allocVector(INTSXP, size)); - SEXP out_names = PROTECT(Rf_allocVector(STRSXP, size)); - SEXP out_descriptions = PROTECT(Rf_allocVector(STRSXP, size)); - - for (size_t i = 0; i < size; ++i) { - INTEGER(out_values)[i] = values[i]; - SET_STRING_ELT(out_names, i, Rf_mkChar(names[i])); - SET_STRING_ELT(out_descriptions, i, Rf_mkChar(descriptions[i])); - } - - Rf_setAttrib(out_values, R_NamesSymbol, out_names); - Rf_setAttrib(out_values, Rf_install("descriptions"), out_descriptions); + cpp11::writable::integers out_values(values); - UNPROTECT(3); + out_values.names() = names; + out_values.attr("descriptions") = descriptions; return out_values; @@ -181,17 +172,16 @@ extern "C" SEXP xml_parse_options_() { #undef HAS_IGNORE_ENC } -// [[export]] -extern "C" SEXP doc_parse_file( - SEXP path_sxp, - SEXP encoding_sxp, - SEXP as_html_sxp, - SEXP options_sxp) { - - const char* path = CHAR(STRING_ELT(path_sxp, 0)); - const char* encoding = CHAR(STRING_ELT(encoding_sxp, 0)); - bool as_html = LOGICAL(as_html_sxp)[0]; - int options = INTEGER(options_sxp)[0]; +[[cpp11::register]] +cpp11::sexp doc_parse_file( + cpp11::strings path_sxp, + cpp11::strings encoding_sxp, + cpp11::logicals as_html_sxp, + cpp11::integers options_sxp) { + const char* path = cpp11::as_cpp(path_sxp); + const char* encoding = cpp11::as_cpp(encoding_sxp); + bool as_html = cpp11::as_cpp(as_html_sxp); + int options = cpp11::as_cpp(options_sxp); xmlDoc* pDoc; if (as_html) { pDoc = htmlReadFile( @@ -208,31 +198,29 @@ extern "C" SEXP doc_parse_file( } if (pDoc == NULL) { - Rf_error("Failed to parse %s", path); + cpp11::stop("Failed to parse %s", path); } return SEXP(XPtrDoc(pDoc)); } -// [[export]] -extern "C" SEXP doc_parse_raw( - SEXP x, - SEXP encoding_sxp, - SEXP base_url_sxp, - SEXP as_html_sxp, - SEXP options_sxp) { - - BEGIN_CPP - std::string encoding(CHAR(STRING_ELT(encoding_sxp, 0))); - std::string base_url(CHAR(STRING_ELT(base_url_sxp, 0))); - bool as_html = LOGICAL(as_html_sxp)[0]; - int options = INTEGER(options_sxp)[0]; +[[cpp11::register]] +cpp11::sexp doc_parse_raw( + cpp11::raws x, + cpp11::strings encoding_sxp, + cpp11::strings base_url_sxp, + cpp11::logicals as_html_sxp, + cpp11::integers options_sxp) { + std::string encoding = cpp11::r_string(encoding_sxp[0]); + std::string base_url = cpp11::r_string(base_url_sxp[0]); + bool as_html = cpp11::as_cpp(as_html_sxp); + int options = cpp11::as_cpp(options_sxp); xmlDoc* pDoc; if (as_html) { pDoc = htmlReadMemory( (const char *) RAW(x), - Rf_length(x), + x.size(), base_url == "" ? NULL : base_url.c_str(), encoding == "" ? NULL : encoding.c_str(), options @@ -240,7 +228,7 @@ extern "C" SEXP doc_parse_raw( } else { pDoc = xmlReadMemory( (const char *) RAW(x), - Rf_length(x), + x.size(), base_url == "" ? NULL : base_url.c_str(), encoding == "" ? NULL : encoding.c_str(), options @@ -248,75 +236,55 @@ extern "C" SEXP doc_parse_raw( } if (pDoc == NULL) { - Rf_error("Failed to parse text"); + cpp11::stop("Failed to parse text"); } return SEXP(XPtrDoc(pDoc)); - - END_CPP } -// [[export]] -extern "C" SEXP doc_root(SEXP x) { - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp doc_root(cpp11::sexp x) { XPtrDoc doc(x); XPtrNode node(xmlDocGetRootElement(doc.checked_get())); return SEXP(node); - END_CPP } -// [[export]] -extern "C" SEXP doc_has_root(SEXP x_sxp) { - BEGIN_CPP +[[cpp11::register]] +cpp11::logicals doc_has_root(cpp11::sexp x_sxp) { XPtrDoc x(x_sxp); - return Rf_ScalarLogical(xmlDocGetRootElement(x.get()) != NULL); - END_CPP + return cpp11::logicals({xmlDocGetRootElement(x.get()) != NULL}); } -// [[export]] -extern "C" SEXP doc_url(SEXP doc_sxp) { - BEGIN_CPP - +[[cpp11::register]] +cpp11::strings doc_url(cpp11::sexp doc_sxp) { XPtrDoc doc(doc_sxp); if (doc->URL == NULL) { - return Rf_ScalarString(NA_STRING); + return cpp11::writable::strings({NA_STRING}); } - SEXP out = PROTECT(Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(out, 0, Rf_mkCharCE((const char*) doc->URL, CE_UTF8)); - UNPROTECT(1); - - return out; - END_CPP + return cpp11::as_sexp((const char*) doc->URL); } -// [[export]] -extern "C" SEXP doc_new(SEXP version_sxp, SEXP encoding_sxp) { - - const char* encoding = CHAR(STRING_ELT(encoding_sxp, 0)); +[[cpp11::register]] +cpp11::sexp doc_new(cpp11::strings version_sxp, cpp11::strings encoding_sxp) { + const char* encoding = cpp11::as_cpp(encoding_sxp); - BEGIN_CPP XPtrDoc x(xmlNewDoc(asXmlChar(version_sxp))); xmlCharEncodingHandlerPtr p = xmlFindCharEncodingHandler(encoding); x->encoding = xmlStrdup(reinterpret_cast(p->name)); return SEXP(x); - END_CPP } -// [[export]] -extern "C" SEXP doc_set_root(SEXP doc_sxp, SEXP root_sxp) { - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp doc_set_root(cpp11::sexp doc_sxp, cpp11::sexp root_sxp) { XPtrDoc doc(doc_sxp); XPtrNode root(root_sxp); XPtrNode out(xmlDocSetRootElement(doc, root)); return SEXP(out); - END_CPP } -// [[export]] -extern "C" SEXP doc_is_html(SEXP doc_sxp) { - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp doc_is_html(cpp11::sexp doc_sxp) { XPtrDoc doc(doc_sxp); - return Rf_ScalarLogical(doc->properties & XML_DOC_HTML); - END_CPP + return cpp11::logicals({doc->properties & XML_DOC_HTML}); } diff --git a/src/xml2_init.cpp b/src/xml2_init.cpp index b89c64a..bab45a2 100644 --- a/src/xml2_init.cpp +++ b/src/xml2_init.cpp @@ -1,3 +1,5 @@ +#include + #define R_NO_REMAP #include #undef R_NO_REMAP @@ -10,6 +12,14 @@ #include #include "xml2_utils.h" +#define BEGIN_CPP try { + +#define END_CPP \ + } \ + catch (std::exception & e) { \ + Rf_error("C++ exception: %s", e.what()); \ + } + void handleStructuredError(void* userData, xmlError* error) { BEGIN_CPP @@ -37,8 +47,8 @@ void handleGenericError(void *ctx, const char *fmt, ...) Rf_error(buffer); } -// [[export]] -extern "C" SEXP init_libxml2() { +[[cpp11::register]] +cpp11::sexp init_libxml2() { // Check that header and libs are compatible LIBXML_TEST_VERSION @@ -56,7 +66,7 @@ extern "C" { } -// [[export]] -extern "C" SEXP libxml2_version_(){ - return Rf_mkString(LIBXML_DOTTED_VERSION); +[[cpp11::register]] +cpp11::strings libxml2_version_(){ + return cpp11::writable::strings(cpp11::r_string(LIBXML_DOTTED_VERSION)); } diff --git a/src/xml2_namespace.cpp b/src/xml2_namespace.cpp index 0915c08..e5e2d1c 100644 --- a/src/xml2_namespace.cpp +++ b/src/xml2_namespace.cpp @@ -1,3 +1,5 @@ +#include + #define R_NO_REMAP #include #undef R_NO_REMAP @@ -7,11 +9,9 @@ #include "xml2_types.h" #include "xml2_utils.h" -// [[export]] -extern "C" SEXP unique_ns(SEXP ns) { - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp unique_ns(SEXP ns) { return NsMap(ns).out(); - END_CPP } void cache_namespace(xmlNode* node, NsMap* nsMap) { @@ -26,9 +26,8 @@ void cache_namespace(xmlNode* node, NsMap* nsMap) { cache_namespace(cur, nsMap); } -// [[export]] -extern "C" SEXP doc_namespaces(SEXP doc_sxp) { - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp doc_namespaces(doc_pointer doc_sxp) { XPtrDoc doc(doc_sxp); NsMap nsMap; @@ -37,41 +36,36 @@ extern "C" SEXP doc_namespaces(SEXP doc_sxp) { cache_namespace(root, &nsMap); return nsMap.out(); - END_CPP } -// [[export]] -extern "C" SEXP ns_lookup_uri(SEXP doc_sxp, SEXP node_sxp, SEXP uri_sxp) { - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp ns_lookup_uri(doc_pointer doc_sxp, node_pointer node_sxp, cpp11::strings uri_sxp) { XPtrDoc doc(doc_sxp); XPtrNode node(node_sxp); xmlNsPtr ns = xmlSearchNsByHref(doc.checked_get(), node.checked_get(), asXmlChar(uri_sxp)); if (ns == NULL) { - Rf_error("No namespace with URI `%s` found", CHAR(STRING_ELT(uri_sxp, 0))); + cpp11::stop("No namespace with URI `%s` found", cpp11::as_cpp(uri_sxp)); } XPtrNs out(ns); return SEXP(out); - END_CPP } -// [[export]] -extern "C" SEXP ns_lookup(SEXP doc_sxp, SEXP node_sxp, SEXP prefix_sxp) { - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp ns_lookup(doc_pointer doc_sxp, node_pointer node_sxp, cpp11::strings prefix_sxp) { XPtrDoc doc(doc_sxp); XPtrNode node(node_sxp); xmlNsPtr ns = NULL; - if (Rf_xlength(STRING_ELT(prefix_sxp, 0)) == 0) { + if (prefix_sxp[0].size() == 0) { ns = xmlSearchNs(doc.checked_get(), node.checked_get(), NULL); } else { ns = xmlSearchNs(doc.checked_get(), node.checked_get(), asXmlChar(prefix_sxp)); if (ns == NULL) { - Rf_error("No namespace with prefix `%s` found", CHAR(STRING_ELT(prefix_sxp, 0))); + cpp11::stop("No namespace with prefix `%s` found", cpp11::as_cpp(prefix_sxp)); } } XPtrNs out(ns); return SEXP(out); - END_CPP } diff --git a/src/xml2_node.cpp b/src/xml2_node.cpp index 35b35cc..9cea7dd 100644 --- a/src/xml2_node.cpp +++ b/src/xml2_node.cpp @@ -1,3 +1,5 @@ +#include + #define R_NO_REMAP #include #undef R_NO_REMAP @@ -12,13 +14,8 @@ #include "xml2_types.h" #include "xml2_utils.h" -__attribute__ ((noreturn)) -void stop_unexpected_node_type() { - Rf_error("Unexpected node type"); -} - template // for xmlAttr and xmlNode -std::string nodeName(T* node, SEXP nsMap) { +std::string nodeName(T* node, cpp11::strings nsMap) { std::string name = Xml2String(node->name).asStdString(); if (Rf_xlength(nsMap) == 0) { return name; @@ -32,21 +29,19 @@ std::string nodeName(T* node, SEXP nsMap) { return prefix + ":" + name; } -SEXP node_name_impl(SEXP x, SEXP nsMap) { +cpp11::r_string node_name_impl(cpp11::list x, cpp11::strings nsMap) { NodeType type = getNodeType(x); - SEXP out; + cpp11::r_string out; switch(type) { case NodeType::missing: out = NA_STRING; break; case NodeType::node: { - SEXP node_sxp = VECTOR_ELT(x, 0); - XPtrNode node(node_sxp); + XPtrNode node(x[0]); - std::string name = nodeName(node.checked_get(), nsMap); - out = Rf_mkCharLenCE(name.c_str(), name.size(), CE_UTF8); + out = nodeName(node.checked_get(), nsMap); break; } default: stop_unexpected_node_type(); @@ -55,60 +50,51 @@ SEXP node_name_impl(SEXP x, SEXP nsMap) { return out; } -// [[export]] -extern "C" SEXP node_name(SEXP x, SEXP nsMap) { - BEGIN_CPP +[[cpp11::register]] +cpp11::strings node_name(cpp11::list x, cpp11::strings nsMap) { NodeType type = getNodeType(x); switch(type) { case NodeType::missing: case NodeType::node: - return Rf_ScalarString(node_name_impl(x, nsMap)); + // TODO can this be done nicer? + return cpp11::writable::strings(node_name_impl(x, nsMap)); break; case NodeType::nodeset: { - int n = Rf_xlength(x); - - SEXP out = PROTECT(Rf_allocVector(STRSXP, n)); + R_xlen_t n = x.size(); + cpp11::writable::strings out(n); for (int i = 0; i < n; ++i) { - SEXP x_i = VECTOR_ELT(x, i); - SEXP name_i = node_name_impl(x_i, nsMap); - SET_STRING_ELT(out, i, name_i); + out[i] = node_name_impl(x[i], nsMap); } - UNPROTECT(1); return out; }; default: stop_unexpected_node_type(); } - - END_CPP } -// [[export]] -extern "C" SEXP node_set_name(SEXP node_sxp, SEXP value) { - BEGIN_CPP +[[cpp11::register]] +SEXP node_set_name(node_pointer node_sxp, cpp11::strings value) { XPtrNode node(node_sxp); xmlNodeSetName(node, asXmlChar(value)); return R_NilValue; - END_CPP } -SEXP node_text_impl(SEXP x) { +cpp11::r_string node_text_impl(cpp11::list x) { NodeType type = getNodeType(x); - SEXP out; + cpp11::r_string out; switch(type) { case NodeType::missing: out = NA_STRING; break; case NodeType::node: { - SEXP node_sxp = VECTOR_ELT(x, 0); - XPtrNode node(node_sxp); + XPtrNode node(x[0]); out = Xml2String(xmlNodeGetContent(node.checked_get())).asRString(); break; @@ -119,35 +105,29 @@ SEXP node_text_impl(SEXP x) { return out; } -// [[export]] -extern "C" SEXP node_text(SEXP x) { - BEGIN_CPP +[[cpp11::register]] +cpp11::strings node_text(cpp11::list x) { NodeType type = getNodeType(x); switch(type) { case NodeType::missing: case NodeType::node: - return Rf_ScalarString(node_text_impl(x)); + // TODO can this be done nicer? + return cpp11::writable::strings(node_text_impl(x)); break; case NodeType::nodeset: { - int n = Rf_xlength(x); - - SEXP out = PROTECT(Rf_allocVector(STRSXP, n)); + R_xlen_t n = x.size(); + cpp11::writable::strings out(n); for (int i = 0; i < n; ++i) { - SEXP x_i = VECTOR_ELT(x, i); - SEXP name_i = node_text_impl(x_i); - SET_STRING_ELT(out, i, name_i); + out[i] = node_text_impl(x[i]); } - UNPROTECT(1); return out; }; default: stop_unexpected_node_type(); } - - END_CPP } bool hasPrefix(std::string lhs, std::string rhs) { @@ -176,10 +156,10 @@ const xmlChar* xmlNsDefinition(xmlNodePtr node, const xmlChar* lookup) { } -SEXP node_attr_impl(SEXP x, - const std::string& name, - SEXP missingVal, - SEXP nsMap_sxp) { +cpp11::r_string node_attr_impl(cpp11::list x, + const std::string& name, + cpp11::r_string missingVal, + cpp11::strings nsMap_sxp) { NodeType type = getNodeType(x); switch(type) { @@ -187,8 +167,7 @@ SEXP node_attr_impl(SEXP x, return NA_STRING; break; case NodeType::node: { - SEXP node_sxp = VECTOR_ELT(x, 0); - XPtrNode node(node_sxp); + XPtrNode node(x[0]); if (name == "xmlns") { return Xml2String(xmlNsDefinition(node, NULL)).asRString(missingVal); } @@ -226,59 +205,52 @@ SEXP node_attr_impl(SEXP x, } } -// [[export]] -extern "C" SEXP node_attr( - SEXP x, - SEXP name_sxp, - SEXP missing_sxp, - SEXP nsMap_sxp) { - BEGIN_CPP +[[cpp11::register]] +cpp11::strings node_attr( + cpp11::list x, + cpp11::strings name_sxp, + cpp11::strings missing_sxp, + cpp11::strings nsMap_sxp) { NodeType type = getNodeType(x); - std::string name(CHAR(STRING_ELT(name_sxp, 0))); + std::string name(cpp11::as_cpp(name_sxp)); - if (Rf_xlength(missing_sxp) != 1) { - Rf_error("`missing` should be length 1"); + if (missing_sxp.size() != 1) { + cpp11::stop("`missing` should be length 1"); } - SEXP missingVal = STRING_ELT(missing_sxp, 0); + cpp11::r_string missingVal = missing_sxp[0]; switch(type) { case NodeType::missing: case NodeType::node: - return Rf_ScalarString(node_attr_impl(x, name, missingVal, nsMap_sxp)); + return cpp11::writable::strings(node_attr_impl(x, name, missingVal, nsMap_sxp)); break; case NodeType::nodeset: { - int n = Rf_xlength(x); + R_xlen_t n = x.size(); - SEXP out = PROTECT(Rf_allocVector(STRSXP, n)); + cpp11::writable::strings out(n); for (int i = 0; i < n; ++i) { - SEXP x_i = VECTOR_ELT(x, i); - SEXP attr_i = node_attr_impl(x_i, name, missingVal, nsMap_sxp); - SET_STRING_ELT(out, i, attr_i); + out[i] = node_attr_impl(x[i], name, missingVal, nsMap_sxp); } - UNPROTECT(1); return out; }; default: stop_unexpected_node_type(); } - - END_CPP } -SEXP node_attrs_impl(SEXP x, SEXP nsMap_sxp) { +cpp11::strings node_attrs_impl(cpp11::list x, cpp11::strings nsMap_sxp) { NodeType type = getNodeType(x); switch(type) { case NodeType::missing: - return Rf_ScalarString(NA_STRING); + return cpp11::writable::strings({NA_STRING}); break; case NodeType::node: { - SEXP node_sxp = VECTOR_ELT(x, 0); - XPtrNode node_(node_sxp); + XPtrNode node_(x[0]); int n = 0; xmlNodePtr node = node_.checked_get(); @@ -292,52 +264,50 @@ SEXP node_attrs_impl(SEXP x, SEXP nsMap_sxp) { for(xmlNsPtr cur = node->nsDef; cur != NULL; cur = cur->next) n++; - SEXP names = PROTECT(Rf_allocVector(STRSXP, n)); - SEXP values = PROTECT(Rf_allocVector(STRSXP, n)); + cpp11::writable::strings names(n); + cpp11::writable::strings values(n); int i = 0; for(xmlAttr* cur = node->properties; cur != NULL; cur = cur->next, ++i) { std::string name = nodeName(cur, nsMap_sxp); - SET_STRING_ELT(names, i, Rf_mkCharLenCE(name.c_str(), name.size(), CE_UTF8)); + names[i] = name; xmlNs* ns = cur->ns; if (ns == NULL) { - if (Rf_xlength(nsMap_sxp) > 0) { - SET_STRING_ELT(values, i, Xml2String(xmlGetNoNsProp(node, cur->name)).asRString()); + if (nsMap_sxp.size() > 0) { + values[i] = Xml2String(xmlGetNoNsProp(node, cur->name)).asRString(); } else { - SET_STRING_ELT(values, i, Xml2String(xmlGetProp(node, cur->name)).asRString()); + values[i] = Xml2String(xmlGetProp(node, cur->name)).asRString(); } } else { - SET_STRING_ELT(values, i, Xml2String(xmlGetNsProp(node, cur->name, ns->href)).asRString()); + values[i] = Xml2String(xmlGetNsProp(node, cur->name, ns->href)).asRString(); } } for(xmlNsPtr cur = node->nsDef; cur != NULL; cur = cur->next, ++i) { if (cur->prefix == NULL) { - SET_STRING_ELT(names, i, Rf_mkChar("xmlns")); + names[i] = "xmlns"; } else { std::string name = std::string("xmlns:") + Xml2String(cur->prefix).asStdString(); - SET_STRING_ELT(names,i, Rf_mkCharLenCE(name.c_str(), name.size(), CE_UTF8)); + names[i] = name; } - SET_STRING_ELT(values, i, Xml2String(cur->href).asRString()); + values[i] = Xml2String(cur->href).asRString(); } - Rf_setAttrib(values, R_NamesSymbol, names); + values.names() = names; - UNPROTECT(2); return values; } - return Rf_allocVector(STRSXP, 0); + return cpp11::strings(); break; } default: stop_unexpected_node_type(); } } -// [[export]] -extern "C" SEXP node_attrs(SEXP x, SEXP nsMap_sxp) { - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp node_attrs(cpp11::list x, cpp11::strings nsMap_sxp) { NodeType type = getNodeType(x); switch(type) @@ -347,23 +317,18 @@ extern "C" SEXP node_attrs(SEXP x, SEXP nsMap_sxp) { return node_attrs_impl(x, nsMap_sxp); break; case NodeType::nodeset: { - int n = Rf_xlength(x); + R_xlen_t n = x.size(); - SEXP out = PROTECT(Rf_allocVector(VECSXP, n)); + cpp11::writable::list out(n); for (int i = 0; i < n; ++i) { - SEXP x_i = VECTOR_ELT(x, i); - SEXP name_i = node_attrs_impl(x_i, nsMap_sxp); - SET_VECTOR_ELT(out, i, name_i); + out[i] = node_attrs_impl(x[i], nsMap_sxp); } - UNPROTECT(1); return out; }; default: stop_unexpected_node_type(); } - - END_CPP } // Fix the tree by removing the namespace pointers to the given tree @@ -499,11 +464,14 @@ void removeNs(xmlNodePtr node, const xmlChar* prefix) { return; } -// [[export]] -extern "C" SEXP node_set_attr(SEXP node_sxp, SEXP name_sxp, SEXP value, SEXP nsMap) { - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp node_set_attr( + node_pointer node_sxp, + cpp11::strings name_sxp, + cpp11::strings value, + cpp11::strings nsMap) { XPtrNode node_(node_sxp); - std::string name(CHAR(STRING_ELT(name_sxp, 0))); + std::string name(cpp11::as_cpp(name_sxp)); const xmlNodePtr node = node_.checked_get(); @@ -518,7 +486,7 @@ extern "C" SEXP node_set_attr(SEXP node_sxp, SEXP name_sxp, SEXP value, SEXP nsM return R_NilValue; } - if (Rf_xlength(nsMap) == 0) { + if (nsMap.empty()) { xmlSetProp(node, asXmlChar(name), asXmlChar(value)); } else { size_t colon = name.find(':'); @@ -540,14 +508,15 @@ extern "C" SEXP node_set_attr(SEXP node_sxp, SEXP name_sxp, SEXP value, SEXP nsM } return R_NilValue; - END_CPP } -// [[export]] -extern "C" SEXP node_remove_attr(SEXP node_sxp, SEXP name_sxp, SEXP nsMap) { - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp node_remove_attr( + node_pointer node_sxp, + cpp11::strings name_sxp, + cpp11::strings nsMap) { XPtrNode node_(node_sxp); - std::string name(CHAR(STRING_ELT(name_sxp, 0))); + std::string name(cpp11::as_cpp(name_sxp)); const xmlNodePtr node = node_.checked_get(); @@ -561,7 +530,7 @@ extern "C" SEXP node_remove_attr(SEXP node_sxp, SEXP name_sxp, SEXP nsMap) { return R_NilValue; } - if (Rf_xlength(nsMap) == 0) { + if (nsMap.empty()) { xmlUnsetProp(node, asXmlChar(name)); } else { size_t colon = name.find(':'); @@ -583,26 +552,23 @@ extern "C" SEXP node_remove_attr(SEXP node_sxp, SEXP name_sxp, SEXP nsMap) { } return R_NilValue; - END_CPP } -SEXP asList(std::vector nodes) { - SEXP out = PROTECT(Rf_allocVector(VECSXP, nodes.size())); - for (size_t i = 0; i < nodes.size(); ++i) { +cpp11::list asList(std::vector nodes) { + R_xlen_t n = nodes.size(); + cpp11::writable::list out(n); + for (R_xlen_t i = 0; i < n; ++i) { XPtrNode node(nodes[i]); - SET_VECTOR_ELT(out, i, SEXP(node)); + out[i] = SEXP(node); } - UNPROTECT(1); - return out; } -// [[export]] -extern "C" SEXP node_children(SEXP node_sxp, SEXP only_node_sxp) { - BEGIN_CPP +[[cpp11::register]] +cpp11::list node_children(node_pointer node_sxp, cpp11::logicals only_node_sxp) { XPtrNode node(node_sxp); - bool only_node = LOGICAL(only_node_sxp)[0]; + bool only_node = cpp11::as_cpp(only_node_sxp); std::vector out; @@ -615,10 +581,9 @@ extern "C" SEXP node_children(SEXP node_sxp, SEXP only_node_sxp) { } return asList(out); - END_CPP } -int node_length_impl(SEXP x, bool only_node) { +int node_length_impl(cpp11::list x, bool only_node) { NodeType type = getNodeType(x); int out; @@ -628,8 +593,7 @@ int node_length_impl(SEXP x, bool only_node) { out = 0; break; case NodeType::node: { - SEXP node_sxp = VECTOR_ELT(x, 0); - XPtrNode node(node_sxp); + XPtrNode node(x[0]); out = 0; for(xmlNode* cur = node->xmlChildrenNode; cur != NULL; cur = cur->next) { @@ -646,63 +610,53 @@ int node_length_impl(SEXP x, bool only_node) { return out; } -// [[export]] -extern "C" SEXP node_length(SEXP x, SEXP only_node_sxp) { - BEGIN_CPP +[[cpp11::register]] +cpp11::integers node_length(cpp11::list x, cpp11::logicals only_node_sxp) { NodeType type = getNodeType(x); - bool only_node = LOGICAL(only_node_sxp)[0]; + bool only_node = cpp11::as_cpp(only_node_sxp); switch(type) { case NodeType::missing: case NodeType::node: - return Rf_ScalarInteger(node_length_impl(x, only_node)); + return cpp11::integers({node_length_impl(x, only_node)}); break; case NodeType::nodeset: { - int n = Rf_xlength(x); + R_xlen_t n = x.size(); if (n == 0) { - return Rf_ScalarInteger(0); + return cpp11::writable::integers({0}); } - SEXP out = PROTECT(Rf_allocVector(INTSXP, n)); - int* p_out = INTEGER(out); + cpp11::writable::integers out(n); for (int i = 0; i < n; ++i) { - SEXP x_i = VECTOR_ELT(x, i); - int length_i = node_length_impl(x_i, only_node); - p_out[i] = length_i; + out[i] = node_length_impl(x[i], only_node); } - UNPROTECT(1); return out; }; default: stop_unexpected_node_type(); } - - END_CPP } -// [[export]] -extern "C" SEXP node_has_children(SEXP node_sxp, SEXP only_node_sxp) { - BEGIN_CPP +[[cpp11::register]] +cpp11::logicals node_has_children(node_pointer node_sxp, cpp11::logicals only_node_sxp) { XPtrNode node(node_sxp); - bool only_node = LOGICAL(only_node_sxp)[0]; + bool only_node = cpp11::as_cpp(only_node_sxp); for(xmlNode* cur = node->xmlChildrenNode; cur != NULL; cur = cur->next) { if (only_node && cur->type != XML_ELEMENT_NODE) { continue; } - return Rf_ScalarLogical(true); + return cpp11::logicals({true}); } - return Rf_ScalarLogical(false); - END_CPP + return cpp11::logicals({false}); } -// [[export]] -extern "C" SEXP node_parents(SEXP node_sxp) { - BEGIN_CPP +[[cpp11::register]] +cpp11::list node_parents(node_pointer node_sxp) { XPtrNode node(node_sxp); std::vector out; @@ -714,20 +668,18 @@ extern "C" SEXP node_parents(SEXP node_sxp) { } return asList(out); - END_CPP } -// [[export]] -extern "C" SEXP node_siblings(SEXP node_sxp, SEXP only_node_sxp) { - BEGIN_CPP +[[cpp11::register]] +cpp11::list node_siblings(node_pointer node_sxp, cpp11::logicals only_node_sxp) { XPtrNode node(node_sxp); - bool only_node = LOGICAL(only_node_sxp)[0]; + bool only_node = cpp11::as_cpp(only_node_sxp); std::vector out; xmlNode* parent = node->parent; if (parent == NULL) - return Rf_allocVector(VECSXP, 0); + return cpp11::list(0); for(xmlNode* cur = parent->xmlChildrenNode; cur != NULL; cur = cur->next) { if (cur == node) { @@ -741,91 +693,75 @@ extern "C" SEXP node_siblings(SEXP node_sxp, SEXP only_node_sxp) { } return asList(out); - END_CPP } -// [[export]] -extern "C" SEXP node_parent(SEXP node_sxp) { - BEGIN_CPP +[[cpp11::register]] +node_pointer node_parent(node_pointer node_sxp) { XPtrNode node(node_sxp); if (node->parent == NULL) { - Rf_error("Parent does not exist"); + cpp11::stop("Parent does not exist"); } XPtrNode out(node->parent); return SEXP(out); - END_CPP } -SEXP node_path_impl(SEXP x) { +cpp11::r_string node_path_impl(cpp11::list x) { NodeType type = getNodeType(x); - SEXP out; - switch(type) { case NodeType::missing: - out = NA_STRING; + return NA_STRING; break; case NodeType::node: { - SEXP node_sxp = VECTOR_ELT(x, 0); - XPtrNode node(node_sxp); + XPtrNode node(x[0]); - out = Xml2String(xmlGetNodePath(node.checked_get())).asRString(); + return Xml2String(xmlGetNodePath(node.checked_get())).asRString(); break; } default: stop_unexpected_node_type(); } - - return out; } -// [[export]] -extern "C" SEXP node_path(SEXP x) { - BEGIN_CPP +[[cpp11::register]] +cpp11::strings node_path(cpp11::list x) { NodeType type = getNodeType(x); switch(type) { case NodeType::missing: case NodeType::node: - return Rf_ScalarString(node_path_impl(x)); + return cpp11::writable::strings(node_path_impl(x)); break; case NodeType::nodeset: { - int n = Rf_xlength(x); + R_xlen_t n = x.size(); - SEXP out = PROTECT(Rf_allocVector(STRSXP, n)); + cpp11::writable::strings out(n); for (int i = 0; i < n; ++i) { - SEXP x_i = VECTOR_ELT(x, i); - SEXP name_i = node_path_impl(x_i); - SET_STRING_ELT(out, i, name_i); + out[i] = node_path_impl(x[i]); } - UNPROTECT(1); return out; }; default: stop_unexpected_node_type(); } - - END_CPP } -// [[export]] -extern "C" SEXP nodes_duplicated(SEXP nodes) { - BEGIN_CPP - +[[cpp11::register]] +cpp11::logicals nodes_duplicated(cpp11::list nodes) { std::set seen; - int n = Rf_xlength(nodes); + R_xlen_t n = nodes.size(); - SEXP out = PROTECT(Rf_allocVector(LGLSXP, n)); + cpp11::writable::logicals out(n); for (int i = 0; i < n; ++i) { bool result; - SEXP cur = VECTOR_ELT(nodes, i); + cpp11::list cur = nodes[i]; if (Rf_inherits(cur, "xml_node")) { - XPtrNode node(VECTOR_ELT(cur, 0)); + XPtrNode node(cur[0]); result = !seen.insert(node.checked_get()).second; } else if (Rf_inherits(cur, "xml_missing")) { result = false; @@ -833,15 +769,13 @@ extern "C" SEXP nodes_duplicated(SEXP nodes) { XPtrNode node(cur); result = !seen.insert(node.checked_get()).second; } - LOGICAL(out)[i] = result; + out[i] = result; } - UNPROTECT(1); return out; - END_CPP } -int node_type_impl(SEXP x) { +int node_type_impl(cpp11::list x) { NodeType type = getNodeType(x); int out; @@ -851,8 +785,7 @@ int node_type_impl(SEXP x) { out = NA_INTEGER; break; case NodeType::node: { - SEXP node_sxp = VECTOR_ELT(x, 0); - XPtrNode node(node_sxp); + XPtrNode node(x[0]); out = node->type; break; @@ -863,146 +796,120 @@ int node_type_impl(SEXP x) { return out; } -// [[export]] -extern "C" SEXP node_type(SEXP x) { - BEGIN_CPP +[[cpp11::register]] +cpp11::integers node_type(cpp11::list x) { NodeType type = getNodeType(x); switch(type) { case NodeType::missing: case NodeType::node: - return Rf_ScalarInteger(node_type_impl(x)); + return cpp11::writable::integers({node_type_impl(x)}); break; case NodeType::nodeset: { - int n = Rf_xlength(x); + R_xlen_t n = x.size(); - SEXP out = PROTECT(Rf_allocVector(INTSXP, n)); - int* p_out = INTEGER(out); + cpp11::writable::integers out(n); for (int i = 0; i < n; ++i) { - SEXP x_i = VECTOR_ELT(x, i); - int type_i = node_type_impl(x_i); - p_out[i] = type_i; + out[i] = node_type_impl(x[i]); } - UNPROTECT(1); return out; }; default: stop_unexpected_node_type(); } - - END_CPP } -// [[export]] -extern "C" SEXP node_copy(SEXP node_sxp) { - BEGIN_CPP +[[cpp11::register]] +node_pointer node_copy(node_pointer node_sxp) { XPtrNode node(node_sxp); XPtrNode copy(xmlCopyNode(node.checked_get(), 1)); return SEXP(copy); - END_CPP } -// [[export]] -extern "C" SEXP node_set_content(SEXP node_sxp, SEXP content) { - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp node_set_content(node_pointer node_sxp, cpp11::strings content) { XPtrNode node(node_sxp); - xmlNodeSetContentLen(node.checked_get(), asXmlChar(content), Rf_xlength(STRING_ELT(content, 0))); + xmlNodeSetContentLen(node.checked_get(), asXmlChar(content), content[0].size()); return R_NilValue; - END_CPP } -// [[export]] -extern "C" SEXP node_append_content(SEXP node_sxp, SEXP content) { - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp node_append_content(node_pointer node_sxp, cpp11::strings content) { XPtrNode node(node_sxp); - xmlNodeAddContentLen(node.checked_get(), asXmlChar(content), Rf_xlength(STRING_ELT(content, 0))); + xmlNodeAddContentLen(node.checked_get(), asXmlChar(content), content[0].size()); return R_NilValue; - END_CPP } -// [[export]] -extern "C" SEXP node_new_text(SEXP node_sxp, SEXP content) { - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp node_new_text(node_pointer node_sxp, cpp11::strings content) { XPtrNode node(node_sxp); - xmlAddChild(node.checked_get(), xmlNewTextLen(asXmlChar(content), Rf_xlength(STRING_ELT(content, 0)))); + xmlAddChild(node.checked_get(), xmlNewTextLen(asXmlChar(content), content[0].size())); return R_NilValue; - END_CPP } -// [[export]] -extern "C" SEXP node_append_child(SEXP parent_sxp, SEXP cur_sxp) { - BEGIN_CPP +[[cpp11::register]] +node_pointer node_append_child(node_pointer parent_sxp, node_pointer cur_sxp) { XPtrNode parent(parent_sxp); XPtrNode cur(cur_sxp); XPtrNode out(xmlAddChild(parent.checked_get(), cur.checked_get())); return SEXP(out); - END_CPP } -// [[export]] -extern "C" SEXP node_prepend_child(SEXP parent_sxp, SEXP cur_sxp) { - BEGIN_CPP +[[cpp11::register]] +node_pointer node_prepend_child(node_pointer parent_sxp, node_pointer cur_sxp) { XPtrNode parent(parent_sxp); XPtrNode cur(cur_sxp); XPtrNode out(xmlAddPrevSibling(parent.checked_get()->children, cur.checked_get())); return SEXP(out); - END_CPP } // Previous sibling -// [[export]] -extern "C" SEXP node_prepend_sibling(SEXP cur_sxp, SEXP elem_sxp) { - BEGIN_CPP +[[cpp11::register]] +node_pointer node_prepend_sibling(node_pointer cur_sxp, node_pointer elem_sxp) { XPtrNode cur(cur_sxp); XPtrNode elem(elem_sxp); XPtrNode out(xmlAddPrevSibling(cur.checked_get(), elem.checked_get())); return SEXP(out); - END_CPP } // Append sibling -// [[export]] -extern "C" SEXP node_append_sibling(SEXP cur_sxp, SEXP elem_sxp) { - BEGIN_CPP +[[cpp11::register]] +node_pointer node_append_sibling(node_pointer cur_sxp, node_pointer elem_sxp) { XPtrNode cur(cur_sxp); XPtrNode elem(elem_sxp); XPtrNode out(xmlAddNextSibling(cur.checked_get(), elem.checked_get())); return SEXP(out); - END_CPP } // Replace node -// [[export]] -extern "C" SEXP node_replace(SEXP old_sxp, SEXP cur_sxp) { - BEGIN_CPP +[[cpp11::register]] +node_pointer node_replace(node_pointer old_sxp, node_pointer cur_sxp) { XPtrNode old(old_sxp); XPtrNode cur(cur_sxp); XPtrNode out(xmlReplaceNode(old.checked_get(), cur.checked_get())); return SEXP(out); - END_CPP } -// [[export]] -extern "C" SEXP node_remove(SEXP node_sxp, SEXP free_sxp) { - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp node_remove(node_pointer node_sxp, cpp11::logicals free_sxp) { XPtrNode node(node_sxp); - bool free = LOGICAL(free_sxp)[0]; + bool free = cpp11::as_cpp(free_sxp); xmlUnlinkNode(node.checked_get()); if (free) { @@ -1010,47 +917,37 @@ extern "C" SEXP node_remove(SEXP node_sxp, SEXP free_sxp) { } return R_NilValue; - END_CPP } -// [[export]] -extern "C" SEXP node_new(SEXP name) { - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp node_new(cpp11::strings name) { XPtrNode node(xmlNewNode(NULL, asXmlChar(name))); return SEXP(node); - END_CPP } -// [[export]] -extern "C" SEXP node_cdata_new(SEXP doc_sxp, SEXP content_sxp) { - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp node_cdata_new(cpp11::sexp doc_sxp, cpp11::strings content_sxp) { XPtrDoc doc(doc_sxp); - XPtrNode node(xmlNewCDataBlock(doc.checked_get(), asXmlChar(content_sxp), Rf_xlength(STRING_ELT(content_sxp, 0)))); + XPtrNode node(xmlNewCDataBlock(doc.checked_get(), asXmlChar(content_sxp), content_sxp[0].size())); return SEXP(node); - END_CPP } -// [[export]] -extern "C" SEXP node_comment_new(SEXP content) { - BEGIN_CPP +[[cpp11::register]] +node_pointer node_comment_new(cpp11::strings content) { XPtrNode node(xmlNewComment(asXmlChar(content))); return SEXP(node); - END_CPP } -// [[export]] -extern "C" SEXP node_new_ns(SEXP name, SEXP ns_sxp) { - BEGIN_CPP +[[cpp11::register]] +node_pointer node_new_ns(cpp11::strings name, cpp11::external_pointer ns_sxp) { XPtrNs ns(ns_sxp); XPtrNode node(xmlNewNode(ns.checked_get(), asXmlChar(name))); return SEXP(node); - END_CPP } -// [[export]] -extern "C" SEXP node_set_namespace_uri(SEXP doc_sxp, SEXP node_sxp, SEXP uri) { - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp node_set_namespace_uri(doc_pointer doc_sxp, node_pointer node_sxp, cpp11::strings uri) { XPtrDoc doc(doc_sxp); XPtrNode node(node_sxp); @@ -1059,17 +956,15 @@ extern "C" SEXP node_set_namespace_uri(SEXP doc_sxp, SEXP node_sxp, SEXP uri) { xmlSetNs(node.checked_get(), ns); return R_NilValue; - END_CPP } -// [[export]] -extern "C" SEXP node_set_namespace_prefix(SEXP doc_sxp, SEXP node_sxp, SEXP prefix_sxp) { - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp node_set_namespace_prefix(doc_pointer doc_sxp, node_pointer node_sxp, cpp11::strings prefix_sxp) { XPtrDoc doc(doc_sxp); XPtrNode node(node_sxp); xmlNsPtr ns = NULL; - if (Rf_xlength(STRING_ELT(prefix_sxp, 0)) == 0) { + if (prefix_sxp[0].size() == 0) { ns = xmlSearchNs(doc.checked_get(), node.checked_get(), NULL); } else { ns = xmlSearchNs(doc.checked_get(), node.checked_get(), asXmlChar(prefix_sxp)); @@ -1078,20 +973,17 @@ extern "C" SEXP node_set_namespace_prefix(SEXP doc_sxp, SEXP node_sxp, SEXP pref xmlSetNs(node.checked_get(), ns); return R_NilValue; - END_CPP } -// [[export]] -extern "C" SEXP node_new_dtd(SEXP doc_sxp, SEXP name_sxp, SEXP eid_sxp, SEXP sid_sxp) { - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp node_new_dtd(doc_pointer doc_sxp, cpp11::strings name_sxp, cpp11::strings eid_sxp, cpp11::strings sid_sxp) { XPtrDoc doc(doc_sxp); - std::string name(CHAR(STRING_ELT(name_sxp, 0))); - std::string eid(CHAR(STRING_ELT(eid_sxp, 0))); - std::string sid(CHAR(STRING_ELT(sid_sxp, 0))); + std::string name(cpp11::as_cpp(name_sxp)); + std::string eid(cpp11::as_cpp(eid_sxp)); + std::string sid(cpp11::as_cpp(sid_sxp)); xmlDtdPtr dtd = xmlNewDtd(doc, name == "" ? NULL : asXmlChar(name), eid == "" ? NULL : asXmlChar(eid), sid == "" ? NULL : asXmlChar(sid)); xmlAddChild(reinterpret_cast(doc.checked_get()), reinterpret_cast(dtd)); return R_NilValue; - END_CPP } diff --git a/src/xml2_output.cpp b/src/xml2_output.cpp index c0619e2..28dad2a 100644 --- a/src/xml2_output.cpp +++ b/src/xml2_output.cpp @@ -1,3 +1,5 @@ +#include + #define R_NO_REMAP #include #undef R_NO_REMAP @@ -43,8 +45,8 @@ typedef struct { int value; } xml_save_def; -// [[export]] -extern "C" SEXP xml_save_options_() { +[[cpp11::register]] +cpp11::writable::integers xml_save_options_() { static const xml_save_def entries[] = { {"format", "Format output", XML_SAVE_FORMAT}, @@ -69,21 +71,18 @@ extern "C" SEXP xml_save_options_() { ++n; } - SEXP names = PROTECT(Rf_allocVector(STRSXP, n)); - SEXP descriptions = PROTECT(Rf_allocVector(STRSXP, n)); - SEXP values = PROTECT(Rf_allocVector(INTSXP, n)); - + cpp11::writable::strings names(n); + cpp11::writable::strings descriptions(n); + cpp11::writable::integers values(n); - for (R_xlen_t i = 0;i < n; ++i) { - SET_STRING_ELT(names, i, Rf_mkChar(entries[i].name)); - SET_STRING_ELT(descriptions, i, Rf_mkChar(entries[i].description)); - INTEGER(values)[i] = entries[i].value; + for (R_xlen_t i = 0; i < n; ++i) { + names[i] = entries[i].name; + descriptions[i] = entries[i].description; + values[i] = entries[i].value; } - Rf_setAttrib(values, R_NamesSymbol, names); - Rf_setAttrib(values, Rf_install("descriptions"), descriptions); - - UNPROTECT(3); + values.names() = names; + values.attr("descriptions") = descriptions; return values; } @@ -92,19 +91,17 @@ int xml_write_callback(SEXP con, const char * buffer, int len) { size_t write_size; if ((write_size = R_WriteConnection(con, (void *) buffer, len)) != static_cast(len)) { - Rf_error("write failed, expected %l, got %l", len, write_size); + cpp11::stop("write failed, expected %l, got %l", len, write_size); } return write_size; } -// [[export]] -extern "C" SEXP doc_write_file(SEXP doc_sxp, SEXP path_sxp, SEXP encoding_sxp, SEXP options_sxp) { - - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp doc_write_file(cpp11::sexp doc_sxp, cpp11::strings path_sxp, cpp11::strings encoding_sxp, cpp11::integers options_sxp) { XPtrDoc doc(doc_sxp); - const char* path = CHAR(STRING_ELT(path_sxp, 0)); - const char* encoding = CHAR(STRING_ELT(encoding_sxp, 0)); - int options = INTEGER(options_sxp)[0]; + const char* path = cpp11::as_cpp(path_sxp); + const char* encoding = cpp11::as_cpp(encoding_sxp); + int options = cpp11::as_cpp(options_sxp); xmlSaveCtxtPtr savectx = xmlSaveToFilename( path, @@ -112,44 +109,38 @@ extern "C" SEXP doc_write_file(SEXP doc_sxp, SEXP path_sxp, SEXP encoding_sxp, S options); xmlSaveDoc(savectx, doc.checked_get()); if (xmlSaveClose(savectx) == -1) { - Rf_error("Error closing file"); + cpp11::stop("Error closing file"); } return R_NilValue; - END_CPP } -// [[export]] -extern "C" SEXP doc_write_connection(SEXP doc_sxp, SEXP connection, SEXP encoding_sxp, SEXP options_sxp) { - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp doc_write_connection(cpp11::sexp doc_sxp, cpp11::sexp connection, cpp11::strings encoding_sxp, cpp11::integers options_sxp) { XPtrDoc doc(doc_sxp); - const char* encoding = CHAR(STRING_ELT(encoding_sxp, 0)); - int options = INTEGER(options_sxp)[0]; - - SEXP con = R_GetConnection(connection); + const char* encoding = cpp11::as_cpp(encoding_sxp); + int options = cpp11::as_cpp(options_sxp); xmlSaveCtxtPtr savectx = xmlSaveToIO( reinterpret_cast(xml_write_callback), NULL, - con, + connection, encoding, options); xmlSaveDoc(savectx, doc.checked_get()); if (xmlSaveClose(savectx) == -1) { - Rf_error("Error closing connection"); + cpp11::stop("Error closing connection"); } return R_NilValue; - END_CPP } -// [[export]] -extern "C" SEXP doc_write_character(SEXP doc_sxp, SEXP encoding_sxp, SEXP options_sxp) { - BEGIN_CPP +[[cpp11::register]] +cpp11::writable::strings doc_write_character(cpp11::sexp doc_sxp, cpp11::strings encoding_sxp, cpp11::integers options_sxp) { XPtrDoc doc(doc_sxp); - const char* encoding = CHAR(STRING_ELT(encoding_sxp, 0)); - int options = INTEGER(options_sxp)[0]; + const char* encoding = cpp11::as_cpp(encoding_sxp); + int options = options_sxp[0]; xmlBufferPtr buffer = xmlBufferCreate(); @@ -161,26 +152,21 @@ extern "C" SEXP doc_write_character(SEXP doc_sxp, SEXP encoding_sxp, SEXP option xmlSaveDoc(savectx, doc.checked_get()); if (xmlSaveClose(savectx) == -1) { xmlFree(buffer); - Rf_error("Error writing to buffer"); + cpp11::stop("Error writing to buffer"); } - SEXP out = PROTECT(Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(out, 0, Xml2String(buffer->content).asRString()); + cpp11::writable::strings out(Xml2String(buffer->content).asRString()); xmlFree(buffer); - UNPROTECT(1); - return out; - END_CPP } -// [[export]] -extern "C" SEXP node_write_file(SEXP node_sxp, SEXP path_sxp, SEXP encoding_sxp, SEXP options_sxp) { - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp node_write_file(cpp11::sexp node_sxp, cpp11::strings path_sxp, cpp11::strings encoding_sxp, cpp11::integers options_sxp) { XPtrNode node(node_sxp); - const char* path = CHAR(STRING_ELT(path_sxp, 0)); - const char* encoding = CHAR(STRING_ELT(encoding_sxp, 0)); - int options = INTEGER(options_sxp)[0]; + const char* path = cpp11::as_cpp(path_sxp); + const char* encoding = cpp11::as_cpp(encoding_sxp); + int options = cpp11::as_cpp(options_sxp); xmlSaveCtxtPtr savectx = xmlSaveToFilename( path, @@ -188,43 +174,38 @@ extern "C" SEXP node_write_file(SEXP node_sxp, SEXP path_sxp, SEXP encoding_sxp, options); xmlSaveTree(savectx, node.checked_get()); if (xmlSaveClose(savectx) == -1) { - Rf_error("Error closing file"); + cpp11::stop("Error closing file"); } return R_NilValue; - END_CPP } -// [[export]] -extern "C" SEXP node_write_connection(SEXP node_sxp, SEXP connection, SEXP encoding_sxp, SEXP options_sxp) { - BEGIN_CPP +[[cpp11::register]] +cpp11::sexp node_write_connection(cpp11::sexp node_sxp, cpp11::sexp connection, cpp11::strings encoding_sxp, cpp11::integers options_sxp) { XPtrNode node(node_sxp); - SEXP con = R_GetConnection(connection); - const char* encoding = CHAR(STRING_ELT(encoding_sxp, 0)); - int options = INTEGER(options_sxp)[0]; + const char* encoding = cpp11::as_cpp(encoding_sxp); + int options = cpp11::as_cpp(options_sxp); xmlSaveCtxtPtr savectx = xmlSaveToIO( (xmlOutputWriteCallback)xml_write_callback, NULL, - con, + connection, encoding, options); xmlSaveTree(savectx, node.checked_get()); if (xmlSaveClose(savectx) == -1) { - Rf_error("Error closing connection"); + cpp11::stop("Error closing connection"); } return R_NilValue; - END_CPP } -// [[export]] -extern "C" SEXP node_write_character(SEXP node_sxp, SEXP encoding_sxp, SEXP options_sxp) { - BEGIN_CPP +[[cpp11::register]] +cpp11::writable::strings node_write_character(cpp11::sexp node_sxp, cpp11::strings encoding_sxp, cpp11::integers options_sxp) { XPtrNode node(node_sxp); - const char* encoding = CHAR(STRING_ELT(encoding_sxp, 0)); - int options = INTEGER(options_sxp)[0]; + const char* encoding = cpp11::as_cpp(encoding_sxp); + int options = cpp11::as_cpp(options_sxp); xmlBufferPtr buffer = xmlBufferCreate(); @@ -236,12 +217,10 @@ extern "C" SEXP node_write_character(SEXP node_sxp, SEXP encoding_sxp, SEXP opti xmlSaveTree(savectx, node.checked_get()); if (xmlSaveClose(savectx) == -1) { xmlFree(buffer); - Rf_error("Error writing to buffer"); + cpp11::stop("Error writing to buffer"); } - SEXP out = PROTECT(Rf_ScalarString(Xml2String(buffer->content).asRString())); + cpp11::writable::strings out(Xml2String(buffer->content).asRString()); xmlFree(buffer); - UNPROTECT(1); return out; - END_CPP } diff --git a/src/xml2_schema.cpp b/src/xml2_schema.cpp index 345ca50..44c36e8 100644 --- a/src/xml2_schema.cpp +++ b/src/xml2_schema.cpp @@ -1,3 +1,5 @@ +#include + #define R_NO_REMAP #include #undef R_NO_REMAP @@ -16,16 +18,14 @@ void handleSchemaError(void* userData, xmlError* error) { vec->push_back(message); } -// [[export]] -extern "C" SEXP doc_validate(SEXP doc_sxp, SEXP schema_sxp) { +[[cpp11::register]] +cpp11::logicals doc_validate(doc_pointer doc_sxp, doc_pointer schema_sxp) { XPtrDoc doc(doc_sxp); XPtrDoc schema(schema_sxp); xmlLineNumbersDefault(1); - BEGIN_CPP - std::vector vec; xmlSchemaParserCtxtPtr cptr = xmlSchemaNewDocParserCtxt(schema.checked_get()); @@ -38,23 +38,14 @@ extern "C" SEXP doc_validate(SEXP doc_sxp, SEXP schema_sxp) { xmlSchemaSetValidStructuredErrors(vptr, handleSchemaError, &vec); - SEXP out = PROTECT(Rf_allocVector(LGLSXP, 1)); - - LOGICAL(out)[0] = xmlSchemaValidateDoc(vptr, doc.checked_get()) == 0; + bool valid = (xmlSchemaValidateDoc(vptr, doc.checked_get()) == 0); + cpp11::writable::logicals out{valid}; xmlSchemaFreeParserCtxt(cptr); xmlSchemaFreeValidCtxt(vptr); xmlSchemaFree(sptr); - SEXP errors = PROTECT(Rf_allocVector(STRSXP, vec.size())); - for (size_t i = 0; i < vec.size(); ++i) { - SET_STRING_ELT(errors, i, Rf_mkCharLenCE(vec[i].c_str(), vec[i].size(), CE_UTF8)); - } - Rf_setAttrib(out, Rf_install("errors"), errors); + out.attr("errors") = vec; - - UNPROTECT(2); return out; - - END_CPP } diff --git a/src/xml2_url.cpp b/src/xml2_url.cpp index 6f7644b..ed181a6 100644 --- a/src/xml2_url.cpp +++ b/src/xml2_url.cpp @@ -1,3 +1,5 @@ +#include + #define R_NO_REMAP #include #undef R_NO_REMAP @@ -5,72 +7,70 @@ #include #include "xml2_utils.h" -// [[export]] -extern "C" SEXP url_absolute_(SEXP x_sxp, SEXP base_sxp) { - R_xlen_t n = Rf_xlength(x_sxp); - SEXP out = PROTECT(Rf_allocVector(STRSXP, n)); - - if (Rf_xlength(base_sxp) > 1) { - Rf_error("Base URL must be length 1"); +const xmlChar* to_xml_chr(cpp11::strings x, const char* arg) { + if (x.size() != 1) { + cpp11::stop("%s must be a character vector of length 1", arg); } - const xmlChar* base_uri = (xmlChar*) Rf_translateCharUTF8(STRING_ELT(base_sxp, 0)); + return (xmlChar*) cpp11::as_cpp(x); +} + +[[cpp11::register]] +cpp11::strings url_absolute_(cpp11::strings x_sxp, cpp11::strings base_sxp) { + R_xlen_t n = x_sxp.size(); + cpp11::writable::strings out(n); - for (int i = 0; i < n; ++i) { - const xmlChar* uri = (xmlChar*) Rf_translateCharUTF8(STRING_ELT(x_sxp, i)); - SET_STRING_ELT(out, i, Xml2String(xmlBuildURI(uri, base_uri)).asRString()); + const xmlChar* base_uri = to_xml_chr(base_sxp, "Base URL"); + + for (R_xlen_t i = 0; i < n; ++i) { + const xmlChar* uri = (xmlChar*) Rf_translateCharUTF8(x_sxp[i]); + out[i] = Xml2String(xmlBuildURI(uri, base_uri)).asRString(); } - UNPROTECT(1); return out; } -// [[export]] -extern "C" SEXP url_relative_(SEXP x_sxp, SEXP base_sxp) { - R_xlen_t n = Rf_xlength(x_sxp); - SEXP out = PROTECT(Rf_allocVector(STRSXP, n)); - - if (Rf_xlength(base_sxp) > 1) { - Rf_error("Base URL must be length 1"); - } +[[cpp11::register]] +cpp11::strings url_relative_(cpp11::strings x_sxp, cpp11::strings base_sxp) { + R_xlen_t n = x_sxp.size(); + cpp11::writable::strings out(n); - const xmlChar* base_uri = (xmlChar*) Rf_translateCharUTF8(STRING_ELT(base_sxp, 0)); + const xmlChar* base_uri = to_xml_chr(base_sxp, "Base URL"); - for (int i = 0; i < n; ++i) { - const xmlChar* uri = (xmlChar*) Rf_translateCharUTF8(STRING_ELT(x_sxp, i)); - SET_STRING_ELT(out, i, Xml2String(xmlBuildRelativeURI(uri, base_uri)).asRString()); + for (R_xlen_t i = 0; i < n; ++i) { + const xmlChar* uri = (xmlChar*) Rf_translateCharUTF8(x_sxp[i]); + out[i] = Xml2String(xmlBuildRelativeURI(uri, base_uri)).asRString(); } - UNPROTECT(1); return out; } -// [[export]] -extern "C" SEXP url_parse_(SEXP x_sxp) { - R_xlen_t n = Rf_xlength(x_sxp); +[[cpp11::register]] +cpp11::data_frame url_parse_(cpp11::strings x_sxp) { + R_xlen_t n = x_sxp.size(); - SEXP scheme = PROTECT(Rf_allocVector(STRSXP, n)); - SEXP server = PROTECT(Rf_allocVector(STRSXP, n)); - SEXP user = PROTECT(Rf_allocVector(STRSXP, n)); - SEXP path = PROTECT(Rf_allocVector(STRSXP, n)); - SEXP query = PROTECT(Rf_allocVector(STRSXP, n)); - SEXP fragment = PROTECT(Rf_allocVector(STRSXP, n)); + cpp11::writable::strings scheme(n); + cpp11::writable::strings server(n); + cpp11::writable::strings user(n); + cpp11::writable::strings path(n); + cpp11::writable::strings query(n); + cpp11::writable::strings fragment(n); - SEXP port = PROTECT(Rf_allocVector(INTSXP, n)); + cpp11::writable::integers port(n); - for (int i = 0; i < n; ++i) { - const char* raw = Rf_translateCharUTF8(STRING_ELT(x_sxp, i)); + for (R_xlen_t i = 0; i < n; ++i) { + const char* raw = Rf_translateCharUTF8(x_sxp[i]); xmlURI* uri = xmlParseURI(raw); if (uri == NULL) { continue; } - SET_STRING_ELT(scheme, i, Rf_mkChar(uri->scheme == NULL ? "" : uri->scheme)); - SET_STRING_ELT(server, i, Rf_mkChar(uri->server == NULL ? "" : uri->server)); - INTEGER(port)[i] = uri->port == 0 ? NA_INTEGER : uri->port; - SET_STRING_ELT(user, i, Rf_mkChar(uri->user == NULL ? "" : uri->user)); - SET_STRING_ELT(path, i, Rf_mkChar(uri->path == NULL ? "" : uri->path)); - SET_STRING_ELT(fragment, i, Rf_mkChar(uri->fragment == NULL ? "" : uri->fragment)); + scheme[i] = uri->scheme == NULL ? "" : uri->scheme; + server[i] = uri->server == NULL ? "" : uri->server; + port[i] = uri->port == 0 ? NA_INTEGER : uri->port; + user[i] = uri->user == NULL ? "" : uri->user; + path[i] = uri->path == NULL ? "" : uri->path; + fragment[i] = uri->fragment == NULL ? "" : uri->fragment; /* * * * Thu Apr 26 10:36:26 CEST 2007 Daniel Veillard @@ -78,79 +78,56 @@ extern "C" SEXP url_parse_(SEXP x_sxp) { * https://github.com/GNOME/libxml2/commit/a1413b84f7163d57c6251d5f4251186368efd859 */ #if defined(LIBXML_VERSION) && (LIBXML_VERSION >= 20629) - SET_STRING_ELT(query, i, Rf_mkChar(uri->query_raw == NULL ? "" : uri->query_raw)); + query[i] = uri->query_raw == NULL ? "" : uri->query_raw; #else - SET_STRING_ELT(query, i, Rf_mkChar(uri->query == NULL ? "" : uri->query)); + query[i] = uri->query == NULL ? "" : uri->query; #endif xmlFreeURI(uri); } - SEXP out = PROTECT(Rf_allocVector(VECSXP, 7)); - SET_VECTOR_ELT(out, 0, scheme); - SET_VECTOR_ELT(out, 1, server); - SET_VECTOR_ELT(out, 2, port); - SET_VECTOR_ELT(out, 3, user); - SET_VECTOR_ELT(out, 4, path); - SET_VECTOR_ELT(out, 5, query); - SET_VECTOR_ELT(out, 6, fragment); + using namespace cpp11::literals; - SEXP names = PROTECT(Rf_allocVector(STRSXP, 7)); - - SET_STRING_ELT(names, 0, Rf_mkChar("scheme")); - SET_STRING_ELT(names, 1, Rf_mkChar("server")); - SET_STRING_ELT(names, 2, Rf_mkChar("port")); - SET_STRING_ELT(names, 3, Rf_mkChar("user")); - SET_STRING_ELT(names, 4, Rf_mkChar("path")); - SET_STRING_ELT(names, 5, Rf_mkChar("query")); - SET_STRING_ELT(names, 6, Rf_mkChar("fragment")); - - Rf_setAttrib(out, R_ClassSymbol, Rf_mkString("data.frame")); - Rf_setAttrib(out, R_NamesSymbol, names); - - SEXP row_names = PROTECT(Rf_allocVector(INTSXP, 2)); - INTEGER(row_names)[0] = NA_INTEGER; - INTEGER(row_names)[1] = -n; - Rf_setAttrib(out, R_RowNamesSymbol, row_names); - - UNPROTECT(10); + cpp11::writable::data_frame out({ + "scheme"_nm = scheme, + "server"_nm = server, + "port"_nm = port, + "user"_nm = user, + "path"_nm = path, + "query"_nm = query, + "fragment"_nm = fragment, + }); return out; } -// [[export]] -extern "C" SEXP url_escape_(SEXP x_sxp, SEXP reserved_sxp) { - R_xlen_t n = Rf_xlength(x_sxp); - SEXP out = PROTECT(Rf_allocVector(STRSXP, n)); - - if (Rf_xlength(reserved_sxp) != 1) { - Rf_error("`reserved` must be character vector of length 1"); - } +[[cpp11::register]] +cpp11::strings url_escape_(cpp11::strings x_sxp, cpp11::strings reserved_sxp) { + R_xlen_t n = x_sxp.size(); + cpp11::writable::strings out(n); - xmlChar* xReserved = (xmlChar*) Rf_translateCharUTF8(STRING_ELT(reserved_sxp, 0)); + const xmlChar* xReserved = to_xml_chr(reserved_sxp, "`reserved`"); - for (int i = 0; i < n; ++i) { - const xmlChar* xx = (xmlChar*) Rf_translateCharUTF8(STRING_ELT(x_sxp, i)); - SET_STRING_ELT(out, i, Xml2String(xmlURIEscapeStr(xx, xReserved)).asRString()); + for (R_xlen_t i = 0; i < n; ++i) { + const xmlChar* xx = (xmlChar*) Rf_translateCharUTF8(x_sxp[i]); + out[i] = Xml2String(xmlURIEscapeStr(xx, xReserved)).asRString(); } - UNPROTECT(1); return out; } -// [[export]] -extern "C" SEXP url_unescape_(SEXP x_sxp) { - R_xlen_t n = Rf_xlength(x_sxp); - SEXP out = PROTECT(Rf_allocVector(STRSXP, n)); +[[cpp11::register]] +cpp11::strings url_unescape_(cpp11::strings x_sxp) { + R_xlen_t n = x_sxp.size(); + cpp11::writable::strings out(n); - for (int i = 0; i < n; ++i) { - const char* xx = Rf_translateCharUTF8(STRING_ELT(x_sxp, i)); + for (R_xlen_t i = 0; i < n; ++i) { + const char* xx = Rf_translateCharUTF8(x_sxp[i]); char* unescaped = xmlURIUnescapeString(xx, 0, NULL); - SET_STRING_ELT(out, i, (unescaped == NULL) ? NA_STRING : Rf_mkCharCE(unescaped, CE_UTF8)); + out[i] = (unescaped == NULL) ? cpp11::na() : cpp11::r_string(unescaped); xmlFree(unescaped); } - UNPROTECT(1); return out; } diff --git a/src/xml2_utils.h b/src/xml2_utils.h index d77b3cf..489817d 100644 --- a/src/xml2_utils.h +++ b/src/xml2_utils.h @@ -1,6 +1,8 @@ #ifndef __XML2_XML_UTILS__ #define __XML2_XML_UTILS__ +#include + #define R_NO_REMAP #include #undef R_NO_REMAP @@ -15,6 +17,11 @@ enum NodeType { nodeset = 3, }; +__attribute__ ((noreturn)) +inline void stop_unexpected_node_type() { + cpp11::stop("Unexpected node type"); +} + inline const NodeType getNodeType(SEXP x) { if (Rf_inherits(x, "xml_node")) { return(NodeType::node); @@ -23,7 +30,7 @@ inline const NodeType getNodeType(SEXP x) { } else if (Rf_inherits(x, "xml_missing")) { return(NodeType::missing); } else { - Rf_error("Unexpected node type"); + stop_unexpected_node_type(); } } @@ -31,19 +38,10 @@ inline const xmlChar* asXmlChar(std::string const& x) { return (const xmlChar*) x.c_str(); } -inline const xmlChar* asXmlChar(SEXP x, int n = 0) { - return (const xmlChar*) CHAR(STRING_ELT(x, n)); +inline const xmlChar* asXmlChar(cpp11::strings x) { + return (const xmlChar*) cpp11::as_cpp(x); } -#define BEGIN_CPP try { - -#define END_CPP \ - } \ - catch (std::exception & e) { \ - Rf_error("C++ exception: %s", e.what()); \ - } - - // If we are using C++11 disallow moves #if __cplusplus >= 201103L void asXmlChar(std::string&&) = delete; @@ -80,11 +78,11 @@ class Xml2String { return std::string((char*) string_); } - SEXP asRString(SEXP missing = NA_STRING) { + cpp11::r_string asRString(cpp11::r_string missing = NA_STRING) { if (string_ == NULL) return missing; - return Rf_mkCharCE((char*) string_, CE_UTF8); + return cpp11::r_string((char*) string_); }; }; @@ -103,10 +101,10 @@ class NsMap { } // Initialise from an existing STRSXP - NsMap(SEXP x) { - SEXP names = Rf_getAttrib(x, R_NamesSymbol); - for (R_len_t i = 0; i < Rf_xlength(x); ++i) { - add(std::string(CHAR(STRING_ELT(names, i))), std::string(CHAR(STRING_ELT(x, i)))); + NsMap(cpp11::strings x) { + cpp11::strings names = x.names(); + for (R_len_t i = 0; i < x.size(); ++i) { + add(cpp11::r_string(names[i]), cpp11::r_string(x[i])); } } @@ -120,7 +118,7 @@ class NsMap { return it->second; } - Rf_error("Couldn't find url for prefix %s", prefix.c_str()); + cpp11::stop("Couldn't find url for prefix %s", prefix.c_str()); return std::string(); } @@ -131,7 +129,7 @@ class NsMap { } } - Rf_error("Couldn't find prefix for url %s", url.c_str()); + cpp11::stop("Couldn't find prefix for url %s", url.c_str()); return std::string(); } @@ -144,20 +142,20 @@ class NsMap { return true; } - SEXP out() { - SEXP out = PROTECT(Rf_allocVector(STRSXP, prefix2url.size())); - SEXP names = PROTECT(Rf_allocVector(STRSXP, prefix2url.size())); + cpp11::sexp out() { + int n = prefix2url.size(); + cpp11::writable::strings out(n); + cpp11::writable::strings names(n); size_t i = 0; for (prefix2url_t::const_iterator it = prefix2url.begin(); it != prefix2url.end(); ++it) { - SET_STRING_ELT(out, i, Rf_mkChar(it->second.c_str())); - SET_STRING_ELT(names, i, Rf_mkChar(it->first.c_str())); + out[i] = it->second.c_str(); + names[i] = it->first.c_str(); ++i; } - Rf_setAttrib(out, R_NamesSymbol, names); + out.names() = names; - UNPROTECT(2); return out; } }; diff --git a/src/xml2_xpath.cpp b/src/xml2_xpath.cpp index 6a43b50..5b8347e 100644 --- a/src/xml2_xpath.cpp +++ b/src/xml2_xpath.cpp @@ -1,3 +1,5 @@ +#include + #define R_NO_REMAP #include #undef R_NO_REMAP @@ -21,29 +23,32 @@ class XmlSeeker { context_->node = node; } - void registerNamespace(SEXP nsMap) { - R_xlen_t n = Rf_xlength(nsMap); + void registerNamespace(cpp11::strings nsMap) { + R_xlen_t n = nsMap.size(); if (n == 0) { return; } - SEXP prefix = Rf_getAttrib(nsMap, R_NamesSymbol); + cpp11::strings prefix = nsMap.names(); for (int i = 0; i < n; ++i) { - xmlChar* prefixI = (xmlChar*) CHAR(STRING_ELT(prefix, i)); - xmlChar* urlI = (xmlChar*) CHAR(STRING_ELT(nsMap, i)); + xmlChar* prefixI = (xmlChar*) CHAR(prefix[i]); + xmlChar* urlI = (xmlChar*) CHAR(nsMap[i]); if (xmlXPathRegisterNs(context_, prefixI, urlI) != 0) - Rf_error("Failed to register namespace (%s <-> %s)", prefixI, urlI); + cpp11::stop("Failed to register namespace (%s <-> %s)", prefixI, urlI); } } - SEXP search(const char* xpath, int num_results) { + cpp11::sexp search(const char* xpath, int num_results) { result_ = xmlXPathEval((const xmlChar*)xpath, context_); if (result_ == NULL) { SEXP ret = PROTECT(Rf_allocVector(VECSXP, 0)); Rf_setAttrib(ret, R_ClassSymbol, Rf_mkString("xml_missing")); UNPROTECT(1); + // TODO creating an empty list doesn't work; fails test-xml_find.R:40:3 + // cpp11::writable::list ret; + // ret.attr("class") = "xml_missing"; return ret; } @@ -52,6 +57,7 @@ class XmlSeeker { { xmlNodeSet* nodes = result_->nodesetval; if (nodes == NULL || nodes->nodeNr == 0) { + // TODO SEXP ret = PROTECT(Rf_allocVector(VECSXP, 0)); Rf_setAttrib(ret, R_ClassSymbol, Rf_mkString("xml_missing")); UNPROTECT(1); @@ -59,34 +65,29 @@ class XmlSeeker { } int n = std::min(result_->nodesetval->nodeNr, num_results); - SEXP out = PROTECT(Rf_allocVector(VECSXP, n)); + cpp11::writable::list out(n); - SEXP names = PROTECT(Rf_allocVector(STRSXP, 2)); - SET_STRING_ELT(names, 0, Rf_mkChar("node")); - SET_STRING_ELT(names, 1, Rf_mkChar("doc")); + cpp11::strings names({"node", "doc"}); for (int i = 0; i < n; i++) { - SEXP ret = PROTECT(Rf_allocVector(VECSXP, 2)); - - SET_VECTOR_ELT(ret, 0, XPtrNode(nodes->nodeTab[i])); - SET_VECTOR_ELT(ret, 1, doc_); - - Rf_setAttrib(ret, R_NamesSymbol, names); - Rf_setAttrib(ret, R_ClassSymbol, Rf_mkString("xml_node")); + cpp11::writable::list ret({ + XPtrNode(nodes->nodeTab[i]), + doc_ + }); - SET_VECTOR_ELT(out, i, ret); + ret.names() = names; + ret.attr("class") = "xml_node"; - UNPROTECT(1); + out[i] = ret; } - UNPROTECT(2); return out; } - case XPATH_NUMBER: { return Rf_ScalarReal(result_->floatval); } - case XPATH_BOOLEAN: { return Rf_ScalarLogical(result_->boolval); } - case XPATH_STRING: { return Rf_ScalarString(Rf_mkCharCE((char *) result_->stringval, CE_UTF8)); } + case XPATH_NUMBER: { return cpp11::doubles({result_->floatval}); } + case XPATH_BOOLEAN: { return cpp11::logicals({result_->boolval}); } + case XPATH_STRING: { return cpp11::as_sexp((const char*) result_->stringval); } default: - Rf_error("XPath result type: %d not supported", result_->type); + cpp11::stop("XPath result type: %d not supported", result_->type); } return R_NilValue; @@ -102,17 +103,21 @@ class XmlSeeker { }; -// [[export]] -extern "C" SEXP xpath_search(SEXP node_sxp, SEXP doc_sxp, SEXP xpath_sxp, SEXP nsMap_sxp, SEXP num_results_sxp) { - +[[cpp11::register]] +cpp11::sexp xpath_search( + node_pointer node_sxp, + doc_pointer doc_sxp, + cpp11::sexp xpath_sxp, + cpp11::strings nsMap_sxp, + cpp11::doubles num_results_sxp) { XPtrNode node(node_sxp); XPtrDoc doc(doc_sxp); + // TODO can the type check be done nicer? if (TYPEOF(xpath_sxp) != STRSXP) { - Rf_error("XPath must be a string, received %s", Rf_type2char(TYPEOF(xpath_sxp))); + cpp11::stop("XPath must be a string, received %s", Rf_type2char(TYPEOF(xpath_sxp))); } - const char* xpath = CHAR(STRING_ELT(xpath_sxp, 0)); - - double num_results = REAL(num_results_sxp)[0]; + const char* xpath = cpp11::as_cpp(xpath_sxp); + double num_results = cpp11::as_cpp(num_results_sxp); if (num_results == R_PosInf) { num_results = INT_MAX; diff --git a/tests/testthat/_snaps/xml_url.md b/tests/testthat/_snaps/xml_url.md new file mode 100644 index 0000000..e2e60cf --- /dev/null +++ b/tests/testthat/_snaps/xml_url.md @@ -0,0 +1,17 @@ +# url_absolute + + Code + url_absolute(c(".", "..", "/", "/x"), c("http://hadley.nz/a/b/c/d", + "http://foo.bar")) + Condition + Error: + ! Base URL must be a character vector of length 1 + +# url_escape + + Code + url_escape("a b c", reserved = c("a", "b")) + Condition + Error: + ! `reserved` must be a character vector of length 1 + diff --git a/tests/testthat/test-xml_modify.R b/tests/testthat/test-xml_modify.R index 0678684..fd5c7ff 100644 --- a/tests/testthat/test-xml_modify.R +++ b/tests/testthat/test-xml_modify.R @@ -4,12 +4,12 @@ test_that("modifying nodes works", { expect_equal(xml_name(node), "x") - .Call(node_set_name, node$node, "y") + node_set_name(node$node, "y") expect_equal(xml_name(node), "y") expect_equal(xml_text(node), "") - .Call(node_set_content, node$node, "test") + node_set_content(node$node, "test") expect_equal(xml_text(node), "test") }) diff --git a/tests/testthat/test-xml_namespaces.R b/tests/testthat/test-xml_namespaces.R index 6ab43f6..3da8d91 100644 --- a/tests/testthat/test-xml_namespaces.R +++ b/tests/testthat/test-xml_namespaces.R @@ -20,12 +20,12 @@ test_that("aliased prefixes retained", { test_that("unique prefix-url combo unchanged", { x <- c(blah = "http://blah.com", rah = "http://rah.com") - expect_equal(.Call(unique_ns, x), x) + expect_equal(unique_ns(x), x) }) test_that("all prefixs kept", { x <- c(blah = "http://blah.com", rah = "http://blah.com") - expect_equal(names(.Call(unique_ns, x)), c("blah", "rah")) + expect_equal(names(unique_ns(x)), c("blah", "rah")) }) test_that("multiple default namespaces can be stripped", { diff --git a/tests/testthat/test-xml_url.R b/tests/testthat/test-xml_url.R index 65253bf..f796bb3 100644 --- a/tests/testthat/test-xml_url.R +++ b/tests/testthat/test-xml_url.R @@ -4,10 +4,9 @@ test_that("url_absolute", { c("http://hadley.nz/a/b/c/", "http://hadley.nz/a/b/", "http://hadley.nz/", "http://hadley.nz/x") ) - expect_error( - url_absolute(c(".", "..", "/", "/x"), c("http://hadley.nz/a/b/c/d", "http://foo.bar")), - "Base URL must be length 1" - ) + expect_snapshot(error = TRUE, { + url_absolute(c(".", "..", "/", "/x"), c("http://hadley.nz/a/b/c/d", "http://foo.bar")) + }) }) test_that("url_relative", { @@ -34,10 +33,9 @@ test_that("url_relative", { "../c" ) - expect_error( - url_relative("http://hadley.nz/a/c", c("http://hadley.nz/a/b/c/d", "http://foo.bar")), - "Base URL must be length 1" - ) + expect_snapshot(error = TRUE, { + url_relative("http://hadley.nz/a/c", c("http://hadley.nz/a/b/c/d", "http://foo.bar")) + }) }) test_that("url_parse", { @@ -75,10 +73,9 @@ test_that("url_parse", { }) test_that("url_escape", { - expect_error( - url_escape("a b c", reserved = c("a", "b")), - "`reserved` must be character vector of length 1" - ) + expect_snapshot(error = TRUE, { + url_escape("a b c", reserved = c("a", "b")) + }) expect_equal( url_escape("a b c"),