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
|
#' Serializing XML objects to connections.
#'
#' @inheritParams base::serialize
#' @param ... Additional arguments passed to [read_xml()].
#' @inherit base::serialize return
#' @examples
#' library(xml2)
#' x <- read_xml("<a>
#' <b><c>123</c></b>
#' <b><c>456</c></b>
#' </a>")
#'
#' b <- xml_find_all(x, "//b")
#' out <- xml_serialize(b, NULL)
#' xml_unserialize(out)
#' @export
xml_serialize <- function(object, connection, ...) UseMethod("xml_serialize")
#' @export
xml_serialize.xml_document <- function(object, connection, ...) {
if (is.character(connection)) {
connection <- file(connection, "w", raw = TRUE)
on.exit(close(connection))
}
serialize(structure(as.character(object, ...), doc_type = doc_type(object), class = "xml_serialized_document"), connection)
}
#' @export
xml_serialize.xml_node <- function(object, connection, ...) {
if (is.character(connection)) {
connection <- file(connection, "w", raw = TRUE)
on.exit(close(connection))
}
x <- as_xml_document(object)
serialize(structure(as.character(x, ...), class = "xml_serialized_node"), connection)
}
#' @export
xml_serialize.xml_nodeset <- function(object, connection, ...) {
if (is.character(connection)) {
connection <- file(connection, "w", raw = TRUE)
on.exit(close(connection))
}
x <- as_xml_document(object, "root")
serialize(structure(as.character(x, ...), class = "xml_serialized_nodeset"), connection)
}
#' @rdname xml_serialize
#' @export
xml_unserialize <- function(connection, ...) {
if (is.character(connection)) {
connection <- file(connection, "r", raw = TRUE)
on.exit(close(connection))
}
object <- unserialize(connection)
if (inherits(object, "xml_serialized_nodeset")) {
x <- read_xml(unclass(object), ...)
# Select only the direct children of the root
res <- xml_find_all(x, "/*/node()")
} else if (inherits(object, "xml_serialized_node")) {
x <- read_xml(unclass(object), ...)
# Select only the root
res <- xml_find_first(x, "/node()")
} else if (inherits(object, "xml_serialized_document")) {
read_xml_int <- function(object, as_html = FALSE, ...) {
if (missing(as_html)) {
as_html <- identical(attr(object, "doc_type", exact = TRUE), "html")
}
read_xml(unclass(object), as_html = as_html, ...)
}
res <- read_xml_int(unclass(object), ...)
} else {
cli::cli_abort("Not a serialized xml2 object.")
}
res
}
|
