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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
#' Navigate around the family tree.
#'
#' \code{xml_children} returns only elements, \code{xml_contents} returns
#' all nodes. \code{xml_length} returns the number of children.
#' \code{xml_parent} returns the parent node, \code{xml_parents}
#' returns all parents up to the root. \code{xml_siblings} returns all nodes
#' at the same level. \code{xml_child} makes it easy to specify a specific
#' child to return.
#'
#' @inheritParams xml_name
#' @param only_elements For \code{xml_length}, should it count all children,
#' or just children that are elements (the default)?
#' @param search For \code{xml_child}, either the child number to return (by
#' position), or the name of the child node to return. If there are multiple
#' child nodes with the same name, the first will be returned
#' @return A node or nodeset (possibly empty). Results are always de-duplicated.
#' @export
#' @examples
#' x <- read_xml("<foo> <bar><boo /></bar> <baz/> </foo>")
#' xml_children(x)
#' xml_children(xml_children(x))
#' xml_siblings(xml_children(x)[[1]])
#'
#' # Note the each unique node only appears once in the output
#' xml_parent(xml_children(x))
#'
#' # Mixed content
#' x <- read_xml("<foo> a <b/> c <d>e</d> f</foo>")
#' # Childen gets the elements, contents gets all node types
#' xml_children(x)
#' xml_contents(x)
#'
#' xml_length(x)
#' xml_length(x, only_elements = FALSE)
#'
#' # xml_child makes it easier to select specific children
#' xml_child(x)
#' xml_child(x, 2)
#' xml_child(x, "baz")
xml_children <- function(x) {
nodeset_apply(x, node_children)
}
#' @export
#' @rdname xml_children
xml_child <- function(x, search = 1, ns = xml_ns(x)) {
if (length(search) != 1) {
stop("`search` must be of length 1", call. = FALSE)
}
if (is.numeric(search)) {
xml_children(x)[[search]]
} else if (is.character(search)) {
xml_find_first(x, xpath = paste0("./", search), ns = ns)
} else {
stop("`search` must be `numeric` or `character`", call. = FALSE)
}
}
#' @export
#' @rdname xml_children
xml_contents <- function(x) {
nodeset_apply(x, node_children, onlyNode = FALSE)
}
#' @export
#' @rdname xml_children
xml_parents <- function(x) {
nodeset_apply(x, node_parents)
}
#' @export
#' @rdname xml_children
xml_siblings <- function(x) {
nodeset_apply(x, node_siblings)
}
#' @export
#' @rdname xml_children
xml_parent <- function(x) {
UseMethod("xml_parent")
}
#' @export
xml_parent.xml_missing <- function(x) {
xml_missing()
}
#' @export
xml_parent.xml_node <- function(x) {
xml_node(node_parent(x$node), x$doc)
}
#' @export
xml_parent.xml_nodeset <- function(x) {
nodeset_apply(x, node_parent)
}
#' @export
#' @rdname xml_children
xml_length <- function(x, only_elements = TRUE) {
UseMethod("xml_length")
}
#' @export
xml_length.xml_missing <- function(x, only_elements = TRUE) {
0L
}
#' @export
xml_length.xml_node <- function(x, only_elements = TRUE) {
node_length(x$node, onlyNode = only_elements)
}
#' @export
xml_length.xml_nodeset <- function(x, only_elements = TRUE) {
if (length(x) == 0)
return(0L)
vapply(x, xml_length, only_elements = only_elements, FUN.VALUE = integer(1))
}
#' @export
#' @rdname xml_children
xml_root <- function(x) {
stopifnot(inherits(x, c("xml_node", "xml_document", "xml_nodeset")))
if (inherits(x, "xml_nodeset")) {
if (length(x) == 0) {
return(NULL)
} else {
return(xml_root(x[[1]]))
}
}
if (!doc_has_root(x$doc)) {
xml_missing()
} else {
xml_document(x$doc)
}
}
|
