1#' Navigate around the family tree.
2#'
3#' `xml_children` returns only elements, `xml_contents` returns
4#' all nodes. `xml_length` returns the number of children.
5#' `xml_parent` returns the parent node, `xml_parents`
6#' returns all parents up to the root. `xml_siblings` returns all nodes
7#' at the same level. `xml_child` makes it easy to specify a specific
8#' child to return.
9#'
10#' @inheritParams xml_name
11#' @param only_elements For `xml_length`, should it count all children,
12#'   or just children that are elements (the default)?
13#' @param search For `xml_child`, either the child number to return (by
14#'   position), or the name of the child node to return. If there are multiple
15#'   child nodes with the same name, the first will be returned
16#' @return A node or nodeset (possibly empty). Results are always de-duplicated.
17#' @export
18#' @examples
19#' x <- read_xml("<foo> <bar><boo /></bar> <baz/> </foo>")
20#' xml_children(x)
21#' xml_children(xml_children(x))
22#' xml_siblings(xml_children(x)[[1]])
23#'
24#' # Note the each unique node only appears once in the output
25#' xml_parent(xml_children(x))
26#'
27#' # Mixed content
28#' x <- read_xml("<foo> a <b/> c <d>e</d> f</foo>")
29#' # Childen gets the elements, contents gets all node types
30#' xml_children(x)
31#' xml_contents(x)
32#'
33#' xml_length(x)
34#' xml_length(x, only_elements = FALSE)
35#'
36#' # xml_child makes it easier to select specific children
37#' xml_child(x)
38#' xml_child(x, 2)
39#' xml_child(x, "baz")
40xml_children <- function(x) {
41  nodeset_apply(x, function(x) .Call(node_children, x, TRUE))
42}
43
44#' @export
45#' @rdname xml_children
46xml_child <- function(x, search = 1, ns = xml_ns(x)) {
47  if (length(search) != 1) {
48    stop("`search` must be of length 1", call. = FALSE)
49  }
50
51  if (is.numeric(search)) {
52    xml_children(x)[[search]]
53  } else if (is.character(search)) {
54    xml_find_first(x, xpath = paste0("./", search), ns = ns)
55  } else {
56    stop("`search` must be `numeric` or `character`", call. = FALSE)
57  }
58}
59
60#' @export
61#' @rdname xml_children
62xml_contents <- function(x) {
63  nodeset_apply(x, function(x) .Call(node_children, x, FALSE))
64}
65
66#' @export
67#' @rdname xml_children
68xml_parents <- function(x) {
69  nodeset_apply(x, function(x) .Call(node_parents, x))
70}
71
72#' @export
73#' @rdname xml_children
74xml_siblings <- function(x) {
75  nodeset_apply(x, function(x) .Call(node_siblings, x, TRUE))
76}
77
78#' @export
79#' @rdname xml_children
80xml_parent <- function(x) {
81  UseMethod("xml_parent")
82}
83
84#' @export
85xml_parent.xml_missing <- function(x) {
86  xml_missing()
87}
88
89#' @export
90xml_parent.xml_node <- function(x) {
91  xml_node(.Call(node_parent, x$node), x$doc)
92}
93
94#' @export
95xml_parent.xml_nodeset <- function(x) {
96  nodeset_apply(x, function(x) .Call(node_parent, x))
97}
98
99
100#' @export
101#' @rdname xml_children
102xml_length <- function(x, only_elements = TRUE) {
103  UseMethod("xml_length")
104}
105
106#' @export
107xml_length.xml_missing <- function(x, only_elements = TRUE) {
108  0L
109}
110
111#' @export
112xml_length.xml_node <- function(x, only_elements = TRUE) {
113  .Call(node_length, x$node, only_elements)
114}
115
116#' @export
117xml_length.xml_nodeset <- function(x, only_elements = TRUE) {
118  if (length(x) == 0)
119    return(0L)
120
121  vapply(x, xml_length, only_elements = only_elements, FUN.VALUE = integer(1))
122}
123
124#' @export
125#' @rdname xml_children
126xml_root <- function(x) {
127  stopifnot(inherits(x, c("xml_node", "xml_document", "xml_nodeset")))
128
129  if (inherits(x, "xml_nodeset")) {
130    if (length(x) == 0) {
131      return(NULL)
132    } else {
133      return(xml_root(x[[1]]))
134    }
135  }
136  if (!.Call(doc_has_root, x$doc)) {
137    xml_missing()
138  } else {
139    xml_document(x$doc)
140  }
141}
142