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
|
#' Write XML or HTML to disk.
#'
#' This writes out both XML and normalised HTML. The default behavior will
#' output the same format which was read. If you want to force output pass
#' `option = "as_xml"` or `option = "as_html"` respectively.
#'
#' @param x A document or node to write to disk. It's not possible to
#' save nodesets containing more than one node.
#' @param file Path to file or connection to write to.
#' @param encoding The character encoding to use in the document. The default
#' encoding is \sQuote{UTF-8}. Available encodings are specified at
#' <http://xmlsoft.org/html/libxml-encoding.html#xmlCharEncoding>.
#' @param options default: \sQuote{format}. Zero or more of
#' \Sexpr[results=rd, stage=build]{xml2:::describe_options(xml2:::xml_save_options())}
#' @param ... additional arguments passed to methods.
#' @export
#' @examples
#' h <- read_html("<p>Hi!</p>")
#'
#' tmp <- tempfile(fileext = ".xml")
#' write_xml(h, tmp, options = "format")
#' readLines(tmp)
#'
#' # write formatted HTML output
#' write_html(h, tmp, options = "format")
#' readLines(tmp)
write_xml <- function(x, file, ...) {
UseMethod("write_xml")
}
#' @export
write_xml.xml_missing <- function(x, file, ...) {
cli::cli_abort("Missing data cannot be written.")
}
#' @rdname write_xml
#' @export
write_xml.xml_document <- function(
x,
file,
...,
options = "format",
encoding = "UTF-8"
) {
options <- parse_options(options, xml_save_options())
file <- path_to_connection(file, check = "dir")
if (inherits(file, "connection")) {
if (!isOpen(file)) {
open(file, "wb")
on.exit(close(file))
}
.Call(doc_write_connection, x$doc, file, encoding, options)
} else {
check_string(file)
.Call(doc_write_file, x$doc, file, encoding, options)
}
invisible()
}
#' @export
write_xml.xml_nodeset <- function(
x,
file,
...,
options = "format",
encoding = "UTF-8"
) {
if (length(x) != 1) {
cli::cli_abort("Can only save length 1 node sets.")
}
options <- parse_options(options, xml_save_options())
file <- path_to_connection(file, check = "dir")
if (inherits(file, "connection")) {
if (!isOpen(file)) {
open(file, "wb")
on.exit(close(file))
}
.Call(node_write_connection, x[[1]]$node, file, encoding, options)
} else {
check_string(file)
.Call(node_write_file, x[[1]]$node, file, encoding, options)
}
invisible()
}
#' @export
write_xml.xml_node <- function(
x,
file,
...,
options = "format",
encoding = "UTF-8"
) {
options <- parse_options(options, xml_save_options())
file <- path_to_connection(file, check = "dir")
if (inherits(file, "connection")) {
if (!isOpen(file)) {
open(file, "wb")
on.exit(close(file))
}
.Call(node_write_connection, x$node, file, encoding, options)
} else {
check_string(file)
.Call(node_write_file, x$node, file, encoding, options)
}
invisible()
}
#' @export
#' @rdname write_xml
write_html <- function(x, file, ...) {
UseMethod("write_html")
}
#' @export
write_html.xml_missing <- function(x, file, ...) {
cli::cli_abort("Missing data cannot be written.")
}
#' @rdname write_xml
#' @export
write_html.xml_document <- write_xml.xml_document
#' @export
write_html.xml_nodeset <- write_xml.xml_nodeset
#' @export
write_html.xml_node <- write_xml.xml_node
|
