Implement xml_attr

Author: hadley

NAMESPACE

@@ -3,6 +3,9 @@
 S3method(print,xml_doc)
 S3method(print,xml_node)
 S3method(print,xml_nodeset)
+S3method(xml_attr,xml_doc)
+S3method(xml_attr,xml_node)
+S3method(xml_attr,xml_nodeset)
 S3method(xml_children,xml_doc)
 S3method(xml_children,xml_node)
 S3method(xml_children,xml_nodeset)
@@ -15,6 +18,7 @@ S3method(xml_root,xml_nodeset)
 S3method(xml_text,xml_doc)
 S3method(xml_text,xml_node)
 S3method(xml_text,xml_nodeset)
+export(xml_attr)
 export(xml_children)
 export(xml_name)
 export(xml_parse)

R/RcppExports.R

@@ -45,6 +45,10 @@ node_text <- function(node) {
     .Call('xml2_node_text', PACKAGE = 'xml2', node)
 }
 
+node_attr <- function(node, name) {
+    .Call('xml2_node_attr', PACKAGE = 'xml2', node, name)
+}
+
 node_format <- function(doc, node, format = TRUE, indent = 0L) {
     .Call('xml2_node_format', PACKAGE = 'xml2', doc, node, format, indent)
 }

R/xml_attr.R

@@ -0,0 +1,30 @@
+#' Retrieve an attribute.
+#'
+#' @inheritParams xml_name
+#' @param attr Name of attribute to extract.
+#' @return A character vector. If an attribute is not presented, its
+#'  value will be missing.
+#' @export
+#' @examples
+#' x <- xml_parse("<root id='1'><child id ='a' /><child id='b' d='b'/></root>")
+#' xml_attr(x, "id")
+#' xml_attr(xml_children(x), "id")
+#' xml_attr(xml_children(x), "d")
+xml_attr <- function(x, attr, ...) {
+  UseMethod("xml_attr")
+}
+
+#' @export
+xml_attr.xml_node <- function(x, attr, ...) {
+  node_attr(x$node, attr)
+}
+
+#' @export
+xml_attr.xml_doc <- function(x, attr, ...) {
+  node_attr(doc_root(x$doc), attr)
+}
+
+#' @export
+xml_attr.xml_nodeset <- function(x, attr, ...) {
+  vapply(x, xml_attr, attr = attr, ..., FUN.VALUE = character(1))
+}

man/xml_attr.Rd

@@ -0,0 +1,29 @@
+% Generated by roxygen2 (4.1.0): do not edit by hand
+% Please edit documentation in R/xml_attr.R
+\name{xml_attr}
+\alias{xml_attr}
+\title{Retrieve an attribute.}
+\usage{
+xml_attr(x, attr, ...)
+}
+\arguments{
+\item{x}{A document, node, or node set.}
+
+\item{attr}{Name of attribute to extract.}
+
+\item{...}{Additional arguments passed down to methods. (Not currently used).}
+}
+\value{
+A character vector. If an attribute is not presented, its
+ value will be missing.
+}
+\description{
+Retrieve an attribute.
+}
+\examples{
+x <- xml_parse("<root id='1'><child id ='a' /><child id='b' d='b'/></root>")
+xml_attr(x, "id")
+xml_attr(xml_children(x), "id")
+xml_attr(xml_children(x), "d")
+}
+

src/RcppExports.cpp

@@ -135,6 +135,18 @@ BEGIN_RCPP
     return __result;
 END_RCPP
 }
+// node_attr
+CharacterVector node_attr(XPtrNode node, std::string name);
+RcppExport SEXP xml2_node_attr(SEXP nodeSEXP, SEXP nameSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject __result;
+    Rcpp::RNGScope __rngScope;
+    Rcpp::traits::input_parameter< XPtrNode >::type node(nodeSEXP);
+    Rcpp::traits::input_parameter< std::string >::type name(nameSEXP);
+    __result = Rcpp::wrap(node_attr(node, name));
+    return __result;
+END_RCPP
+}
 // node_format
 CharacterVector node_format(XPtrDoc doc, XPtrNode node, bool format = true, int indent = 0);
 RcppExport SEXP xml2_node_format(SEXP docSEXP, SEXP nodeSEXP, SEXP formatSEXP, SEXP indentSEXP) {

src/xml2_node.cpp

@@ -12,6 +12,19 @@ CharacterVector node_name(XPtrNode node) {
 CharacterVector node_text(XPtrNode node) {
   xmlChar* s = xmlNodeGetContent(node.get());
   CharacterVector out = xmlCharToRChar(s);
+  if (s != NULL)
+    xmlFree(s);
+
+  return out;
+}
+
+// [[Rcpp::export]]
+CharacterVector node_attr(XPtrNode node, std::string name) {
+  xmlChar* s = xmlGetProp(node.get(), (xmlChar*) name.c_str());
+
+  CharacterVector out = xmlCharToRChar(s);
+  if (s != NULL)
+    xmlFree(s);
 
   return out;
 }

src/xml2_utils.h

@@ -6,7 +6,7 @@
 
 inline Rcpp::CharacterVector xmlCharToRChar(const xmlChar* x) {
   if (x == NULL)
-    Rcpp::stop("Null string");
+    return Rcpp::CharacterVector::create(NA_STRING);
 
   Rcpp::CharacterVector out(1);
   out[0] = Rf_mkCharCE((char*) x, CE_UTF8);