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
142
143
144
145
146
147
148
|
GeneralHandlerNames =
list(SAX = c("text", "startElement", "endElement", "comment",
"startDocument", "endDocument",
"processingInstruction", "entityDeclaration", "externalEntity"),
DOM = c("text", "startElement", "comment", "entity", "cdata",
"processingInstruction"))
checkHandlerNames =
function(handlers, id = "SAX")
{
if(is.null(handlers))
return(TRUE)
ids = names(handlers)
i = match(ids, GeneralHandlerNames)
prob = any(!is.na(i))
if(prob) {
warning("future versions of the XML package will require names of general handler functions to be prefixed by a . to distinguish them from handlers for nodes with those names. This _may_ affect the ", paste(names(handlers)[!is.na(i)], collapse = ", "))
}
if(any(w <- !sapply(handlers, is.function)))
warning("some handlers are not functions: ", paste(names(handlers[w]), collapse = ", "))
!prob
}
xmlEventParse <-
#
# Parses an XML file using an event parser which calls user-level functions in the
# `handlers' collection when different XML nodes are encountered in the parse stream.
#
# See also xmlParseTree()
#
function(file, handlers = xmlEventHandler(), ignoreBlanks = FALSE, addContext = TRUE,
useTagName = TRUE, asText = FALSE, trim=TRUE, useExpat = FALSE,
isURL=FALSE, state = NULL,
replaceEntities = TRUE, validate = FALSE, saxVersion = 1,
branches = NULL, useDotNames = length(grep("^\\.", names(handlers))) > 0,
error = xmlErrorCumulator(), addFinalizer = NA)
{
if(libxmlVersion()$major < 2 && !is.character(file))
stop("Without libxml2, the source of the XML can only be specified as a URI.")
i = grep("^/", names(handlers))
if(length(i)) {
endElementHandlers = handlers[i]
names(endElementHandlers) = gsub("^/", "", names(endElementHandlers))
handlers = handlers[ - i]
} else
endElementHandlers = list()
checkHandlerNames(handlers, "SAX")
if(validate)
warning("Currently, libxml2 does support validation using SAX/event-driven parsing. It requires a DOM.")
else {
oldValidate = xmlValidity()
xmlValidity(validate)
on.exit(xmlValidity(oldValidate))
}
if(!any(saxVersion == c(1, 2))) {
stop("saxVersion must be 1 or 2")
}
if(inherits(file, "connection")) {
con = file
if(!isOpen(file)) {
open(file, "r")
on.exit(close(con))
}
file = function(len) {
txt = readLines(con, 1)
if(length(txt) == 0) return(txt)
paste(txt, "\n", sep = "")
}
} else if(is.function(file)) {
# call with -1 to allow us to close the connection
# if necessary.
on.exit(file(-1))
} else {
if(!asText && missing(isURL)) {
# check if this is a URL or regular file.
isURL <- length(grep("http://",file)) | length(grep("ftp://",file)) | length(grep("file://",file))
}
if(isURL == FALSE && asText == FALSE) {
file = path.expand(file)
if(file.exists(file) == FALSE)
stop(paste("File", file, "does not exist "))
}
file = as.character(file)
}
branches = as.list(branches)
if(length(branches) > 0 && (length(names(branches)) == 0 || any(names(branches) == "")))
stop("All branch elements must have a name!")
old = setEntitySubstitution(replaceEntities)
on.exit(setEntitySubstitution(old))
if(!is.function(error))
stop("error must be a function")
.oldErrorHandler = setXMLErrorHandler(error)
on.exit(.Call("RS_XML_setStructuredErrorHandler", .oldErrorHandler, PACKAGE = "XML"), add = TRUE)
state <- .Call("RS_XML_Parse", file, handlers, endElementHandlers,
as.logical(addContext), as.logical(ignoreBlanks),
as.logical(useTagName), as.logical(asText), as.logical(trim),
as.logical(useExpat), state, as.logical(replaceEntities),
as.logical(validate), as.integer(saxVersion), branches, as.logical(useDotNames), error,
addFinalizer,
PACKAGE = "XML")
if(!is.null(state))
return(state)
else
return(invisible(handlers))
}
xmlStopParser =
function(parser)
{
if(!inherits(parser, "XMLParserContext"))
stop("Need an XMLParserContext object for xmlStopParser")
.Call("RS_XML_xmlStopParser", parser, PACKAGE = "XML")
}
xmlParserContextFunction =
function(f, class = "XMLParserContextFunction")
{
class(f) = c(class, class(f))
f
}
|
