more pugixml functions

[JanMarvin]

The following matches a few xml2 functions used in mschart. Not sure if we really have a need for any of this, but I was curious what is used and not currently supported by us. We have a couple of functions that provide similar things, but a) I've only implemented nesting of 3 nodes (mschart requires more).

// xml_find_node
// @param node xml_node a child is searched in
// @param child the xml_node to search
// @param pointer bool if pointer should be returned
// @param escapes bool if escapes should be used
// @export
// [[Rcpp::export]]
SEXP xml_find_node(XPtrXML node, std::string chld) {

  struct Local {
    Local(std::string chld) {this->chld = chld;}

    // // find attribute
    // bool operator()(pugi::xml_attribute attr) const {
    //   return strcmp(attr.name(), "e") == 0;
    // }

    bool operator()(pugi::xml_node node) const {
      std::string xml_name = node.name();
      return xml_name.compare(chld.c_str()) == 0;
    }

    std::string chld;
  };

  unsigned int pugi_format_flags = pugi_format(node);
  pugi::xml_node found = node->find_node(Local(chld));
  // could return the value instead

  std::ostringstream oss;
  found.print(oss, " ", pugi_format_flags);
  SEXP name = Rcpp::wrap(Rcpp::String(oss.str()));

  Rcpp::CharacterVector out = Rcpp::wrap(Rcpp::String(found.path()));
  out.attr("names") = name;

  return out;
}

// xml_remove_child
// @param node xml_node a child is searched in
// @param path the xpath to the node to remove
// @param pointer bool if pointer should be returned
// @export
// [[Rcpp::export]]
SEXP xml_remove_child(XPtrXML node, std::string path, bool pointer) {

  unsigned int pugi_format_flags = pugi_format(node);

  pugi::xml_node got = node->select_node(path.c_str()).node();
  node->select_node(path.c_str()).parent().remove_child(got);

  if (pointer) {
    return (node);
  } else {
    std::ostringstream oss;
    node->print(oss, " ", pugi_format_flags);
    return Rcpp::wrap(Rcpp::String(oss.str()));
  }
}

// xml_replace_node
// @param node xml_node a child is searched in
// @param child the xml_node to search
// @param pointer bool if pointer should be returned
// @param escapes bool if escapes should be used
// @export
// [[Rcpp::export]]
SEXP xml_replace_child(XPtrXML node, std::string path, std::string replacement, bool escapes, bool pointer) {


  // pugi::parse_default without escapes flag
  unsigned int pugi_parse_flags = pugi::parse_cdata | pugi::parse_wconv_attribute | pugi::parse_ws_pcdata | pugi::parse_eol;
  if (escapes) pugi_parse_flags |= pugi::parse_escapes;

  unsigned int pugi_format_flags = pugi_format(node);

  pugi::xml_node got = node->select_node(path.c_str()).node();

  pugi::xml_document rplcmnt;
  pugi::xml_parse_result result = rplcmnt.load_string(replacement.c_str(), pugi_parse_flags);

  // check if result is a valid xml_node
  if (result) {
    node->select_node(path.c_str()).parent().insert_copy_after(rplcmnt.first_child(), got);
  } else {
    Rf_error("oops");
  }
  node->select_node(path.c_str()).parent().remove_child(got);

  if (pointer) {
    return (node);
  } else {
    std::ostringstream oss;
    node->print(oss, " ", pugi_format_flags);
    return Rcpp::wrap(Rcpp::String(oss.str()));
  }
}

library(openxlsx2)

xml_str <- "<a><b><c><d><e/><f/></d></c></b></a>"

# xml <- xml2::read_xml(xml_str)
# 
# xml_remove(xml_find_first(xml, "//e"))
# 
# tmp <- tempfile(fileext = ".xml")
# write_xml(xml, tmp)
# openxlsx2::read_xml(tmp)

# xml2::xml_find_first
openxlsx2:::xml_find_node(openxlsx2::read_xml(xml_str), "e")
#>         <e/> 
#> "/a/b/c/d/e"

# xml2::xml-remove
openxlsx2:::xml_remove_child(
  openxlsx2::read_xml(xml_str),
  openxlsx2:::xml_find_node(openxlsx2::read_xml(xml_str), "e"),
  FALSE
)
#> [1] "<a><b><c><d><f/></d></c></b></a>"

# xml2::xml_replace
openxlsx2:::xml_replace_child(
  openxlsx2::read_xml(xml_str),
  openxlsx2:::xml_find_node(openxlsx2::read_xml(xml_str), "e"),
  "<k/>",
  FALSE,
  FALSE
)
#> [1] "<a><b><c><d><k/><f/></d></c></b></a>"

# xml2::attr<-
openxlsx2:::xml_replace_child(
  openxlsx2::read_xml(xml_str),
  openxlsx2:::xml_find_node(openxlsx2::read_xml(xml_str), "e"),
  xml_attr_mod(
    names(openxlsx2:::xml_find_node(openxlsx2::read_xml(xml_str), "e")),
    c("val" = "1")
    ),
  FALSE,
  FALSE
)
#> [1] "<a><b><c><d><e val=\"1\"/><f/></d></c></b></a>"