1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
#' Coerce a R list to xml nodes.
#'
#' This turns an R list into the equivalent XML document. Not all R lists will
#' produce valid XML, in particular there can only be one root node and all
#' child nodes need to be named (or empty) lists. R attributes become XML
#' attributes and R names become XML node names.
#'
#' @inheritParams as_list
#' @include as_list.R xml_parse.R
#' @export
#' @examples
# empty lists generate empty nodes
#'as_xml_document(list(x = list()))
#'
#'# Nesting multiple nodes
#'as_xml_document(list(foo = list(bar = list(baz = list()))))
#'
#'# attributes are stored as R attributes
#'as_xml_document(list(foo = structure(list(), id = "a")))
#'as_xml_document(list(foo = list(
#' bar = structure(list(), id = "a"),
#' bar = structure(list(), id = "b"))))
as_xml_document <- function(x, ...) {
UseMethod("as_xml_document")
}
#' @export
as_xml_document.character <- read_xml.character
#' @export
as_xml_document.raw <- read_xml.raw
#' @export
as_xml_document.connection <- read_xml.connection
#' @export
as_xml_document.response <- read_xml.response
#' @export
as_xml_document.list <- function(x, ...) {
if (length(x) > 1) {
stop("Root nodes must be of length 1", call. = FALSE)
}
add_node <- function(x, parent, tag = NULL) {
if (is.atomic(x)) {
return(xml_set_text(parent, as.character(x)))
}
if (!is.null(tag)) {
parent <- xml_add_child(parent, tag)
attr <- r_attrs_to_xml(attributes(x))
for (i in seq_along(attr)) {
xml_set_attr(parent, names(attr)[[i]], attr[[i]])
}
}
for (i in seq_along(x)) {
add_node(x[[i]], parent, names(x)[[i]])
}
}
doc <- xml_new_document()
add_node(x, doc)
xml_root(doc)
}
#' @export
as_xml_document.xml_node <- function(x, ...) {
xml_new_root(.value = x, ..., .copy = TRUE)
}
#' @export
as_xml_document.xml_nodeset <- function(x, root, ...) {
doc <- xml_new_root(.value = root, ..., .copy = TRUE)
for (i in seq_along(x)) {
xml_add_child(doc, x[[i]], .copy = TRUE)
}
doc
}
#' @export
as_xml_document.xml_document <- function(x, ...) {
x
}
|
