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