line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# $Id$ |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# This is free software, you may use it and distribute it under the same terms as |
5
|
|
|
|
|
|
|
# Perl itself. |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
# Copyright 2001-2003 AxKit.com Ltd., 2002-2006 Christian Glahn, 2006-2009 Petr Pajas |
8
|
|
|
|
|
|
|
# |
9
|
|
|
|
|
|
|
# |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
package XML::LibXML; |
12
|
|
|
|
|
|
|
|
13
|
67
|
|
|
67
|
|
5328617
|
use strict; |
|
67
|
|
|
|
|
644
|
|
|
67
|
|
|
|
|
1829
|
|
14
|
67
|
|
|
67
|
|
296
|
use warnings; |
|
67
|
|
|
|
|
122
|
|
|
67
|
|
|
|
|
2341
|
|
15
|
|
|
|
|
|
|
|
16
|
67
|
|
|
|
|
8650
|
use vars qw($VERSION $ABI_VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS |
17
|
|
|
|
|
|
|
$skipDTD $skipXMLDeclaration $setTagCompression |
18
|
|
|
|
|
|
|
$MatchCB $ReadCB $OpenCB $CloseCB %PARSER_FLAGS |
19
|
|
|
|
|
|
|
$XML_LIBXML_PARSE_DEFAULTS |
20
|
67
|
|
|
67
|
|
312
|
); |
|
67
|
|
|
|
|
126
|
|
21
|
67
|
|
|
67
|
|
402
|
use Carp; |
|
67
|
|
|
|
|
111
|
|
|
67
|
|
|
|
|
4154
|
|
22
|
|
|
|
|
|
|
|
23
|
67
|
|
|
67
|
|
405
|
use constant XML_XMLNS_NS => 'http://www.w3.org/2000/xmlns/'; |
|
67
|
|
|
|
|
114
|
|
|
67
|
|
|
|
|
6377
|
|
24
|
67
|
|
|
67
|
|
386
|
use constant XML_XML_NS => 'http://www.w3.org/XML/1998/namespace'; |
|
67
|
|
|
|
|
134
|
|
|
67
|
|
|
|
|
3099
|
|
25
|
|
|
|
|
|
|
|
26
|
67
|
|
|
67
|
|
26463
|
use XML::LibXML::Error; |
|
67
|
|
|
|
|
182
|
|
|
67
|
|
|
|
|
2680
|
|
27
|
67
|
|
|
67
|
|
30519
|
use XML::LibXML::NodeList; |
|
67
|
|
|
|
|
168
|
|
|
67
|
|
|
|
|
1888
|
|
28
|
67
|
|
|
67
|
|
29425
|
use XML::LibXML::XPathContext; |
|
67
|
|
|
|
|
151
|
|
|
67
|
|
|
|
|
1758
|
|
29
|
67
|
|
|
67
|
|
32982
|
use IO::Handle; # for FH reads called as methods |
|
67
|
|
|
|
|
357124
|
|
|
67
|
|
|
|
|
4608
|
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
BEGIN { |
32
|
67
|
|
|
67
|
|
314
|
$VERSION = "2.0208"; # VERSION TEMPLATE: DO NOT CHANGE |
33
|
67
|
|
|
|
|
133
|
$ABI_VERSION = 2; |
34
|
67
|
|
|
|
|
357
|
require Exporter; |
35
|
67
|
|
|
67
|
|
544
|
use XSLoader (); |
|
67
|
|
|
|
|
133
|
|
|
67
|
|
|
|
|
1953
|
|
36
|
67
|
|
|
|
|
1191
|
@ISA = qw(Exporter); |
37
|
|
|
|
|
|
|
|
38
|
67
|
|
|
67
|
|
344
|
use vars qw($__PROXY_NODE_REGISTRY $__threads_shared $__PROXY_NODE_REGISTRY_MUTEX $__loaded); |
|
67
|
|
|
|
|
120
|
|
|
67
|
|
|
|
|
22718
|
|
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub VERSION { |
41
|
0
|
|
|
0
|
0
|
0
|
my $class = shift; |
42
|
0
|
|
|
|
|
0
|
my ($caller) = caller; |
43
|
0
|
|
|
|
|
0
|
my $req_abi = $ABI_VERSION; |
44
|
0
|
0
|
|
|
|
0
|
if (UNIVERSAL::can($caller,'REQUIRE_XML_LIBXML_ABI_VERSION')) { |
|
|
0
|
|
|
|
|
|
45
|
0
|
|
|
|
|
0
|
$req_abi = $caller->REQUIRE_XML_LIBXML_ABI_VERSION(); |
46
|
|
|
|
|
|
|
} elsif ($caller eq 'XML::LibXSLT') { |
47
|
|
|
|
|
|
|
# XML::LibXSLT without REQUIRE_XML_LIBXML_ABI_VERSION is an old and incompatible version |
48
|
0
|
|
|
|
|
0
|
$req_abi = 1; |
49
|
|
|
|
|
|
|
} |
50
|
0
|
0
|
|
|
|
0
|
unless ($req_abi == $ABI_VERSION) { |
51
|
0
|
0
|
|
|
|
0
|
my $ver = @_ ? ' '.$_[0] : ''; |
52
|
0
|
|
|
|
|
0
|
die ("This version of $caller requires XML::LibXML$ver (ABI $req_abi), which is incompatible with currently installed XML::LibXML $VERSION (ABI $ABI_VERSION). Please upgrade $caller, XML::LibXML, or both!"); |
53
|
|
|
|
|
|
|
} |
54
|
0
|
|
|
|
|
0
|
return $class->UNIVERSAL::VERSION(@_) |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
58
|
|
|
|
|
|
|
# export information # |
59
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
60
|
67
|
|
|
|
|
1067
|
%EXPORT_TAGS = ( |
61
|
|
|
|
|
|
|
all => [qw( |
62
|
|
|
|
|
|
|
XML_ELEMENT_NODE |
63
|
|
|
|
|
|
|
XML_ATTRIBUTE_NODE |
64
|
|
|
|
|
|
|
XML_TEXT_NODE |
65
|
|
|
|
|
|
|
XML_CDATA_SECTION_NODE |
66
|
|
|
|
|
|
|
XML_ENTITY_REF_NODE |
67
|
|
|
|
|
|
|
XML_ENTITY_NODE |
68
|
|
|
|
|
|
|
XML_PI_NODE |
69
|
|
|
|
|
|
|
XML_COMMENT_NODE |
70
|
|
|
|
|
|
|
XML_DOCUMENT_NODE |
71
|
|
|
|
|
|
|
XML_DOCUMENT_TYPE_NODE |
72
|
|
|
|
|
|
|
XML_DOCUMENT_FRAG_NODE |
73
|
|
|
|
|
|
|
XML_NOTATION_NODE |
74
|
|
|
|
|
|
|
XML_HTML_DOCUMENT_NODE |
75
|
|
|
|
|
|
|
XML_DTD_NODE |
76
|
|
|
|
|
|
|
XML_ELEMENT_DECL |
77
|
|
|
|
|
|
|
XML_ATTRIBUTE_DECL |
78
|
|
|
|
|
|
|
XML_ENTITY_DECL |
79
|
|
|
|
|
|
|
XML_NAMESPACE_DECL |
80
|
|
|
|
|
|
|
XML_XINCLUDE_END |
81
|
|
|
|
|
|
|
XML_XINCLUDE_START |
82
|
|
|
|
|
|
|
encodeToUTF8 |
83
|
|
|
|
|
|
|
decodeFromUTF8 |
84
|
|
|
|
|
|
|
XML_XMLNS_NS |
85
|
|
|
|
|
|
|
XML_XML_NS |
86
|
|
|
|
|
|
|
)], |
87
|
|
|
|
|
|
|
libxml => [qw( |
88
|
|
|
|
|
|
|
XML_ELEMENT_NODE |
89
|
|
|
|
|
|
|
XML_ATTRIBUTE_NODE |
90
|
|
|
|
|
|
|
XML_TEXT_NODE |
91
|
|
|
|
|
|
|
XML_CDATA_SECTION_NODE |
92
|
|
|
|
|
|
|
XML_ENTITY_REF_NODE |
93
|
|
|
|
|
|
|
XML_ENTITY_NODE |
94
|
|
|
|
|
|
|
XML_PI_NODE |
95
|
|
|
|
|
|
|
XML_COMMENT_NODE |
96
|
|
|
|
|
|
|
XML_DOCUMENT_NODE |
97
|
|
|
|
|
|
|
XML_DOCUMENT_TYPE_NODE |
98
|
|
|
|
|
|
|
XML_DOCUMENT_FRAG_NODE |
99
|
|
|
|
|
|
|
XML_NOTATION_NODE |
100
|
|
|
|
|
|
|
XML_HTML_DOCUMENT_NODE |
101
|
|
|
|
|
|
|
XML_DTD_NODE |
102
|
|
|
|
|
|
|
XML_ELEMENT_DECL |
103
|
|
|
|
|
|
|
XML_ATTRIBUTE_DECL |
104
|
|
|
|
|
|
|
XML_ENTITY_DECL |
105
|
|
|
|
|
|
|
XML_NAMESPACE_DECL |
106
|
|
|
|
|
|
|
XML_XINCLUDE_END |
107
|
|
|
|
|
|
|
XML_XINCLUDE_START |
108
|
|
|
|
|
|
|
)], |
109
|
|
|
|
|
|
|
encoding => [qw( |
110
|
|
|
|
|
|
|
encodeToUTF8 |
111
|
|
|
|
|
|
|
decodeFromUTF8 |
112
|
|
|
|
|
|
|
)], |
113
|
|
|
|
|
|
|
ns => [qw( |
114
|
|
|
|
|
|
|
XML_XMLNS_NS |
115
|
|
|
|
|
|
|
XML_XML_NS |
116
|
|
|
|
|
|
|
)], |
117
|
|
|
|
|
|
|
); |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
@EXPORT_OK = ( |
120
|
67
|
|
|
|
|
204
|
@{$EXPORT_TAGS{all}}, |
|
67
|
|
|
|
|
486
|
|
121
|
|
|
|
|
|
|
); |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
@EXPORT = ( |
124
|
67
|
|
|
|
|
151
|
@{$EXPORT_TAGS{all}}, |
|
67
|
|
|
|
|
399
|
|
125
|
|
|
|
|
|
|
); |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
128
|
|
|
|
|
|
|
# initialization of the global variables # |
129
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
130
|
67
|
|
|
|
|
155
|
$skipDTD = 0; |
131
|
67
|
|
|
|
|
128
|
$skipXMLDeclaration = 0; |
132
|
67
|
|
|
|
|
100
|
$setTagCompression = 0; |
133
|
|
|
|
|
|
|
|
134
|
67
|
|
|
|
|
123
|
$MatchCB = undef; |
135
|
67
|
|
|
|
|
131
|
$ReadCB = undef; |
136
|
67
|
|
|
|
|
123
|
$OpenCB = undef; |
137
|
67
|
|
|
|
|
126
|
$CloseCB = undef; |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
# if ($threads::threads) { |
140
|
|
|
|
|
|
|
# our $__THREADS_TID = 0; |
141
|
|
|
|
|
|
|
# eval q{ |
142
|
|
|
|
|
|
|
# use threads::shared; |
143
|
|
|
|
|
|
|
# our $__PROXY_NODE_REGISTRY_MUTEX :shared = 0; |
144
|
|
|
|
|
|
|
# }; |
145
|
|
|
|
|
|
|
# die $@ if $@; |
146
|
|
|
|
|
|
|
# } |
147
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
148
|
|
|
|
|
|
|
# bootstrapping # |
149
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
150
|
67
|
|
|
|
|
139666
|
XSLoader::load( 'XML::LibXML', $VERSION ); |
151
|
67
|
|
|
|
|
717
|
undef &AUTOLOAD; |
152
|
|
|
|
|
|
|
|
153
|
67
|
|
|
|
|
232
|
*encodeToUTF8 = \&XML::LibXML::Common::encodeToUTF8; |
154
|
67
|
|
|
|
|
2686
|
*decodeFromUTF8 = \&XML::LibXML::Common::decodeFromUTF8; |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
} # BEGIN |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
160
|
|
|
|
|
|
|
# libxml2 node names (see also XML::LibXML::Common # |
161
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
162
|
67
|
|
|
67
|
|
500
|
use constant XML_ELEMENT_NODE => 1; |
|
67
|
|
|
|
|
140
|
|
|
67
|
|
|
|
|
4529
|
|
163
|
67
|
|
|
67
|
|
406
|
use constant XML_ATTRIBUTE_NODE => 2; |
|
67
|
|
|
|
|
198
|
|
|
67
|
|
|
|
|
3241
|
|
164
|
67
|
|
|
67
|
|
372
|
use constant XML_TEXT_NODE => 3; |
|
67
|
|
|
|
|
153
|
|
|
67
|
|
|
|
|
3118
|
|
165
|
67
|
|
|
67
|
|
371
|
use constant XML_CDATA_SECTION_NODE => 4; |
|
67
|
|
|
|
|
165
|
|
|
67
|
|
|
|
|
3169
|
|
166
|
67
|
|
|
67
|
|
378
|
use constant XML_ENTITY_REF_NODE => 5; |
|
67
|
|
|
|
|
152
|
|
|
67
|
|
|
|
|
3478
|
|
167
|
67
|
|
|
67
|
|
389
|
use constant XML_ENTITY_NODE => 6; |
|
67
|
|
|
|
|
110
|
|
|
67
|
|
|
|
|
2918
|
|
168
|
67
|
|
|
67
|
|
353
|
use constant XML_PI_NODE => 7; |
|
67
|
|
|
|
|
154
|
|
|
67
|
|
|
|
|
2815
|
|
169
|
67
|
|
|
67
|
|
365
|
use constant XML_COMMENT_NODE => 8; |
|
67
|
|
|
|
|
176
|
|
|
67
|
|
|
|
|
2789
|
|
170
|
67
|
|
|
67
|
|
384
|
use constant XML_DOCUMENT_NODE => 9; |
|
67
|
|
|
|
|
138
|
|
|
67
|
|
|
|
|
2889
|
|
171
|
67
|
|
|
67
|
|
356
|
use constant XML_DOCUMENT_TYPE_NODE => 10; |
|
67
|
|
|
|
|
146
|
|
|
67
|
|
|
|
|
2997
|
|
172
|
67
|
|
|
67
|
|
356
|
use constant XML_DOCUMENT_FRAG_NODE => 11; |
|
67
|
|
|
|
|
136
|
|
|
67
|
|
|
|
|
2897
|
|
173
|
67
|
|
|
67
|
|
381
|
use constant XML_NOTATION_NODE => 12; |
|
67
|
|
|
|
|
141
|
|
|
67
|
|
|
|
|
3204
|
|
174
|
67
|
|
|
67
|
|
394
|
use constant XML_HTML_DOCUMENT_NODE => 13; |
|
67
|
|
|
|
|
137
|
|
|
67
|
|
|
|
|
2926
|
|
175
|
67
|
|
|
67
|
|
349
|
use constant XML_DTD_NODE => 14; |
|
67
|
|
|
|
|
144
|
|
|
67
|
|
|
|
|
2792
|
|
176
|
67
|
|
|
67
|
|
348
|
use constant XML_ELEMENT_DECL => 15; |
|
67
|
|
|
|
|
130
|
|
|
67
|
|
|
|
|
2902
|
|
177
|
67
|
|
|
67
|
|
375
|
use constant XML_ATTRIBUTE_DECL => 16; |
|
67
|
|
|
|
|
121
|
|
|
67
|
|
|
|
|
2602
|
|
178
|
67
|
|
|
67
|
|
326
|
use constant XML_ENTITY_DECL => 17; |
|
67
|
|
|
|
|
136
|
|
|
67
|
|
|
|
|
2831
|
|
179
|
67
|
|
|
67
|
|
342
|
use constant XML_NAMESPACE_DECL => 18; |
|
67
|
|
|
|
|
114
|
|
|
67
|
|
|
|
|
2772
|
|
180
|
67
|
|
|
67
|
|
413
|
use constant XML_XINCLUDE_START => 19; |
|
67
|
|
|
|
|
148
|
|
|
67
|
|
|
|
|
2809
|
|
181
|
67
|
|
|
67
|
|
377
|
use constant XML_XINCLUDE_END => 20; |
|
67
|
|
|
|
|
114
|
|
|
67
|
|
|
|
|
29701
|
|
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
sub import { |
185
|
217
|
|
|
217
|
|
1126
|
my $package=shift; |
186
|
217
|
50
|
|
|
|
1396
|
if (grep /^:threads_shared$/, @_) { |
|
|
100
|
|
|
|
|
|
187
|
0
|
|
|
|
|
0
|
require threads; |
188
|
0
|
0
|
|
|
|
0
|
if (!defined($__threads_shared)) { |
|
|
0
|
|
|
|
|
|
189
|
0
|
0
|
|
|
|
0
|
if (INIT_THREAD_SUPPORT()) { |
190
|
0
|
|
|
|
|
0
|
eval q{ |
191
|
|
|
|
|
|
|
use threads::shared; |
192
|
|
|
|
|
|
|
share($__PROXY_NODE_REGISTRY_MUTEX); |
193
|
|
|
|
|
|
|
}; |
194
|
0
|
0
|
|
|
|
0
|
if ($@) { # something went wrong |
195
|
0
|
|
|
|
|
0
|
DISABLE_THREAD_SUPPORT(); # leave the library in a usable state |
196
|
0
|
|
|
|
|
0
|
die $@; # and die |
197
|
|
|
|
|
|
|
} |
198
|
0
|
|
|
|
|
0
|
$__PROXY_NODE_REGISTRY = XML::LibXML::HashTable->new(); |
199
|
0
|
|
|
|
|
0
|
$__threads_shared=1; |
200
|
|
|
|
|
|
|
} else { |
201
|
0
|
|
|
|
|
0
|
croak("XML::LibXML or Perl compiled without ithread support!"); |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
} elsif (!$__threads_shared) { |
204
|
0
|
|
|
|
|
0
|
croak("XML::LibXML already loaded without thread support. Too late to enable thread support!"); |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
} elsif (defined $XML::LibXML::__loaded) { |
207
|
83
|
100
|
|
|
|
319
|
$__threads_shared=0 if not defined $__threads_shared; |
208
|
|
|
|
|
|
|
} |
209
|
217
|
|
|
|
|
141198
|
__PACKAGE__->export_to_level(1,$package,grep !/^:threads(_shared)?$/,@_); |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
sub threads_shared_enabled { |
213
|
0
|
0
|
|
0
|
0
|
0
|
return $__threads_shared ? 1 : 0; |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# if ($threads::threads) { |
217
|
|
|
|
|
|
|
# our $__PROXY_NODE_REGISTRY = XML::LibXML::HashTable->new(); |
218
|
|
|
|
|
|
|
# } |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
221
|
|
|
|
|
|
|
# test exact version (up to patch-level) # |
222
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
223
|
|
|
|
|
|
|
{ |
224
|
|
|
|
|
|
|
my ($runtime_version) = LIBXML_RUNTIME_VERSION() =~ /^(\d+)/; |
225
|
|
|
|
|
|
|
if ( $runtime_version < LIBXML_VERSION ) { |
226
|
|
|
|
|
|
|
warn "Warning: XML::LibXML compiled against libxml2 ".LIBXML_VERSION. |
227
|
|
|
|
|
|
|
", but runtime libxml2 is older $runtime_version\n"; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
233
|
|
|
|
|
|
|
# parser flags # |
234
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
# Copied directly from http://xmlsoft.org/html/libxml-parser.html#xmlParserOption |
237
|
|
|
|
|
|
|
use constant { |
238
|
67
|
|
|
|
|
330392
|
XML_PARSE_RECOVER => 1, # recover on errors |
239
|
|
|
|
|
|
|
XML_PARSE_NOENT => 2, # substitute entities |
240
|
|
|
|
|
|
|
XML_PARSE_DTDLOAD => 4, # load the external subset |
241
|
|
|
|
|
|
|
XML_PARSE_DTDATTR => 8, # default DTD attributes |
242
|
|
|
|
|
|
|
XML_PARSE_DTDVALID => 16, # validate with the DTD |
243
|
|
|
|
|
|
|
XML_PARSE_NOERROR => 32, # suppress error reports |
244
|
|
|
|
|
|
|
XML_PARSE_NOWARNING => 64, # suppress warning reports |
245
|
|
|
|
|
|
|
XML_PARSE_PEDANTIC => 128, # pedantic error reporting |
246
|
|
|
|
|
|
|
XML_PARSE_NOBLANKS => 256, # remove blank nodes |
247
|
|
|
|
|
|
|
XML_PARSE_SAX1 => 512, # use the SAX1 interface internally |
248
|
|
|
|
|
|
|
XML_PARSE_XINCLUDE => 1024, # Implement XInclude substitution |
249
|
|
|
|
|
|
|
XML_PARSE_NONET => 2048, # Forbid network access |
250
|
|
|
|
|
|
|
XML_PARSE_NODICT => 4096, # Do not reuse the context dictionary |
251
|
|
|
|
|
|
|
XML_PARSE_NSCLEAN => 8192, # remove redundant namespaces declarations |
252
|
|
|
|
|
|
|
XML_PARSE_NOCDATA => 16384, # merge CDATA as text nodes |
253
|
|
|
|
|
|
|
XML_PARSE_NOXINCNODE => 32768, # do not generate XINCLUDE START/END nodes |
254
|
|
|
|
|
|
|
XML_PARSE_COMPACT => 65536, # compact small text nodes; no modification of the tree allowed afterwards |
255
|
|
|
|
|
|
|
# (will possibly crash if you try to modify the tree) |
256
|
|
|
|
|
|
|
XML_PARSE_OLD10 => 131072, # parse using XML-1.0 before update 5 |
257
|
|
|
|
|
|
|
XML_PARSE_NOBASEFIX => 262144, # do not fixup XINCLUDE xml#base uris |
258
|
|
|
|
|
|
|
XML_PARSE_HUGE => 524288, # relax any hardcoded limit from the parser |
259
|
|
|
|
|
|
|
XML_PARSE_OLDSAX => 1048576, # parse using SAX2 interface from before 2.7.0 |
260
|
|
|
|
|
|
|
HTML_PARSE_RECOVER => (1<<0), # suppress error reports |
261
|
|
|
|
|
|
|
HTML_PARSE_NOERROR => (1<<5), # suppress error reports |
262
|
67
|
|
|
67
|
|
493
|
}; |
|
67
|
|
|
|
|
134
|
|
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
$XML_LIBXML_PARSE_DEFAULTS = ( XML_PARSE_NODICT ); |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
# this hash is made global so that applications can add names for new |
267
|
|
|
|
|
|
|
# libxml2 parser flags as temporary workaround |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
%PARSER_FLAGS = ( |
270
|
|
|
|
|
|
|
recover => XML_PARSE_RECOVER, |
271
|
|
|
|
|
|
|
expand_entities => XML_PARSE_NOENT, |
272
|
|
|
|
|
|
|
load_ext_dtd => XML_PARSE_DTDLOAD, |
273
|
|
|
|
|
|
|
complete_attributes => XML_PARSE_DTDATTR, |
274
|
|
|
|
|
|
|
validation => XML_PARSE_DTDVALID, |
275
|
|
|
|
|
|
|
suppress_errors => XML_PARSE_NOERROR, |
276
|
|
|
|
|
|
|
suppress_warnings => XML_PARSE_NOWARNING, |
277
|
|
|
|
|
|
|
pedantic_parser => XML_PARSE_PEDANTIC, |
278
|
|
|
|
|
|
|
no_blanks => XML_PARSE_NOBLANKS, |
279
|
|
|
|
|
|
|
expand_xinclude => XML_PARSE_XINCLUDE, |
280
|
|
|
|
|
|
|
xinclude => XML_PARSE_XINCLUDE, |
281
|
|
|
|
|
|
|
no_network => XML_PARSE_NONET, |
282
|
|
|
|
|
|
|
clean_namespaces => XML_PARSE_NSCLEAN, |
283
|
|
|
|
|
|
|
no_cdata => XML_PARSE_NOCDATA, |
284
|
|
|
|
|
|
|
no_xinclude_nodes => XML_PARSE_NOXINCNODE, |
285
|
|
|
|
|
|
|
old10 => XML_PARSE_OLD10, |
286
|
|
|
|
|
|
|
no_base_fix => XML_PARSE_NOBASEFIX, |
287
|
|
|
|
|
|
|
huge => XML_PARSE_HUGE, |
288
|
|
|
|
|
|
|
oldsax => XML_PARSE_OLDSAX, |
289
|
|
|
|
|
|
|
); |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
my %OUR_FLAGS = ( |
292
|
|
|
|
|
|
|
recover => 'XML_LIBXML_RECOVER', |
293
|
|
|
|
|
|
|
line_numbers => 'XML_LIBXML_LINENUMBERS', |
294
|
|
|
|
|
|
|
URI => 'XML_LIBXML_BASE_URI', |
295
|
|
|
|
|
|
|
base_uri => 'XML_LIBXML_BASE_URI', |
296
|
|
|
|
|
|
|
gdome => 'XML_LIBXML_GDOME', |
297
|
|
|
|
|
|
|
ext_ent_handler => 'ext_ent_handler', |
298
|
|
|
|
|
|
|
); |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
sub _parser_options { |
301
|
108
|
|
|
108
|
|
214
|
my ($self, $opts) = @_; |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
# currently dictionaries break XML::LibXML memory management |
304
|
|
|
|
|
|
|
|
305
|
108
|
|
|
|
|
147
|
my $flags; |
306
|
|
|
|
|
|
|
|
307
|
108
|
100
|
|
|
|
230
|
if (ref($self)) { |
308
|
25
|
|
50
|
|
|
60
|
$flags = ($self->{XML_LIBXML_PARSER_OPTIONS}||0); |
309
|
|
|
|
|
|
|
} else { |
310
|
83
|
|
|
|
|
121
|
$flags = $XML_LIBXML_PARSE_DEFAULTS; # safety precaution |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
108
|
|
|
|
|
169
|
my ($key, $value); |
314
|
108
|
|
|
|
|
405
|
while (($key,$value) = each %$opts) { |
315
|
167
|
|
|
|
|
268
|
my $f = $PARSER_FLAGS{ $key }; |
316
|
167
|
100
|
|
|
|
444
|
if (defined $f) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
317
|
99
|
100
|
|
|
|
148
|
if ($value) { |
318
|
71
|
|
|
|
|
202
|
$flags |= $f |
319
|
|
|
|
|
|
|
} else { |
320
|
28
|
|
|
|
|
60
|
$flags &= ~$f; |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
} elsif ($key eq 'set_parser_flags') { # this can be used to pass flags XML::LibXML does not yet know about |
323
|
0
|
|
|
|
|
0
|
$flags |= $value; |
324
|
|
|
|
|
|
|
} elsif ($key eq 'unset_parser_flags') { |
325
|
0
|
|
|
|
|
0
|
$flags &= ~$value; |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
} |
329
|
108
|
|
|
|
|
3890
|
return $flags; |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
my %compatibility_flags = ( |
333
|
|
|
|
|
|
|
XML_LIBXML_VALIDATION => 'validation', |
334
|
|
|
|
|
|
|
XML_LIBXML_EXPAND_ENTITIES => 'expand_entities', |
335
|
|
|
|
|
|
|
XML_LIBXML_PEDANTIC => 'pedantic_parser', |
336
|
|
|
|
|
|
|
XML_LIBXML_NONET => 'no_network', |
337
|
|
|
|
|
|
|
XML_LIBXML_EXT_DTD => 'load_ext_dtd', |
338
|
|
|
|
|
|
|
XML_LIBXML_COMPLETE_ATTR => 'complete_attributes', |
339
|
|
|
|
|
|
|
XML_LIBXML_EXPAND_XINCLUDE => 'expand_xinclude', |
340
|
|
|
|
|
|
|
XML_LIBXML_NSCLEAN => 'clean_namespaces', |
341
|
|
|
|
|
|
|
XML_LIBXML_KEEP_BLANKS => 'keep_blanks', |
342
|
|
|
|
|
|
|
XML_LIBXML_LINENUMBERS => 'line_numbers', |
343
|
|
|
|
|
|
|
); |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
346
|
|
|
|
|
|
|
# parser constructor # |
347
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
sub new { |
351
|
183
|
|
|
183
|
0
|
52481
|
my $class = shift; |
352
|
183
|
|
|
|
|
419
|
my $self = bless { |
353
|
|
|
|
|
|
|
}, $class; |
354
|
183
|
100
|
|
|
|
535
|
if (@_) { |
355
|
43
|
|
|
|
|
89
|
my %opts = (); |
356
|
43
|
100
|
|
|
|
140
|
if (ref($_[0]) eq 'HASH') { |
357
|
25
|
|
|
|
|
43
|
%opts = %{$_[0]}; |
|
25
|
|
|
|
|
111
|
|
358
|
|
|
|
|
|
|
} else { |
359
|
|
|
|
|
|
|
# old interface |
360
|
18
|
|
|
|
|
75
|
my %args = @_; |
361
|
|
|
|
|
|
|
%opts=( |
362
|
|
|
|
|
|
|
map { |
363
|
18
|
|
33
|
|
|
57
|
(($compatibility_flags{ $_ }||$_) => $args{ $_ }) |
|
65
|
|
|
|
|
225
|
|
364
|
|
|
|
|
|
|
} keys %args |
365
|
|
|
|
|
|
|
); |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
# parser flags |
368
|
43
|
50
|
33
|
|
|
167
|
$opts{no_blanks} = !$opts{keep_blanks} if exists($opts{keep_blanks}) and !exists($opts{no_blanks}); |
369
|
43
|
100
|
100
|
|
|
208
|
$opts{load_ext_dtd} = $opts{expand_entities} if exists($opts{expand_entities}) and !exists($opts{load_ext_dtd}); |
370
|
|
|
|
|
|
|
|
371
|
43
|
|
|
|
|
195
|
for (keys %OUR_FLAGS) { |
372
|
258
|
|
|
|
|
565
|
$self->{$OUR_FLAGS{$_}} = delete $opts{$_}; |
373
|
|
|
|
|
|
|
} |
374
|
43
|
100
|
|
|
|
184
|
$class->load_catalog(delete($opts{catalog})) if $opts{catalog}; |
375
|
|
|
|
|
|
|
|
376
|
43
|
|
|
|
|
147
|
$self->{XML_LIBXML_PARSER_OPTIONS} = XML::LibXML->_parser_options(\%opts); |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
# store remaining unknown options directly in $self |
379
|
43
|
|
|
|
|
124
|
for (keys %opts) { |
380
|
99
|
100
|
|
|
|
202
|
$self->{$_}=$opts{$_} unless exists $PARSER_FLAGS{$_}; |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
} else { |
383
|
140
|
|
|
|
|
486
|
$self->{XML_LIBXML_PARSER_OPTIONS} = $XML_LIBXML_PARSE_DEFAULTS; |
384
|
|
|
|
|
|
|
} |
385
|
183
|
50
|
|
|
|
547
|
if ( defined $self->{Handler} ) { |
386
|
0
|
|
|
|
|
0
|
$self->set_handler( $self->{Handler} ); |
387
|
|
|
|
|
|
|
} |
388
|
|
|
|
|
|
|
|
389
|
183
|
|
|
|
|
315
|
$self->{_State_} = 0; |
390
|
183
|
|
|
|
|
480
|
return $self; |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
sub _clone { |
394
|
9
|
|
|
9
|
|
20
|
my ($self)=@_; |
395
|
|
|
|
|
|
|
my $new = ref($self)->new({ |
396
|
|
|
|
|
|
|
recover => $self->{XML_LIBXML_RECOVER}, |
397
|
|
|
|
|
|
|
line_numbers => $self->{XML_LIBXML_LINENUMBERS}, |
398
|
|
|
|
|
|
|
base_uri => $self->{XML_LIBXML_BASE_URI}, |
399
|
|
|
|
|
|
|
gdome => $self->{XML_LIBXML_GDOME}, |
400
|
9
|
|
|
|
|
51
|
}); |
401
|
|
|
|
|
|
|
# The parser options may contain some options that were zeroed from the |
402
|
|
|
|
|
|
|
# defaults so set_parser_flags won't work here. We need to assign them |
403
|
|
|
|
|
|
|
# explicitly. |
404
|
9
|
|
|
|
|
24
|
$new->{XML_LIBXML_PARSER_OPTIONS} = $self->{XML_LIBXML_PARSER_OPTIONS}; |
405
|
9
|
|
|
|
|
28
|
$new->input_callbacks($self->input_callbacks()); |
406
|
9
|
|
|
|
|
20
|
return $new; |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
410
|
|
|
|
|
|
|
# Threads support methods # |
411
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
# threads doc says CLONE's API may change in future, which would break |
414
|
|
|
|
|
|
|
# an XS method prototype |
415
|
|
|
|
|
|
|
sub CLONE { |
416
|
0
|
0
|
|
0
|
|
0
|
if ($XML::LibXML::__threads_shared) { |
417
|
0
|
|
|
|
|
0
|
XML::LibXML::_CLONE( $_[0] ); |
418
|
|
|
|
|
|
|
} |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
sub CLONE_SKIP { |
422
|
0
|
0
|
|
0
|
|
0
|
return $XML::LibXML::__threads_shared ? 0 : 1; |
423
|
|
|
|
|
|
|
} |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
sub __proxy_registry { |
426
|
0
|
|
|
0
|
|
0
|
my ($class)=caller; |
427
|
0
|
|
|
|
|
0
|
die "This version of $class uses API of XML::LibXML 1.66 which is not compatible with XML::LibXML $VERSION. Please upgrade $class!\n"; |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
431
|
|
|
|
|
|
|
# DOM Level 2 document constructor # |
432
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
sub createDocument { |
435
|
13
|
|
|
13
|
0
|
2358
|
my $self = shift; |
436
|
13
|
100
|
100
|
|
|
83
|
if (!@_ or $_[0] =~ m/^\d\.\d$/) { |
437
|
|
|
|
|
|
|
# for backward compatibility |
438
|
10
|
|
|
|
|
130
|
return XML::LibXML::Document->new(@_); |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
else { |
441
|
|
|
|
|
|
|
# DOM API: createDocument(namespaceURI, qualifiedName, doctype?) |
442
|
3
|
|
|
|
|
22
|
my $doc = XML::LibXML::Document-> new; |
443
|
3
|
|
|
|
|
31
|
my $el = $doc->createElementNS(shift, shift); |
444
|
3
|
|
|
|
|
11
|
$doc->setDocumentElement($el); |
445
|
3
|
50
|
|
|
|
7
|
$doc->setExternalSubset(shift) if @_; |
446
|
3
|
|
|
|
|
8
|
return $doc; |
447
|
|
|
|
|
|
|
} |
448
|
|
|
|
|
|
|
} |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
451
|
|
|
|
|
|
|
# callback functions # |
452
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
sub externalEntityLoader(&) |
455
|
|
|
|
|
|
|
{ |
456
|
1
|
|
|
1
|
0
|
1518
|
return _externalEntityLoader($_[0]); |
457
|
|
|
|
|
|
|
} |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
sub input_callbacks { |
460
|
26
|
|
|
26
|
0
|
61
|
my $self = shift; |
461
|
26
|
|
|
|
|
35
|
my $icbclass = shift; |
462
|
|
|
|
|
|
|
|
463
|
26
|
100
|
|
|
|
64
|
if ( defined $icbclass ) { |
464
|
10
|
|
|
|
|
21
|
$self->{XML_LIBXML_CALLBACK_STACK} = $icbclass; |
465
|
|
|
|
|
|
|
} |
466
|
26
|
|
|
|
|
49
|
return $self->{XML_LIBXML_CALLBACK_STACK}; |
467
|
|
|
|
|
|
|
} |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
sub match_callback { |
470
|
688
|
|
|
688
|
0
|
2421
|
my $self = shift; |
471
|
688
|
50
|
|
|
|
1360
|
if ( ref $self ) { |
472
|
688
|
100
|
|
|
|
1181
|
if ( scalar @_ ) { |
473
|
4
|
|
|
|
|
6
|
$self->{XML_LIBXML_MATCH_CB} = shift; |
474
|
4
|
|
|
|
|
8
|
$self->{XML_LIBXML_CALLBACK_STACK} = undef; |
475
|
|
|
|
|
|
|
} |
476
|
688
|
|
|
|
|
1173
|
return $self->{XML_LIBXML_MATCH_CB}; |
477
|
|
|
|
|
|
|
} |
478
|
|
|
|
|
|
|
else { |
479
|
0
|
0
|
|
|
|
0
|
$MatchCB = shift if scalar @_; |
480
|
0
|
|
|
|
|
0
|
return $MatchCB; |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
} |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
sub read_callback { |
485
|
688
|
|
|
688
|
0
|
816
|
my $self = shift; |
486
|
688
|
50
|
|
|
|
1045
|
if ( ref $self ) { |
487
|
688
|
100
|
|
|
|
1145
|
if ( scalar @_ ) { |
488
|
4
|
|
|
|
|
7
|
$self->{XML_LIBXML_READ_CB} = shift; |
489
|
4
|
|
|
|
|
8
|
$self->{XML_LIBXML_CALLBACK_STACK} = undef; |
490
|
|
|
|
|
|
|
} |
491
|
688
|
|
|
|
|
1062
|
return $self->{XML_LIBXML_READ_CB}; |
492
|
|
|
|
|
|
|
} |
493
|
|
|
|
|
|
|
else { |
494
|
0
|
0
|
|
|
|
0
|
$ReadCB = shift if scalar @_; |
495
|
0
|
|
|
|
|
0
|
return $ReadCB; |
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
} |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
sub close_callback { |
500
|
688
|
|
|
688
|
0
|
830
|
my $self = shift; |
501
|
688
|
50
|
|
|
|
1037
|
if ( ref $self ) { |
502
|
688
|
100
|
|
|
|
1130
|
if ( scalar @_ ) { |
503
|
4
|
|
|
|
|
7
|
$self->{XML_LIBXML_CLOSE_CB} = shift; |
504
|
4
|
|
|
|
|
7
|
$self->{XML_LIBXML_CALLBACK_STACK} = undef; |
505
|
|
|
|
|
|
|
} |
506
|
688
|
|
|
|
|
977
|
return $self->{XML_LIBXML_CLOSE_CB}; |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
else { |
509
|
0
|
0
|
|
|
|
0
|
$CloseCB = shift if scalar @_; |
510
|
0
|
|
|
|
|
0
|
return $CloseCB; |
511
|
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
sub open_callback { |
515
|
688
|
|
|
688
|
0
|
881
|
my $self = shift; |
516
|
688
|
50
|
|
|
|
1155
|
if ( ref $self ) { |
517
|
688
|
100
|
|
|
|
1147
|
if ( scalar @_ ) { |
518
|
4
|
|
|
|
|
6
|
$self->{XML_LIBXML_OPEN_CB} = shift; |
519
|
4
|
|
|
|
|
7
|
$self->{XML_LIBXML_CALLBACK_STACK} = undef; |
520
|
|
|
|
|
|
|
} |
521
|
688
|
|
|
|
|
983
|
return $self->{XML_LIBXML_OPEN_CB}; |
522
|
|
|
|
|
|
|
} |
523
|
|
|
|
|
|
|
else { |
524
|
0
|
0
|
|
|
|
0
|
$OpenCB = shift if scalar @_; |
525
|
0
|
|
|
|
|
0
|
return $OpenCB; |
526
|
|
|
|
|
|
|
} |
527
|
|
|
|
|
|
|
} |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
sub callbacks { |
530
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
531
|
0
|
0
|
|
|
|
0
|
if ( ref $self ) { |
532
|
0
|
0
|
|
|
|
0
|
if (@_) { |
533
|
0
|
|
|
|
|
0
|
my ($match, $open, $read, $close) = @_; |
534
|
0
|
|
|
|
|
0
|
@{$self}{qw(XML_LIBXML_MATCH_CB XML_LIBXML_OPEN_CB XML_LIBXML_READ_CB XML_LIBXML_CLOSE_CB)} = ($match, $open, $read, $close); |
|
0
|
|
|
|
|
0
|
|
535
|
0
|
|
|
|
|
0
|
$self->{XML_LIBXML_CALLBACK_STACK} = undef; |
536
|
|
|
|
|
|
|
} |
537
|
|
|
|
|
|
|
else { |
538
|
0
|
|
|
|
|
0
|
return @{$self}{qw(XML_LIBXML_MATCH_CB XML_LIBXML_OPEN_CB XML_LIBXML_READ_CB XML_LIBXML_CLOSE_CB)}; |
|
0
|
|
|
|
|
0
|
|
539
|
|
|
|
|
|
|
} |
540
|
|
|
|
|
|
|
} |
541
|
|
|
|
|
|
|
else { |
542
|
0
|
0
|
|
|
|
0
|
if (@_) { |
543
|
0
|
|
|
|
|
0
|
( $MatchCB, $OpenCB, $ReadCB, $CloseCB ) = @_; |
544
|
|
|
|
|
|
|
} |
545
|
|
|
|
|
|
|
else { |
546
|
0
|
|
|
|
|
0
|
return ( $MatchCB, $OpenCB, $ReadCB, $CloseCB ); |
547
|
|
|
|
|
|
|
} |
548
|
|
|
|
|
|
|
} |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
552
|
|
|
|
|
|
|
# internal member variable manipulation # |
553
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
554
|
|
|
|
|
|
|
sub __parser_option { |
555
|
689
|
|
|
689
|
|
1082
|
my ($self, $opt) = @_; |
556
|
689
|
100
|
|
|
|
1365
|
if (@_>2) { |
557
|
119
|
100
|
|
|
|
209
|
if ($_[2]) { |
558
|
66
|
|
|
|
|
127
|
$self->{XML_LIBXML_PARSER_OPTIONS} |= $opt; |
559
|
66
|
|
|
|
|
168
|
return 1; |
560
|
|
|
|
|
|
|
} else { |
561
|
53
|
|
|
|
|
112
|
$self->{XML_LIBXML_PARSER_OPTIONS} &= ~$opt; |
562
|
53
|
|
|
|
|
467
|
return 0; |
563
|
|
|
|
|
|
|
} |
564
|
|
|
|
|
|
|
} else { |
565
|
570
|
100
|
|
|
|
1912
|
return ($self->{XML_LIBXML_PARSER_OPTIONS} & $opt) ? 1 : 0; |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
} |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
sub option_exists { |
570
|
24
|
|
|
24
|
0
|
3135
|
my ($self,$name)=@_; |
571
|
24
|
100
|
100
|
|
|
158
|
return ($PARSER_FLAGS{$name} || $OUR_FLAGS{$name}) ? 1 : 0; |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
sub get_option { |
574
|
171
|
|
|
171
|
0
|
16850
|
my ($self,$name)=@_; |
575
|
171
|
|
|
|
|
293
|
my $flag = $OUR_FLAGS{$name}; |
576
|
171
|
100
|
|
|
|
377
|
return $self->{$flag} if $flag; |
577
|
137
|
|
|
|
|
242
|
$flag = $PARSER_FLAGS{$name}; |
578
|
137
|
50
|
|
|
|
386
|
return $self->__parser_option($flag) if $flag; |
579
|
0
|
|
|
|
|
0
|
warn "XML::LibXML::get_option: unknown parser option $name\n"; |
580
|
0
|
|
|
|
|
0
|
return undef; |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
sub set_option { |
583
|
58
|
|
|
58
|
0
|
131
|
my ($self,$name,$value)=@_; |
584
|
58
|
|
|
|
|
111
|
my $flag = $OUR_FLAGS{$name}; |
585
|
58
|
100
|
|
|
|
153
|
return ($self->{$flag}=$value) if $flag; |
586
|
39
|
|
|
|
|
67
|
$flag = $PARSER_FLAGS{$name}; |
587
|
39
|
50
|
|
|
|
113
|
return $self->__parser_option($flag,$value) if $flag; |
588
|
0
|
|
|
|
|
0
|
warn "XML::LibXML::get_option: unknown parser option $name\n"; |
589
|
0
|
|
|
|
|
0
|
return undef; |
590
|
|
|
|
|
|
|
} |
591
|
|
|
|
|
|
|
sub set_options { |
592
|
1
|
|
|
1
|
0
|
3
|
my $self=shift; |
593
|
1
|
|
|
|
|
2
|
my $opts; |
594
|
1
|
50
|
33
|
|
|
8
|
if (@_==1 and ref($_[0]) eq 'HASH') { |
|
|
0
|
|
|
|
|
|
595
|
1
|
|
|
|
|
3
|
$opts = $_[0]; |
596
|
|
|
|
|
|
|
} elsif (@_ % 2 == 0) { |
597
|
0
|
|
|
|
|
0
|
$opts={@_}; |
598
|
|
|
|
|
|
|
} else { |
599
|
0
|
|
|
|
|
0
|
croak("Odd number of elements passed to set_options"); |
600
|
|
|
|
|
|
|
} |
601
|
1
|
|
|
|
|
6
|
$self->set_option($_=>$opts->{$_}) foreach keys %$opts; |
602
|
1
|
|
|
|
|
2
|
return; |
603
|
|
|
|
|
|
|
} |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
sub validation { |
606
|
10
|
|
|
10
|
0
|
818
|
my $self = shift; |
607
|
10
|
|
|
|
|
30
|
return $self->__parser_option(XML_PARSE_DTDVALID,@_); |
608
|
|
|
|
|
|
|
} |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
sub recover { |
611
|
67
|
|
|
67
|
0
|
323
|
my $self = shift; |
612
|
67
|
100
|
|
|
|
124
|
if (scalar @_) { |
613
|
5
|
|
|
|
|
12
|
$self->{XML_LIBXML_RECOVER} = $_[0]; |
614
|
5
|
|
|
|
|
14
|
$self->__parser_option(XML_PARSE_RECOVER,@_); |
615
|
|
|
|
|
|
|
} |
616
|
67
|
|
|
|
|
205
|
return $self->{XML_LIBXML_RECOVER}; |
617
|
|
|
|
|
|
|
} |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
sub recover_silently { |
620
|
33
|
|
|
33
|
0
|
51
|
my $self = shift; |
621
|
33
|
|
|
|
|
43
|
my $arg = shift; |
622
|
33
|
100
|
|
|
|
56
|
if ( defined($arg) ) |
623
|
|
|
|
|
|
|
{ |
624
|
2
|
100
|
|
|
|
8
|
$self->recover(($arg == 1) ? 2 : $arg); |
625
|
|
|
|
|
|
|
} |
626
|
33
|
100
|
100
|
|
|
60
|
return (($self->recover()||0) == 2) ? 1 : 0; |
627
|
|
|
|
|
|
|
} |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
sub expand_entities { |
630
|
17
|
|
|
17
|
0
|
1341
|
my $self = shift; |
631
|
17
|
100
|
100
|
|
|
88
|
if (scalar(@_) and $_[0]) { |
632
|
7
|
|
|
|
|
24
|
return $self->__parser_option(XML_PARSE_NOENT | XML_PARSE_DTDLOAD,1); |
633
|
|
|
|
|
|
|
} |
634
|
10
|
|
|
|
|
31
|
return $self->__parser_option(XML_PARSE_NOENT,@_); |
635
|
|
|
|
|
|
|
} |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
sub keep_blanks { |
638
|
37
|
|
|
37
|
0
|
958
|
my $self = shift; |
639
|
37
|
|
|
|
|
54
|
my @args; # we have to negate the argument and return negated value, since |
640
|
|
|
|
|
|
|
# the actual flag is no_blanks |
641
|
37
|
100
|
|
|
|
77
|
if (scalar @_) { |
642
|
7
|
100
|
|
|
|
25
|
@args=($_[0] ? 0 : 1); |
643
|
|
|
|
|
|
|
} |
644
|
37
|
100
|
|
|
|
91
|
return $self->__parser_option(XML_PARSE_NOBLANKS,@args) ? 0 : 1; |
645
|
|
|
|
|
|
|
} |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
sub pedantic_parser { |
648
|
37
|
|
|
37
|
0
|
244
|
my $self = shift; |
649
|
37
|
|
|
|
|
72
|
return $self->__parser_option(XML_PARSE_PEDANTIC,@_); |
650
|
|
|
|
|
|
|
} |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
sub line_numbers { |
653
|
9
|
|
|
9
|
0
|
304
|
my $self = shift; |
654
|
9
|
100
|
|
|
|
29
|
$self->{XML_LIBXML_LINENUMBERS} = shift if scalar @_; |
655
|
9
|
|
|
|
|
26
|
return $self->{XML_LIBXML_LINENUMBERS}; |
656
|
|
|
|
|
|
|
} |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
sub no_network { |
659
|
35
|
|
|
35
|
0
|
49
|
my $self = shift; |
660
|
35
|
|
|
|
|
75
|
return $self->__parser_option(XML_PARSE_NONET,@_); |
661
|
|
|
|
|
|
|
} |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
sub load_ext_dtd { |
664
|
21
|
|
|
21
|
0
|
384
|
my $self = shift; |
665
|
21
|
|
|
|
|
52
|
return $self->__parser_option(XML_PARSE_DTDLOAD,@_); |
666
|
|
|
|
|
|
|
} |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
sub complete_attributes { |
669
|
11
|
|
|
11
|
0
|
34
|
my $self = shift; |
670
|
11
|
|
|
|
|
38
|
return $self->__parser_option(XML_PARSE_DTDATTR,@_); |
671
|
|
|
|
|
|
|
} |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
sub expand_xinclude { |
674
|
332
|
|
|
332
|
0
|
2361
|
my $self = shift; |
675
|
332
|
|
|
|
|
796
|
return $self->__parser_option(XML_PARSE_XINCLUDE,@_); |
676
|
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
sub base_uri { |
679
|
4
|
|
|
4
|
0
|
552
|
my $self = shift; |
680
|
4
|
100
|
|
|
|
21
|
$self->{XML_LIBXML_BASE_URI} = shift if scalar @_; |
681
|
4
|
|
|
|
|
15
|
return $self->{XML_LIBXML_BASE_URI}; |
682
|
|
|
|
|
|
|
} |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
sub gdome_dom { |
685
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
686
|
0
|
0
|
|
|
|
0
|
$self->{XML_LIBXML_GDOME} = shift if scalar @_; |
687
|
0
|
|
|
|
|
0
|
return $self->{XML_LIBXML_GDOME}; |
688
|
|
|
|
|
|
|
} |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
sub clean_namespaces { |
691
|
8
|
|
|
8
|
0
|
23
|
my $self = shift; |
692
|
8
|
|
|
|
|
24
|
return $self->__parser_option(XML_PARSE_NSCLEAN,@_); |
693
|
|
|
|
|
|
|
} |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
696
|
|
|
|
|
|
|
# set the optional SAX(2) handler # |
697
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
698
|
|
|
|
|
|
|
sub set_handler { |
699
|
82
|
|
|
82
|
0
|
102
|
my $self = shift; |
700
|
82
|
100
|
|
|
|
132
|
if ( defined $_[0] ) { |
701
|
42
|
|
|
|
|
70
|
$self->{HANDLER} = $_[0]; |
702
|
|
|
|
|
|
|
|
703
|
42
|
|
|
|
|
64
|
$self->{SAX_ELSTACK} = []; |
704
|
42
|
|
|
|
|
99
|
$self->{SAX} = {State => 0}; |
705
|
|
|
|
|
|
|
} |
706
|
|
|
|
|
|
|
else { |
707
|
|
|
|
|
|
|
# undef SAX handling |
708
|
40
|
|
|
|
|
69
|
$self->{SAX_ELSTACK} = []; |
709
|
40
|
|
|
|
|
52
|
delete $self->{HANDLER}; |
710
|
40
|
|
|
|
|
81
|
delete $self->{SAX}; |
711
|
|
|
|
|
|
|
} |
712
|
|
|
|
|
|
|
} |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
715
|
|
|
|
|
|
|
# helper functions # |
716
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
717
|
|
|
|
|
|
|
sub _auto_expand { |
718
|
311
|
|
|
311
|
|
953
|
my ( $self, $result, $uri ) = @_; |
719
|
|
|
|
|
|
|
|
720
|
311
|
100
|
|
|
|
635
|
$result->setBaseURI( $uri ) if defined $uri; |
721
|
|
|
|
|
|
|
|
722
|
311
|
100
|
|
|
|
625
|
if ( $self->expand_xinclude ) { |
723
|
16
|
|
|
|
|
27
|
$self->{_State_} = 1; |
724
|
16
|
|
|
|
|
22
|
eval { $self->processXIncludes($result); }; |
|
16
|
|
|
|
|
52
|
|
725
|
16
|
|
|
|
|
28
|
my $err = $@; |
726
|
16
|
|
|
|
|
28
|
$self->{_State_} = 0; |
727
|
16
|
100
|
|
|
|
107
|
if ($err) { |
728
|
1
|
|
|
|
|
60
|
$self->_cleanup_callbacks(); |
729
|
1
|
|
|
|
|
2
|
$result = undef; |
730
|
1
|
|
|
|
|
23
|
croak $err; |
731
|
|
|
|
|
|
|
} |
732
|
|
|
|
|
|
|
} |
733
|
310
|
|
|
|
|
563
|
return $result; |
734
|
|
|
|
|
|
|
} |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
sub _init_callbacks { |
737
|
684
|
|
|
684
|
|
882
|
my $self = shift; |
738
|
684
|
|
|
|
|
877
|
my $icb = $self->{XML_LIBXML_CALLBACK_STACK}; |
739
|
684
|
100
|
|
|
|
1224
|
unless ( defined $icb ) { |
740
|
161
|
|
|
|
|
590
|
$self->{XML_LIBXML_CALLBACK_STACK} = XML::LibXML::InputCallback->new(); |
741
|
161
|
|
|
|
|
293
|
$icb = $self->{XML_LIBXML_CALLBACK_STACK}; |
742
|
|
|
|
|
|
|
} |
743
|
|
|
|
|
|
|
|
744
|
684
|
|
|
|
|
1376
|
$icb->init_callbacks($self); |
745
|
|
|
|
|
|
|
} |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
sub _cleanup_callbacks { |
748
|
684
|
|
|
684
|
|
935
|
my $self = shift; |
749
|
684
|
|
|
|
|
1378
|
$self->{XML_LIBXML_CALLBACK_STACK}->cleanup_callbacks(); |
750
|
|
|
|
|
|
|
} |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
sub __read { |
753
|
24
|
|
|
24
|
|
1591
|
read($_[0], $_[1], $_[2]); |
754
|
|
|
|
|
|
|
} |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
sub __write { |
757
|
1
|
50
|
|
1
|
|
357
|
if ( ref( $_[0] ) ) { |
758
|
1
|
|
|
|
|
13
|
$_[0]->write( $_[1], $_[2] ); |
759
|
|
|
|
|
|
|
} |
760
|
|
|
|
|
|
|
else { |
761
|
0
|
|
|
|
|
0
|
$_[0]->write( $_[1] ); |
762
|
|
|
|
|
|
|
} |
763
|
|
|
|
|
|
|
} |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
sub load_xml { |
766
|
16
|
|
|
16
|
0
|
4911
|
my $class_or_self = shift; |
767
|
16
|
50
|
|
|
|
51
|
my %args = map { ref($_) eq 'HASH' ? (%$_) : $_ } @_; |
|
34
|
|
|
|
|
137
|
|
768
|
|
|
|
|
|
|
|
769
|
16
|
|
|
|
|
42
|
my $URI = delete($args{URI}); |
770
|
16
|
50
|
|
|
|
45
|
$URI = "$URI" if defined $URI; # stringify in case it is an URI object |
771
|
16
|
|
|
|
|
28
|
my $parser; |
772
|
16
|
100
|
|
|
|
55
|
if (ref($class_or_self)) { |
773
|
3
|
|
|
|
|
12
|
$parser = $class_or_self->_clone(); |
774
|
3
|
|
|
|
|
9
|
$parser->{XML_LIBXML_PARSER_OPTIONS} = $parser->_parser_options(\%args); |
775
|
|
|
|
|
|
|
} else { |
776
|
13
|
|
|
|
|
55
|
$parser = $class_or_self->new(\%args); |
777
|
|
|
|
|
|
|
} |
778
|
16
|
|
|
|
|
26
|
my $dom; |
779
|
16
|
100
|
|
|
|
74
|
if ( defined $args{location} ) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
780
|
1
|
|
|
|
|
6
|
$dom = $parser->parse_file( "$args{location}" ); |
781
|
|
|
|
|
|
|
} |
782
|
|
|
|
|
|
|
elsif ( defined $args{string} ) { |
783
|
13
|
|
|
|
|
50
|
$dom = $parser->parse_string( $args{string}, $URI ); |
784
|
|
|
|
|
|
|
} |
785
|
|
|
|
|
|
|
elsif ( defined $args{IO} ) { |
786
|
2
|
|
|
|
|
11
|
$dom = $parser->parse_fh( $args{IO}, $URI ); |
787
|
|
|
|
|
|
|
} |
788
|
|
|
|
|
|
|
else { |
789
|
0
|
|
|
|
|
0
|
croak("XML::LibXML->load: specify location, string, or IO"); |
790
|
|
|
|
|
|
|
} |
791
|
16
|
|
|
|
|
260
|
return $dom; |
792
|
|
|
|
|
|
|
} |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
sub load_html { |
795
|
6
|
|
|
6
|
0
|
1524
|
my ($class_or_self) = shift; |
796
|
6
|
50
|
|
|
|
14
|
my %args = map { ref($_) eq 'HASH' ? (%$_) : $_ } @_; |
|
14
|
|
|
|
|
42
|
|
797
|
6
|
|
|
|
|
16
|
my $URI = delete($args{URI}); |
798
|
6
|
50
|
|
|
|
45
|
$URI = "$URI" if defined $URI; # stringify in case it is an URI object |
799
|
6
|
|
|
|
|
10
|
my $parser; |
800
|
6
|
50
|
|
|
|
15
|
if (ref($class_or_self)) { |
801
|
6
|
|
|
|
|
15
|
$parser = $class_or_self->_clone(); |
802
|
|
|
|
|
|
|
} else { |
803
|
0
|
|
|
|
|
0
|
$parser = $class_or_self->new(); |
804
|
|
|
|
|
|
|
} |
805
|
6
|
|
|
|
|
8
|
my $dom; |
806
|
6
|
50
|
|
|
|
20
|
if ( defined $args{location} ) { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
807
|
0
|
|
|
|
|
0
|
$dom = $parser->parse_html_file( "$args{location}", \%args ); |
808
|
|
|
|
|
|
|
} |
809
|
|
|
|
|
|
|
elsif ( defined $args{string} ) { |
810
|
6
|
|
|
|
|
18
|
$dom = $parser->parse_html_string( $args{string}, \%args ); |
811
|
|
|
|
|
|
|
} |
812
|
|
|
|
|
|
|
elsif ( defined $args{IO} ) { |
813
|
0
|
|
|
|
|
0
|
$dom = $parser->parse_html_fh( $args{IO}, \%args ); |
814
|
|
|
|
|
|
|
} |
815
|
|
|
|
|
|
|
else { |
816
|
0
|
|
|
|
|
0
|
croak("XML::LibXML->load: specify location, string, or IO"); |
817
|
|
|
|
|
|
|
} |
818
|
6
|
|
|
|
|
79
|
return $dom; |
819
|
|
|
|
|
|
|
} |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
822
|
|
|
|
|
|
|
# parsing functions # |
823
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
824
|
|
|
|
|
|
|
# all parsing functions handle normal as SAX parsing at the same time. |
825
|
|
|
|
|
|
|
# note that SAX parsing is handled incomplete! use XML::LibXML::SAX for |
826
|
|
|
|
|
|
|
# complete parsing sequences |
827
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
828
|
|
|
|
|
|
|
sub parse_string { |
829
|
368
|
|
|
368
|
0
|
67114
|
my $self = shift; |
830
|
368
|
50
|
|
|
|
883
|
croak("parse_string is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self; |
831
|
368
|
50
|
|
|
|
796
|
croak("parse already in progress") if $self->{_State_}; |
832
|
|
|
|
|
|
|
|
833
|
368
|
100
|
100
|
|
|
1488
|
unless ( defined $_[0] and length $_[0] ) { |
834
|
8
|
|
|
|
|
668
|
croak("Empty String"); |
835
|
|
|
|
|
|
|
} |
836
|
|
|
|
|
|
|
|
837
|
360
|
|
|
|
|
529
|
$self->{_State_} = 1; |
838
|
360
|
|
|
|
|
427
|
my $result; |
839
|
|
|
|
|
|
|
|
840
|
360
|
|
|
|
|
1164
|
$self->_init_callbacks(); |
841
|
|
|
|
|
|
|
|
842
|
360
|
100
|
|
|
|
740
|
if ( defined $self->{SAX} ) { |
843
|
37
|
|
|
|
|
44
|
my $string = shift; |
844
|
37
|
|
|
|
|
56
|
$self->{SAX_ELSTACK} = []; |
845
|
37
|
|
|
|
|
45
|
eval { $result = $self->_parse_sax_string($string); }; |
|
37
|
|
|
|
|
1050
|
|
846
|
37
|
|
|
|
|
1240
|
my $err = $@; |
847
|
37
|
|
|
|
|
60
|
$self->{_State_} = 0; |
848
|
37
|
100
|
|
|
|
89
|
if ($err) { |
849
|
3
|
100
|
|
|
|
11
|
chomp $err unless ref $err; |
850
|
3
|
|
|
|
|
7
|
$self->_cleanup_callbacks(); |
851
|
3
|
|
|
|
|
175
|
croak $err; |
852
|
|
|
|
|
|
|
} |
853
|
|
|
|
|
|
|
} |
854
|
|
|
|
|
|
|
else { |
855
|
323
|
|
|
|
|
424
|
eval { $result = $self->_parse_string( @_ ); }; |
|
323
|
|
|
|
|
17674
|
|
856
|
|
|
|
|
|
|
|
857
|
323
|
|
|
|
|
1219
|
my $err = $@; |
858
|
323
|
|
|
|
|
515
|
$self->{_State_} = 0; |
859
|
323
|
100
|
|
|
|
737
|
if ($err) { |
860
|
78
|
50
|
|
|
|
155
|
chomp $err unless ref $err; |
861
|
78
|
|
|
|
|
175
|
$self->_cleanup_callbacks(); |
862
|
78
|
|
|
|
|
1422
|
croak $err; |
863
|
|
|
|
|
|
|
} |
864
|
|
|
|
|
|
|
|
865
|
245
|
|
|
|
|
835
|
$result = $self->_auto_expand( $result, $self->{XML_LIBXML_BASE_URI} ); |
866
|
|
|
|
|
|
|
} |
867
|
278
|
|
|
|
|
754
|
$self->_cleanup_callbacks(); |
868
|
|
|
|
|
|
|
|
869
|
278
|
|
|
|
|
797
|
return $result; |
870
|
|
|
|
|
|
|
} |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
sub parse_fh { |
873
|
9
|
|
|
9
|
0
|
2069
|
my $self = shift; |
874
|
9
|
50
|
|
|
|
28
|
croak("parse_fh is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self; |
875
|
9
|
50
|
|
|
|
30
|
croak("parse already in progress") if $self->{_State_}; |
876
|
9
|
|
|
|
|
16
|
$self->{_State_} = 1; |
877
|
9
|
|
|
|
|
12
|
my $result; |
878
|
|
|
|
|
|
|
|
879
|
9
|
|
|
|
|
71
|
$self->_init_callbacks(); |
880
|
|
|
|
|
|
|
|
881
|
9
|
50
|
|
|
|
25
|
if ( defined $self->{SAX} ) { |
882
|
0
|
|
|
|
|
0
|
$self->{SAX_ELSTACK} = []; |
883
|
0
|
|
|
|
|
0
|
eval { $self->_parse_sax_fh( @_ ); }; |
|
0
|
|
|
|
|
0
|
|
884
|
0
|
|
|
|
|
0
|
my $err = $@; |
885
|
0
|
|
|
|
|
0
|
$self->{_State_} = 0; |
886
|
0
|
0
|
|
|
|
0
|
if ($err) { |
887
|
0
|
0
|
|
|
|
0
|
chomp $err unless ref $err; |
888
|
0
|
|
|
|
|
0
|
$self->_cleanup_callbacks(); |
889
|
0
|
|
|
|
|
0
|
croak $err; |
890
|
|
|
|
|
|
|
} |
891
|
|
|
|
|
|
|
} |
892
|
|
|
|
|
|
|
else { |
893
|
9
|
|
|
|
|
17
|
eval { $result = $self->_parse_fh( @_ ); }; |
|
9
|
|
|
|
|
104
|
|
894
|
9
|
|
|
|
|
296
|
my $err = $@; |
895
|
9
|
|
|
|
|
20
|
$self->{_State_} = 0; |
896
|
9
|
100
|
|
|
|
28
|
if ($err) { |
897
|
3
|
100
|
|
|
|
10
|
chomp $err unless ref $err; |
898
|
3
|
|
|
|
|
9
|
$self->_cleanup_callbacks(); |
899
|
3
|
|
|
|
|
256
|
croak $err; |
900
|
|
|
|
|
|
|
} |
901
|
|
|
|
|
|
|
|
902
|
6
|
|
|
|
|
30
|
$result = $self->_auto_expand( $result, $self->{XML_LIBXML_BASE_URI} ); |
903
|
|
|
|
|
|
|
} |
904
|
|
|
|
|
|
|
|
905
|
6
|
|
|
|
|
21
|
$self->_cleanup_callbacks(); |
906
|
|
|
|
|
|
|
|
907
|
6
|
|
|
|
|
64
|
return $result; |
908
|
|
|
|
|
|
|
} |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
sub parse_file { |
911
|
68
|
|
|
68
|
0
|
5322
|
my $self = shift; |
912
|
68
|
50
|
|
|
|
171
|
croak("parse_file is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self; |
913
|
68
|
50
|
|
|
|
152
|
croak("parse already in progress") if $self->{_State_}; |
914
|
|
|
|
|
|
|
|
915
|
68
|
|
|
|
|
105
|
$self->{_State_} = 1; |
916
|
68
|
|
|
|
|
87
|
my $result; |
917
|
|
|
|
|
|
|
|
918
|
68
|
|
|
|
|
158
|
$self->_init_callbacks(); |
919
|
|
|
|
|
|
|
|
920
|
68
|
100
|
|
|
|
142
|
if ( defined $self->{SAX} ) { |
921
|
1
|
|
|
|
|
3
|
$self->{SAX_ELSTACK} = []; |
922
|
1
|
|
|
|
|
2
|
eval { $self->_parse_sax_file( @_ ); }; |
|
1
|
|
|
|
|
45
|
|
923
|
1
|
|
|
|
|
6
|
my $err = $@; |
924
|
1
|
|
|
|
|
3
|
$self->{_State_} = 0; |
925
|
1
|
50
|
|
|
|
5
|
if ($err) { |
926
|
0
|
0
|
|
|
|
0
|
chomp $err unless ref $err; |
927
|
0
|
|
|
|
|
0
|
$self->_cleanup_callbacks(); |
928
|
0
|
|
|
|
|
0
|
croak $err; |
929
|
|
|
|
|
|
|
} |
930
|
|
|
|
|
|
|
} |
931
|
|
|
|
|
|
|
else { |
932
|
67
|
|
|
|
|
95
|
eval { $result = $self->_parse_file(@_); }; |
|
67
|
|
|
|
|
2616
|
|
933
|
67
|
|
|
|
|
231
|
my $err = $@; |
934
|
67
|
|
|
|
|
126
|
$self->{_State_} = 0; |
935
|
67
|
100
|
|
|
|
170
|
if ($err) { |
936
|
7
|
100
|
|
|
|
24
|
chomp $err unless ref $err; |
937
|
7
|
|
|
|
|
22
|
$self->_cleanup_callbacks(); |
938
|
7
|
|
|
|
|
235
|
croak $err; |
939
|
|
|
|
|
|
|
} |
940
|
|
|
|
|
|
|
|
941
|
60
|
|
|
|
|
167
|
$result = $self->_auto_expand( $result ); |
942
|
|
|
|
|
|
|
} |
943
|
61
|
|
|
|
|
140
|
$self->_cleanup_callbacks(); |
944
|
|
|
|
|
|
|
|
945
|
61
|
|
|
|
|
249
|
return $result; |
946
|
|
|
|
|
|
|
} |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
sub parse_xml_chunk { |
949
|
75
|
|
|
75
|
0
|
4029
|
my $self = shift; |
950
|
|
|
|
|
|
|
# max 2 parameter: |
951
|
|
|
|
|
|
|
# 1: the chunk |
952
|
|
|
|
|
|
|
# 2: the encoding of the string |
953
|
75
|
50
|
|
|
|
163
|
croak("parse_xml_chunk is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self; |
954
|
75
|
50
|
|
|
|
161
|
croak("parse already in progress") if $self->{_State_}; my $result; |
|
75
|
|
|
|
|
84
|
|
955
|
|
|
|
|
|
|
|
956
|
75
|
100
|
100
|
|
|
274
|
unless ( defined $_[0] and length $_[0] ) { |
957
|
3
|
|
|
|
|
318
|
croak("Empty String"); |
958
|
|
|
|
|
|
|
} |
959
|
|
|
|
|
|
|
|
960
|
72
|
|
|
|
|
91
|
$self->{_State_} = 1; |
961
|
|
|
|
|
|
|
|
962
|
72
|
|
|
|
|
146
|
$self->_init_callbacks(); |
963
|
|
|
|
|
|
|
|
964
|
72
|
100
|
|
|
|
110
|
if ( defined $self->{SAX} ) { |
965
|
29
|
|
|
|
|
36
|
eval { |
966
|
29
|
|
|
|
|
1182
|
$self->_parse_sax_xml_chunk( @_ ); |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
# this is required for XML::GenericChunk. |
969
|
|
|
|
|
|
|
# in normal case is_filter is not defined, an thus the parsing |
970
|
|
|
|
|
|
|
# will be terminated. in case of a SAX filter the parsing is not |
971
|
|
|
|
|
|
|
# finished at that state. therefore we must not reset the parsing |
972
|
29
|
100
|
|
|
|
77
|
unless ( $self->{IS_FILTER} ) { |
973
|
27
|
|
|
|
|
62
|
$result = $self->{HANDLER}->end_document(); |
974
|
|
|
|
|
|
|
} |
975
|
|
|
|
|
|
|
}; |
976
|
|
|
|
|
|
|
} |
977
|
|
|
|
|
|
|
else { |
978
|
43
|
|
|
|
|
57
|
eval { $result = $self->_parse_xml_chunk( @_ ); }; |
|
43
|
|
|
|
|
1685
|
|
979
|
|
|
|
|
|
|
} |
980
|
|
|
|
|
|
|
|
981
|
72
|
|
|
|
|
235
|
$self->_cleanup_callbacks(); |
982
|
|
|
|
|
|
|
|
983
|
72
|
|
|
|
|
105
|
my $err = $@; |
984
|
72
|
|
|
|
|
99
|
$self->{_State_} = 0; |
985
|
72
|
100
|
|
|
|
136
|
if ($err) { |
986
|
8
|
50
|
|
|
|
21
|
chomp $err unless ref $err; |
987
|
8
|
|
|
|
|
148
|
croak $err; |
988
|
|
|
|
|
|
|
} |
989
|
|
|
|
|
|
|
|
990
|
64
|
|
|
|
|
118
|
return $result; |
991
|
|
|
|
|
|
|
} |
992
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
sub parse_balanced_chunk { |
994
|
1
|
|
|
1
|
0
|
3
|
my $self = shift; |
995
|
1
|
|
|
|
|
3
|
$self->_init_callbacks(); |
996
|
1
|
|
|
|
|
2
|
my $rv; |
997
|
1
|
|
|
|
|
2
|
eval { |
998
|
1
|
|
|
|
|
2
|
$rv = $self->parse_xml_chunk( @_ ); |
999
|
|
|
|
|
|
|
}; |
1000
|
1
|
|
|
|
|
1
|
my $err = $@; |
1001
|
1
|
|
|
|
|
3
|
$self->_cleanup_callbacks(); |
1002
|
1
|
50
|
|
|
|
4
|
if ( $err ) { |
1003
|
0
|
0
|
|
|
|
0
|
chomp $err unless ref $err; |
1004
|
0
|
|
|
|
|
0
|
croak $err; |
1005
|
|
|
|
|
|
|
} |
1006
|
1
|
|
|
|
|
3
|
return $rv |
1007
|
|
|
|
|
|
|
} |
1008
|
|
|
|
|
|
|
|
1009
|
|
|
|
|
|
|
# java style |
1010
|
|
|
|
|
|
|
sub processXIncludes { |
1011
|
22
|
|
|
22
|
0
|
1472
|
my $self = shift; |
1012
|
22
|
|
|
|
|
34
|
my $doc = shift; |
1013
|
22
|
|
|
|
|
30
|
my $opts = shift; |
1014
|
22
|
|
|
|
|
62
|
my $options = $self->_parser_options($opts); |
1015
|
22
|
100
|
|
|
|
55
|
if ( $self->{_State_} != 1 ) { |
1016
|
6
|
|
|
|
|
14
|
$self->_init_callbacks(); |
1017
|
|
|
|
|
|
|
} |
1018
|
22
|
|
|
|
|
27
|
my $rv; |
1019
|
22
|
|
|
|
|
31
|
eval { |
1020
|
22
|
|
100
|
|
|
284
|
$rv = $self->_processXIncludes($doc || " ", $options); |
1021
|
|
|
|
|
|
|
}; |
1022
|
22
|
|
|
|
|
66
|
my $err = $@; |
1023
|
22
|
100
|
|
|
|
69
|
if ( $self->{_State_} != 1 ) { |
1024
|
6
|
|
|
|
|
15
|
$self->_cleanup_callbacks(); |
1025
|
|
|
|
|
|
|
} |
1026
|
|
|
|
|
|
|
|
1027
|
22
|
100
|
|
|
|
50
|
if ( $err ) { |
1028
|
4
|
100
|
|
|
|
10
|
chomp $err unless ref $err; |
1029
|
4
|
|
|
|
|
191
|
croak $err; |
1030
|
|
|
|
|
|
|
} |
1031
|
18
|
|
|
|
|
37
|
return $rv; |
1032
|
|
|
|
|
|
|
} |
1033
|
|
|
|
|
|
|
|
1034
|
|
|
|
|
|
|
# perl style |
1035
|
|
|
|
|
|
|
sub process_xincludes { |
1036
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
1037
|
0
|
|
|
|
|
0
|
my $doc = shift; |
1038
|
0
|
|
|
|
|
0
|
my $opts = shift; |
1039
|
0
|
|
|
|
|
0
|
my $options = $self->_parser_options($opts); |
1040
|
|
|
|
|
|
|
|
1041
|
0
|
|
|
|
|
0
|
my $rv; |
1042
|
0
|
|
|
|
|
0
|
$self->_init_callbacks(); |
1043
|
0
|
|
|
|
|
0
|
eval { |
1044
|
0
|
|
0
|
|
|
0
|
$rv = $self->_processXIncludes($doc || " ", $options); |
1045
|
|
|
|
|
|
|
}; |
1046
|
0
|
|
|
|
|
0
|
my $err = $@; |
1047
|
0
|
|
|
|
|
0
|
$self->_cleanup_callbacks(); |
1048
|
0
|
0
|
|
|
|
0
|
if ( $err ) { |
1049
|
0
|
0
|
|
|
|
0
|
chomp $err unless ref $err; |
1050
|
0
|
|
|
|
|
0
|
croak $@; |
1051
|
|
|
|
|
|
|
} |
1052
|
0
|
|
|
|
|
0
|
return $rv; |
1053
|
|
|
|
|
|
|
} |
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1056
|
|
|
|
|
|
|
# HTML parsing functions # |
1057
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1058
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
sub _html_options { |
1060
|
28
|
|
|
28
|
|
42
|
my ($self,$opts)=@_; |
1061
|
28
|
100
|
|
|
|
60
|
$opts = {} unless ref $opts; |
1062
|
|
|
|
|
|
|
# return (undef,undef) unless ref $opts; |
1063
|
28
|
|
|
|
|
36
|
my $flags = 0; |
1064
|
|
|
|
|
|
|
{ |
1065
|
28
|
100
|
|
|
|
35
|
my $recover = exists $opts->{recover} ? $opts->{recover} : $self->recover; |
|
28
|
|
|
|
|
73
|
|
1066
|
|
|
|
|
|
|
|
1067
|
28
|
100
|
|
|
|
56
|
if ($recover) |
1068
|
|
|
|
|
|
|
{ |
1069
|
20
|
|
|
|
|
29
|
$flags |= HTML_PARSE_RECOVER; |
1070
|
20
|
100
|
|
|
|
37
|
if ($recover == 2) |
1071
|
|
|
|
|
|
|
{ |
1072
|
4
|
|
|
|
|
8
|
$flags |= HTML_PARSE_NOERROR; |
1073
|
|
|
|
|
|
|
} |
1074
|
|
|
|
|
|
|
} |
1075
|
|
|
|
|
|
|
} |
1076
|
|
|
|
|
|
|
|
1077
|
28
|
100
|
|
|
|
64
|
$flags |= 4 if $opts->{no_defdtd}; # default is ON: injects DTD as needed |
1078
|
28
|
100
|
|
|
|
70
|
$flags |= 32 if exists $opts->{suppress_errors} ? $opts->{suppress_errors} : $self->get_option('suppress_errors'); |
|
|
100
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
# This is to fix https://rt.cpan.org/Ticket/Display.html?id=58024 : |
1080
|
|
|
|
|
|
|
# |
1081
|
|
|
|
|
|
|
# In XML::LibXML, warnings are not suppressed when specifying the recover |
1082
|
|
|
|
|
|
|
# or recover_silently flags as per the following excerpt from the manpage: |
1083
|
|
|
|
|
|
|
# |
1084
|
28
|
100
|
|
|
|
69
|
if ($self->recover_silently) |
1085
|
|
|
|
|
|
|
{ |
1086
|
1
|
|
|
|
|
1
|
$flags |= 32; |
1087
|
|
|
|
|
|
|
} |
1088
|
28
|
50
|
|
|
|
63
|
$flags |= 64 if $opts->{suppress_warnings}; |
1089
|
28
|
50
|
|
|
|
63
|
$flags |= 128 if exists $opts->{pedantic_parser} ? $opts->{pedantic_parser} : $self->pedantic_parser; |
|
|
50
|
|
|
|
|
|
1090
|
28
|
50
|
|
|
|
65
|
$flags |= 256 if exists $opts->{no_blanks} ? $opts->{no_blanks} : !$self->keep_blanks; |
|
|
50
|
|
|
|
|
|
1091
|
28
|
50
|
|
|
|
87
|
$flags |= 2048 if exists $opts->{no_network} ? $opts->{no_network} : !$self->no_network; |
|
|
50
|
|
|
|
|
|
1092
|
28
|
50
|
|
|
|
51
|
$flags |= 16384 if $opts->{no_cdata}; |
1093
|
28
|
50
|
|
|
|
57
|
$flags |= 65536 if $opts->{compact}; # compact small text nodes; no modification |
1094
|
|
|
|
|
|
|
# of the tree allowed afterwards |
1095
|
|
|
|
|
|
|
# (WILL possibly CRASH IF YOU try to MODIFY THE TREE) |
1096
|
28
|
50
|
|
|
|
48
|
$flags |= 524288 if $opts->{huge}; # relax any hardcoded limit from the parser |
1097
|
28
|
50
|
|
|
|
57
|
$flags |= 1048576 if $opts->{oldsax}; # parse using SAX2 interface from before 2.7.0 |
1098
|
|
|
|
|
|
|
|
1099
|
28
|
|
|
|
|
5165
|
return ($opts->{URI},$opts->{encoding},$flags); |
1100
|
|
|
|
|
|
|
} |
1101
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
sub parse_html_string { |
1103
|
18
|
|
|
18
|
0
|
9714
|
my ($self,$str,$opts) = @_; |
1104
|
18
|
50
|
|
|
|
42
|
croak("parse_html_string is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self; |
1105
|
18
|
50
|
|
|
|
43
|
croak("parse already in progress") if $self->{_State_}; |
1106
|
|
|
|
|
|
|
|
1107
|
18
|
50
|
33
|
|
|
919
|
unless ( defined $str and length $str ) { |
1108
|
0
|
|
|
|
|
0
|
croak("Empty String"); |
1109
|
|
|
|
|
|
|
} |
1110
|
18
|
|
|
|
|
28
|
$self->{_State_} = 1; |
1111
|
18
|
|
|
|
|
22
|
my $result; |
1112
|
|
|
|
|
|
|
|
1113
|
18
|
|
|
|
|
44
|
$self->_init_callbacks(); |
1114
|
18
|
|
|
|
|
23
|
eval { |
1115
|
18
|
|
|
|
|
47
|
$result = $self->_parse_html_string( $str, |
1116
|
|
|
|
|
|
|
$self->_html_options($opts) |
1117
|
|
|
|
|
|
|
); |
1118
|
|
|
|
|
|
|
}; |
1119
|
18
|
|
|
|
|
159
|
my $err = $@; |
1120
|
18
|
|
|
|
|
34
|
$self->{_State_} = 0; |
1121
|
18
|
50
|
|
|
|
42
|
if ($err) { |
1122
|
0
|
0
|
|
|
|
0
|
chomp $err unless ref $err; |
1123
|
0
|
|
|
|
|
0
|
$self->_cleanup_callbacks(); |
1124
|
0
|
|
|
|
|
0
|
croak $err; |
1125
|
|
|
|
|
|
|
} |
1126
|
|
|
|
|
|
|
|
1127
|
18
|
|
|
|
|
48
|
$self->_cleanup_callbacks(); |
1128
|
|
|
|
|
|
|
|
1129
|
18
|
|
|
|
|
143
|
return $result; |
1130
|
|
|
|
|
|
|
} |
1131
|
|
|
|
|
|
|
|
1132
|
|
|
|
|
|
|
sub parse_html_file { |
1133
|
6
|
|
|
6
|
0
|
1896
|
my ($self,$file,$opts) = @_; |
1134
|
6
|
50
|
|
|
|
18
|
croak("parse_html_file is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self; |
1135
|
6
|
50
|
|
|
|
15
|
croak("parse already in progress") if $self->{_State_}; |
1136
|
6
|
|
|
|
|
9
|
$self->{_State_} = 1; |
1137
|
6
|
|
|
|
|
8
|
my $result; |
1138
|
|
|
|
|
|
|
|
1139
|
6
|
|
|
|
|
14
|
$self->_init_callbacks(); |
1140
|
6
|
|
|
|
|
8
|
eval { $result = $self->_parse_html_file($file, |
|
6
|
|
|
|
|
16
|
|
1141
|
|
|
|
|
|
|
$self->_html_options($opts) |
1142
|
|
|
|
|
|
|
); }; |
1143
|
6
|
|
|
|
|
26
|
my $err = $@; |
1144
|
6
|
|
|
|
|
13
|
$self->{_State_} = 0; |
1145
|
6
|
50
|
|
|
|
17
|
if ($err) { |
1146
|
0
|
0
|
|
|
|
0
|
chomp $err unless ref $err; |
1147
|
0
|
|
|
|
|
0
|
$self->_cleanup_callbacks(); |
1148
|
0
|
|
|
|
|
0
|
croak $err; |
1149
|
|
|
|
|
|
|
} |
1150
|
|
|
|
|
|
|
|
1151
|
6
|
|
|
|
|
20
|
$self->_cleanup_callbacks(); |
1152
|
|
|
|
|
|
|
|
1153
|
6
|
|
|
|
|
42
|
return $result; |
1154
|
|
|
|
|
|
|
} |
1155
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
sub parse_html_fh { |
1157
|
4
|
|
|
4
|
0
|
213
|
my ($self,$fh,$opts) = @_; |
1158
|
4
|
50
|
|
|
|
10
|
croak("parse_html_fh is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self; |
1159
|
4
|
50
|
|
|
|
11
|
croak("parse already in progress") if $self->{_State_}; |
1160
|
4
|
|
|
|
|
5
|
$self->{_State_} = 1; |
1161
|
|
|
|
|
|
|
|
1162
|
4
|
|
|
|
|
7
|
my $result; |
1163
|
4
|
|
|
|
|
8
|
$self->_init_callbacks(); |
1164
|
4
|
|
|
|
|
7
|
eval { $result = $self->_parse_html_fh( $fh, |
|
4
|
|
|
|
|
10
|
|
1165
|
|
|
|
|
|
|
$self->_html_options($opts) |
1166
|
|
|
|
|
|
|
); }; |
1167
|
4
|
|
|
|
|
12
|
my $err = $@; |
1168
|
4
|
|
|
|
|
7
|
$self->{_State_} = 0; |
1169
|
4
|
50
|
|
|
|
9
|
if ($err) { |
1170
|
0
|
0
|
|
|
|
0
|
chomp $err unless ref $err; |
1171
|
0
|
|
|
|
|
0
|
$self->_cleanup_callbacks(); |
1172
|
0
|
|
|
|
|
0
|
croak $err; |
1173
|
|
|
|
|
|
|
} |
1174
|
4
|
|
|
|
|
11
|
$self->_cleanup_callbacks(); |
1175
|
|
|
|
|
|
|
|
1176
|
4
|
|
|
|
|
24
|
return $result; |
1177
|
|
|
|
|
|
|
} |
1178
|
|
|
|
|
|
|
|
1179
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1180
|
|
|
|
|
|
|
# push parser interface # |
1181
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1182
|
|
|
|
|
|
|
sub init_push { |
1183
|
76
|
|
|
76
|
0
|
621
|
my $self = shift; |
1184
|
|
|
|
|
|
|
|
1185
|
76
|
100
|
|
|
|
125
|
if ( defined $self->{CONTEXT} ) { |
1186
|
1
|
|
|
|
|
7
|
delete $self->{CONTEXT}; |
1187
|
|
|
|
|
|
|
} |
1188
|
|
|
|
|
|
|
|
1189
|
76
|
100
|
|
|
|
135
|
if ( defined $self->{SAX} ) { |
1190
|
36
|
|
|
|
|
570
|
$self->{CONTEXT} = $self->_start_push(1); |
1191
|
|
|
|
|
|
|
} |
1192
|
|
|
|
|
|
|
else { |
1193
|
40
|
|
|
|
|
528
|
$self->{CONTEXT} = $self->_start_push(0); |
1194
|
|
|
|
|
|
|
} |
1195
|
|
|
|
|
|
|
} |
1196
|
|
|
|
|
|
|
|
1197
|
|
|
|
|
|
|
sub push { |
1198
|
140
|
|
|
140
|
0
|
11728
|
my $self = shift; |
1199
|
|
|
|
|
|
|
|
1200
|
140
|
|
|
|
|
251
|
$self->_init_callbacks(); |
1201
|
|
|
|
|
|
|
|
1202
|
140
|
100
|
|
|
|
238
|
if ( not defined $self->{CONTEXT} ) { |
1203
|
36
|
|
|
|
|
67
|
$self->init_push(); |
1204
|
|
|
|
|
|
|
} |
1205
|
|
|
|
|
|
|
|
1206
|
140
|
|
|
|
|
191
|
eval { |
1207
|
140
|
|
|
|
|
196
|
foreach ( @_ ) { |
1208
|
140
|
|
|
|
|
1180
|
$self->_push( $self->{CONTEXT}, $_ ); |
1209
|
|
|
|
|
|
|
} |
1210
|
|
|
|
|
|
|
}; |
1211
|
140
|
|
|
|
|
215
|
my $err = $@; |
1212
|
140
|
|
|
|
|
263
|
$self->_cleanup_callbacks(); |
1213
|
140
|
50
|
|
|
|
296
|
if ( $err ) { |
1214
|
0
|
0
|
|
|
|
0
|
chomp $err unless ref $err; |
1215
|
0
|
|
|
|
|
0
|
croak $err; |
1216
|
|
|
|
|
|
|
} |
1217
|
|
|
|
|
|
|
} |
1218
|
|
|
|
|
|
|
|
1219
|
|
|
|
|
|
|
# this function should be promoted! |
1220
|
|
|
|
|
|
|
# the reason is because libxml2 uses xmlParseChunk() for this purpose! |
1221
|
|
|
|
|
|
|
sub parse_chunk { |
1222
|
197
|
|
|
197
|
0
|
33180
|
my $self = shift; |
1223
|
197
|
|
|
|
|
253
|
my $chunk = shift; |
1224
|
197
|
|
|
|
|
197
|
my $terminate = shift; |
1225
|
|
|
|
|
|
|
|
1226
|
197
|
100
|
|
|
|
342
|
if ( not defined $self->{CONTEXT} ) { |
1227
|
39
|
|
|
|
|
70
|
$self->init_push(); |
1228
|
|
|
|
|
|
|
} |
1229
|
|
|
|
|
|
|
|
1230
|
197
|
100
|
66
|
|
|
497
|
if ( defined $chunk and length $chunk ) { |
1231
|
159
|
|
|
|
|
935
|
$self->_push( $self->{CONTEXT}, $chunk ); |
1232
|
|
|
|
|
|
|
} |
1233
|
|
|
|
|
|
|
|
1234
|
188
|
100
|
|
|
|
445
|
if ( $terminate ) { |
1235
|
38
|
|
|
|
|
75
|
return $self->finish_push(); |
1236
|
|
|
|
|
|
|
} |
1237
|
|
|
|
|
|
|
} |
1238
|
|
|
|
|
|
|
|
1239
|
|
|
|
|
|
|
|
1240
|
|
|
|
|
|
|
sub finish_push { |
1241
|
75
|
|
|
75
|
0
|
224
|
my $self = shift; |
1242
|
75
|
|
100
|
|
|
199
|
my $restore = shift || 0; |
1243
|
75
|
50
|
|
|
|
125
|
return undef unless defined $self->{CONTEXT}; |
1244
|
|
|
|
|
|
|
|
1245
|
75
|
|
|
|
|
82
|
my $retval; |
1246
|
|
|
|
|
|
|
|
1247
|
75
|
100
|
|
|
|
134
|
if ( defined $self->{SAX} ) { |
1248
|
36
|
|
|
|
|
38
|
eval { |
1249
|
36
|
|
|
|
|
283
|
$self->_end_sax_push( $self->{CONTEXT} ); |
1250
|
36
|
|
|
|
|
107
|
$retval = $self->{HANDLER}->end_document( {} ); |
1251
|
|
|
|
|
|
|
}; |
1252
|
|
|
|
|
|
|
} |
1253
|
|
|
|
|
|
|
else { |
1254
|
39
|
|
|
|
|
67
|
eval { $retval = $self->_end_push( $self->{CONTEXT}, $restore ); }; |
|
39
|
|
|
|
|
308
|
|
1255
|
|
|
|
|
|
|
} |
1256
|
75
|
|
|
|
|
123
|
my $err = $@; |
1257
|
75
|
|
|
|
|
183
|
delete $self->{CONTEXT}; |
1258
|
75
|
50
|
|
|
|
124
|
if ( $err ) { |
1259
|
0
|
0
|
|
|
|
0
|
chomp $err unless ref $err; |
1260
|
0
|
|
|
|
|
0
|
croak( $err ); |
1261
|
|
|
|
|
|
|
} |
1262
|
75
|
|
|
|
|
151
|
return $retval; |
1263
|
|
|
|
|
|
|
} |
1264
|
|
|
|
|
|
|
|
1265
|
|
|
|
|
|
|
1; |
1266
|
|
|
|
|
|
|
|
1267
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1268
|
|
|
|
|
|
|
# XML::LibXML::Node Interface # |
1269
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1270
|
|
|
|
|
|
|
package XML::LibXML::Node; |
1271
|
|
|
|
|
|
|
|
1272
|
67
|
|
|
67
|
|
907
|
use Carp qw(croak); |
|
67
|
|
|
|
|
162
|
|
|
67
|
|
|
|
|
9145
|
|
1273
|
|
|
|
|
|
|
|
1274
|
|
|
|
|
|
|
use overload |
1275
|
2
|
|
|
2
|
|
584
|
'""' => sub { $_[0]->toString() }, |
1276
|
734
|
|
|
734
|
|
93966
|
'bool' => sub { 1 }, |
1277
|
19224
|
|
|
19224
|
|
30218
|
'0+' => sub { Scalar::Util::refaddr($_[0]) }, |
1278
|
67
|
|
|
|
|
959
|
fallback => 1, |
1279
|
67
|
|
|
67
|
|
500
|
; |
|
67
|
|
|
|
|
175
|
|
1280
|
|
|
|
|
|
|
|
1281
|
|
|
|
|
|
|
|
1282
|
|
|
|
|
|
|
sub CLONE_SKIP { |
1283
|
0
|
0
|
|
0
|
|
0
|
return $XML::LibXML::__threads_shared ? 0 : 1; |
1284
|
|
|
|
|
|
|
} |
1285
|
|
|
|
|
|
|
|
1286
|
|
|
|
|
|
|
sub isSupported { |
1287
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1288
|
0
|
|
|
|
|
0
|
my $feature = shift; |
1289
|
0
|
0
|
|
|
|
0
|
return $self->can($feature) ? 1 : 0; |
1290
|
|
|
|
|
|
|
} |
1291
|
|
|
|
|
|
|
|
1292
|
0
|
|
|
0
|
|
0
|
sub getChildNodes { my $self = shift; return $self->childNodes(); } |
|
0
|
|
|
|
|
0
|
|
1293
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
sub childNodes { |
1295
|
159
|
|
|
159
|
|
17708
|
my $self = shift; |
1296
|
159
|
|
|
|
|
881
|
my @children = $self->_childNodes(0); |
1297
|
159
|
100
|
|
|
|
577
|
return wantarray ? @children : XML::LibXML::NodeList->new_from_ref(\@children , 1); |
1298
|
|
|
|
|
|
|
} |
1299
|
|
|
|
|
|
|
|
1300
|
|
|
|
|
|
|
sub nonBlankChildNodes { |
1301
|
2
|
|
|
2
|
|
544
|
my $self = shift; |
1302
|
2
|
|
|
|
|
19
|
my @children = $self->_childNodes(1); |
1303
|
2
|
50
|
|
|
|
11
|
return wantarray ? @children : XML::LibXML::NodeList->new_from_ref(\@children , 1); |
1304
|
|
|
|
|
|
|
} |
1305
|
|
|
|
|
|
|
|
1306
|
|
|
|
|
|
|
sub attributes { |
1307
|
51
|
|
|
51
|
|
5301
|
my $self = shift; |
1308
|
51
|
|
|
|
|
311
|
my @attr = $self->_attributes(); |
1309
|
51
|
100
|
|
|
|
165
|
return wantarray ? @attr : XML::LibXML::NamedNodeMap->new( @attr ); |
1310
|
|
|
|
|
|
|
} |
1311
|
|
|
|
|
|
|
|
1312
|
|
|
|
|
|
|
|
1313
|
|
|
|
|
|
|
sub findnodes { |
1314
|
66
|
|
|
66
|
|
12526
|
my ($node, $xpath) = @_; |
1315
|
66
|
|
|
|
|
4773
|
my @nodes = $node->_findnodes($xpath); |
1316
|
58
|
100
|
|
|
|
227
|
if (wantarray) { |
1317
|
44
|
|
|
|
|
4721
|
return @nodes; |
1318
|
|
|
|
|
|
|
} |
1319
|
|
|
|
|
|
|
else { |
1320
|
14
|
|
|
|
|
85
|
return XML::LibXML::NodeList->new_from_ref(\@nodes, 1); |
1321
|
|
|
|
|
|
|
} |
1322
|
|
|
|
|
|
|
} |
1323
|
|
|
|
|
|
|
|
1324
|
|
|
|
|
|
|
sub exists { |
1325
|
8
|
|
|
8
|
|
285
|
my ($node, $xpath) = @_; |
1326
|
8
|
|
|
|
|
268
|
my (undef, $value) = $node->_find($xpath,1); |
1327
|
8
|
|
|
|
|
41
|
return $value; |
1328
|
|
|
|
|
|
|
} |
1329
|
|
|
|
|
|
|
|
1330
|
|
|
|
|
|
|
sub findvalue { |
1331
|
20
|
|
|
20
|
|
1291
|
my ($node, $xpath) = @_; |
1332
|
20
|
|
|
|
|
29
|
my $res; |
1333
|
20
|
|
|
|
|
45
|
$res = $node->find($xpath); |
1334
|
16
|
|
|
|
|
40
|
return $res->to_literal->value; |
1335
|
|
|
|
|
|
|
} |
1336
|
|
|
|
|
|
|
|
1337
|
|
|
|
|
|
|
sub findbool { |
1338
|
0
|
|
|
0
|
|
0
|
my ($node, $xpath) = @_; |
1339
|
0
|
|
|
|
|
0
|
my ($type, @params) = $node->_find($xpath,1); |
1340
|
0
|
0
|
|
|
|
0
|
if ($type) { |
1341
|
0
|
|
|
|
|
0
|
return $type->new(@params); |
1342
|
|
|
|
|
|
|
} |
1343
|
0
|
|
|
|
|
0
|
return undef; |
1344
|
|
|
|
|
|
|
} |
1345
|
|
|
|
|
|
|
|
1346
|
|
|
|
|
|
|
sub find { |
1347
|
46
|
|
|
46
|
|
1480
|
my ($node, $xpath) = @_; |
1348
|
46
|
|
|
|
|
1474
|
my ($type, @params) = $node->_find($xpath,0); |
1349
|
34
|
50
|
|
|
|
125
|
if ($type) { |
1350
|
34
|
|
|
|
|
153
|
return $type->new(@params); |
1351
|
|
|
|
|
|
|
} |
1352
|
0
|
|
|
|
|
0
|
return undef; |
1353
|
|
|
|
|
|
|
} |
1354
|
|
|
|
|
|
|
|
1355
|
|
|
|
|
|
|
sub setOwnerDocument { |
1356
|
1
|
|
|
1
|
|
4
|
my ( $self, $doc ) = @_; |
1357
|
1
|
|
|
|
|
6
|
$doc->adoptNode( $self ); |
1358
|
|
|
|
|
|
|
} |
1359
|
|
|
|
|
|
|
|
1360
|
|
|
|
|
|
|
sub toStringC14N { |
1361
|
14
|
|
|
14
|
|
1371
|
my ($self, $comments, $xpath, $xpc) = @_; |
1362
|
14
|
100
|
100
|
|
|
454
|
return $self->_toStringC14N( $comments || 0, |
|
|
50
|
|
|
|
|
|
1363
|
|
|
|
|
|
|
(defined $xpath ? $xpath : undef), |
1364
|
|
|
|
|
|
|
0, |
1365
|
|
|
|
|
|
|
undef, |
1366
|
|
|
|
|
|
|
(defined $xpc ? $xpc : undef) |
1367
|
|
|
|
|
|
|
); |
1368
|
|
|
|
|
|
|
} |
1369
|
|
|
|
|
|
|
|
1370
|
|
|
|
|
|
|
{ |
1371
|
|
|
|
|
|
|
my $C14N_version_1_dot_1_val = 2; |
1372
|
|
|
|
|
|
|
|
1373
|
|
|
|
|
|
|
sub toStringC14N_v1_1 { |
1374
|
0
|
|
|
0
|
|
0
|
my ($self, $comments, $xpath, $xpc) = @_; |
1375
|
|
|
|
|
|
|
|
1376
|
0
|
0
|
0
|
|
|
0
|
return $self->_toStringC14N( |
|
|
0
|
|
|
|
|
|
1377
|
|
|
|
|
|
|
$comments || 0, |
1378
|
|
|
|
|
|
|
(defined $xpath ? $xpath : undef), |
1379
|
|
|
|
|
|
|
$C14N_version_1_dot_1_val, |
1380
|
|
|
|
|
|
|
undef, |
1381
|
|
|
|
|
|
|
(defined $xpc ? $xpc : undef) |
1382
|
|
|
|
|
|
|
); |
1383
|
|
|
|
|
|
|
} |
1384
|
|
|
|
|
|
|
|
1385
|
|
|
|
|
|
|
} |
1386
|
|
|
|
|
|
|
|
1387
|
|
|
|
|
|
|
sub toStringEC14N { |
1388
|
10
|
|
|
10
|
|
2716
|
my ($self, $comments, $xpath, $xpc, $inc_prefix_list) = @_; |
1389
|
10
|
100
|
|
|
|
33
|
unless (UNIVERSAL::isa($xpc,'XML::LibXML::XPathContext')) { |
1390
|
8
|
50
|
|
|
|
21
|
if ($inc_prefix_list) { |
1391
|
0
|
|
|
|
|
0
|
croak("toStringEC14N: 3rd argument is not an XML::LibXML::XPathContext"); |
1392
|
|
|
|
|
|
|
} else { |
1393
|
8
|
|
|
|
|
10
|
$inc_prefix_list=$xpc; |
1394
|
8
|
|
|
|
|
11
|
$xpc=undef; |
1395
|
|
|
|
|
|
|
} |
1396
|
|
|
|
|
|
|
} |
1397
|
10
|
50
|
66
|
|
|
46
|
if (defined($inc_prefix_list) and !UNIVERSAL::isa($inc_prefix_list,'ARRAY')) { |
1398
|
0
|
|
|
|
|
0
|
croak("toStringEC14N: inclusive_prefix_list must be undefined or ARRAY"); |
1399
|
|
|
|
|
|
|
} |
1400
|
10
|
100
|
50
|
|
|
2977
|
return $self->_toStringC14N( $comments || 0, |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1401
|
|
|
|
|
|
|
(defined $xpath ? $xpath : undef), |
1402
|
|
|
|
|
|
|
1, |
1403
|
|
|
|
|
|
|
(defined $inc_prefix_list ? $inc_prefix_list : undef), |
1404
|
|
|
|
|
|
|
(defined $xpc ? $xpc : undef) |
1405
|
|
|
|
|
|
|
); |
1406
|
|
|
|
|
|
|
} |
1407
|
|
|
|
|
|
|
|
1408
|
|
|
|
|
|
|
*serialize_c14n = \&toStringC14N; |
1409
|
|
|
|
|
|
|
*serialize_exc_c14n = \&toStringEC14N; |
1410
|
|
|
|
|
|
|
|
1411
|
|
|
|
|
|
|
1; |
1412
|
|
|
|
|
|
|
|
1413
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1414
|
|
|
|
|
|
|
# XML::LibXML::Document Interface # |
1415
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1416
|
|
|
|
|
|
|
package XML::LibXML::Document; |
1417
|
|
|
|
|
|
|
|
1418
|
67
|
|
|
67
|
|
52282
|
use vars qw(@ISA); |
|
67
|
|
|
|
|
195
|
|
|
67
|
|
|
|
|
33380
|
|
1419
|
|
|
|
|
|
|
@ISA = ('XML::LibXML::Node'); |
1420
|
|
|
|
|
|
|
|
1421
|
|
|
|
|
|
|
sub actualEncoding { |
1422
|
3
|
|
|
3
|
|
1982
|
my $doc = shift; |
1423
|
3
|
|
|
|
|
18
|
my $enc = $doc->encoding; |
1424
|
3
|
50
|
33
|
|
|
26
|
return (defined $enc and length $enc) ? $enc : 'UTF-8'; |
1425
|
|
|
|
|
|
|
} |
1426
|
|
|
|
|
|
|
|
1427
|
|
|
|
|
|
|
sub setDocumentElement { |
1428
|
96
|
|
|
96
|
|
10379
|
my $doc = shift; |
1429
|
96
|
|
|
|
|
119
|
my $element = shift; |
1430
|
|
|
|
|
|
|
|
1431
|
96
|
|
|
|
|
246
|
my $oldelem = $doc->documentElement; |
1432
|
96
|
100
|
|
|
|
205
|
if ( defined $oldelem ) { |
1433
|
2
|
|
|
|
|
10
|
$doc->removeChild($oldelem); |
1434
|
|
|
|
|
|
|
} |
1435
|
|
|
|
|
|
|
|
1436
|
96
|
|
|
|
|
497
|
$doc->_setDocumentElement($element); |
1437
|
|
|
|
|
|
|
} |
1438
|
|
|
|
|
|
|
|
1439
|
|
|
|
|
|
|
sub toString { |
1440
|
33
|
|
|
33
|
|
6389
|
my $self = shift; |
1441
|
33
|
|
|
|
|
56
|
my $flag = shift; |
1442
|
|
|
|
|
|
|
|
1443
|
33
|
|
|
|
|
53
|
my $retval = ""; |
1444
|
|
|
|
|
|
|
|
1445
|
33
|
100
|
66
|
|
|
166
|
if ( defined $XML::LibXML::skipXMLDeclaration |
1446
|
|
|
|
|
|
|
and $XML::LibXML::skipXMLDeclaration == 1 ) { |
1447
|
4
|
|
|
|
|
20
|
foreach ( $self->childNodes ){ |
1448
|
4
|
0
|
33
|
|
|
35
|
next if $_->nodeType == XML::LibXML::XML_DTD_NODE() |
1449
|
|
|
|
|
|
|
and $XML::LibXML::skipDTD; |
1450
|
4
|
|
|
|
|
107
|
$retval .= $_->toString; |
1451
|
|
|
|
|
|
|
} |
1452
|
|
|
|
|
|
|
} |
1453
|
|
|
|
|
|
|
else { |
1454
|
29
|
100
|
50
|
|
|
244
|
$flag ||= 0 unless defined $flag; |
1455
|
29
|
|
|
|
|
1110
|
$retval = $self->_toString($flag); |
1456
|
|
|
|
|
|
|
} |
1457
|
|
|
|
|
|
|
|
1458
|
33
|
|
|
|
|
197
|
return $retval; |
1459
|
|
|
|
|
|
|
} |
1460
|
|
|
|
|
|
|
|
1461
|
|
|
|
|
|
|
sub serialize { |
1462
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1463
|
0
|
|
|
|
|
0
|
return $self->toString( @_ ); |
1464
|
|
|
|
|
|
|
} |
1465
|
|
|
|
|
|
|
|
1466
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1467
|
|
|
|
|
|
|
# bad style xinclude processing # |
1468
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1469
|
|
|
|
|
|
|
sub process_xinclude { |
1470
|
2
|
|
|
2
|
|
14
|
my $self = shift; |
1471
|
2
|
|
|
|
|
4
|
my $opts = shift; |
1472
|
2
|
|
|
|
|
5
|
XML::LibXML->new->processXIncludes( $self, $opts ); |
1473
|
|
|
|
|
|
|
} |
1474
|
|
|
|
|
|
|
|
1475
|
|
|
|
|
|
|
sub insertProcessingInstruction { |
1476
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1477
|
0
|
|
|
|
|
0
|
my $target = shift; |
1478
|
0
|
|
|
|
|
0
|
my $data = shift; |
1479
|
|
|
|
|
|
|
|
1480
|
0
|
|
|
|
|
0
|
my $pi = $self->createPI( $target, $data ); |
1481
|
0
|
|
|
|
|
0
|
my $root = $self->documentElement; |
1482
|
|
|
|
|
|
|
|
1483
|
0
|
0
|
|
|
|
0
|
if ( defined $root ) { |
1484
|
|
|
|
|
|
|
# this is actually not correct, but i guess it's what the user |
1485
|
|
|
|
|
|
|
# intends |
1486
|
0
|
|
|
|
|
0
|
$self->insertBefore( $pi, $root ); |
1487
|
|
|
|
|
|
|
} |
1488
|
|
|
|
|
|
|
else { |
1489
|
|
|
|
|
|
|
# if no documentElement was found we just append the PI |
1490
|
0
|
|
|
|
|
0
|
$self->appendChild( $pi ); |
1491
|
|
|
|
|
|
|
} |
1492
|
|
|
|
|
|
|
} |
1493
|
|
|
|
|
|
|
|
1494
|
|
|
|
|
|
|
sub insertPI { |
1495
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1496
|
0
|
|
|
|
|
0
|
$self->insertProcessingInstruction( @_ ); |
1497
|
|
|
|
|
|
|
} |
1498
|
|
|
|
|
|
|
|
1499
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1500
|
|
|
|
|
|
|
# DOM L3 Document functions. |
1501
|
|
|
|
|
|
|
# added after robins implicit feature request |
1502
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1503
|
|
|
|
|
|
|
*getElementsByTagName = \&XML::LibXML::Element::getElementsByTagName; |
1504
|
|
|
|
|
|
|
*getElementsByTagNameNS = \&XML::LibXML::Element::getElementsByTagNameNS; |
1505
|
|
|
|
|
|
|
*getElementsByLocalName = \&XML::LibXML::Element::getElementsByLocalName; |
1506
|
|
|
|
|
|
|
|
1507
|
|
|
|
|
|
|
1; |
1508
|
|
|
|
|
|
|
|
1509
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1510
|
|
|
|
|
|
|
# XML::LibXML::DocumentFragment Interface # |
1511
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1512
|
|
|
|
|
|
|
package XML::LibXML::DocumentFragment; |
1513
|
|
|
|
|
|
|
|
1514
|
67
|
|
|
67
|
|
517
|
use vars qw(@ISA); |
|
67
|
|
|
|
|
150
|
|
|
67
|
|
|
|
|
8564
|
|
1515
|
|
|
|
|
|
|
@ISA = ('XML::LibXML::Node'); |
1516
|
|
|
|
|
|
|
|
1517
|
|
|
|
|
|
|
sub toString { |
1518
|
58
|
|
|
58
|
|
17798
|
my $self = shift; |
1519
|
58
|
|
|
|
|
92
|
my $retval = ""; |
1520
|
58
|
50
|
|
|
|
168
|
if ( $self->hasChildNodes() ) { |
1521
|
58
|
|
|
|
|
118
|
foreach my $n ( $self->childNodes() ) { |
1522
|
104
|
|
|
|
|
965
|
$retval .= $n->toString(@_); |
1523
|
|
|
|
|
|
|
} |
1524
|
|
|
|
|
|
|
} |
1525
|
58
|
|
|
|
|
165
|
return $retval; |
1526
|
|
|
|
|
|
|
} |
1527
|
|
|
|
|
|
|
|
1528
|
|
|
|
|
|
|
*serialize = \&toString; |
1529
|
|
|
|
|
|
|
|
1530
|
|
|
|
|
|
|
1; |
1531
|
|
|
|
|
|
|
|
1532
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1533
|
|
|
|
|
|
|
# XML::LibXML::Element Interface # |
1534
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1535
|
|
|
|
|
|
|
package XML::LibXML::Element; |
1536
|
|
|
|
|
|
|
|
1537
|
67
|
|
|
67
|
|
474
|
use vars qw(@ISA); |
|
67
|
|
|
|
|
160
|
|
|
67
|
|
|
|
|
3326
|
|
1538
|
|
|
|
|
|
|
@ISA = ('XML::LibXML::Node'); |
1539
|
67
|
|
|
67
|
|
1135
|
use XML::LibXML qw(:ns :libxml); |
|
67
|
|
|
|
|
211
|
|
|
67
|
|
|
|
|
1324
|
|
1540
|
67
|
|
|
67
|
|
30864
|
use XML::LibXML::AttributeHash; |
|
67
|
|
|
|
|
196
|
|
|
67
|
|
|
|
|
1763
|
|
1541
|
67
|
|
|
67
|
|
408
|
use Carp; |
|
67
|
|
|
|
|
131
|
|
|
67
|
|
|
|
|
3738
|
|
1542
|
|
|
|
|
|
|
|
1543
|
67
|
|
|
67
|
|
398
|
use Scalar::Util qw(blessed); |
|
67
|
|
|
|
|
146
|
|
|
67
|
|
|
|
|
3394
|
|
1544
|
|
|
|
|
|
|
|
1545
|
|
|
|
|
|
|
use overload |
1546
|
67
|
|
|
|
|
481
|
'%{}' => 'getAttributeHash', |
1547
|
|
|
|
|
|
|
'eq' => '_isSameNodeLax', '==' => '_isSameNodeLax', |
1548
|
|
|
|
|
|
|
'ne' => '_isNotSameNodeLax', '!=' => '_isNotSameNodeLax', |
1549
|
|
|
|
|
|
|
fallback => 1, |
1550
|
67
|
|
|
67
|
|
384
|
; |
|
67
|
|
|
|
|
145
|
|
1551
|
|
|
|
|
|
|
|
1552
|
|
|
|
|
|
|
sub _isNotSameNodeLax { |
1553
|
4
|
|
|
4
|
|
12
|
my ($self, $other) = @_; |
1554
|
|
|
|
|
|
|
|
1555
|
4
|
50
|
|
|
|
10
|
return ((not $self->_isSameNodeLax($other)) ? 1 : ''); |
1556
|
|
|
|
|
|
|
} |
1557
|
|
|
|
|
|
|
|
1558
|
|
|
|
|
|
|
sub _isSameNodeLax { |
1559
|
13
|
|
|
13
|
|
47
|
my ($self, $other) = @_; |
1560
|
|
|
|
|
|
|
|
1561
|
13
|
100
|
66
|
|
|
816
|
if (blessed($other) and $other->isa('XML::LibXML::Element')) |
1562
|
|
|
|
|
|
|
{ |
1563
|
8
|
100
|
|
|
|
95
|
return ($self->isSameNode($other) ? 1 : ''); |
1564
|
|
|
|
|
|
|
} |
1565
|
|
|
|
|
|
|
else |
1566
|
|
|
|
|
|
|
{ |
1567
|
5
|
|
|
|
|
31
|
return ''; |
1568
|
|
|
|
|
|
|
} |
1569
|
|
|
|
|
|
|
} |
1570
|
|
|
|
|
|
|
|
1571
|
|
|
|
|
|
|
{ |
1572
|
|
|
|
|
|
|
my %tiecache; |
1573
|
|
|
|
|
|
|
|
1574
|
|
|
|
|
|
|
sub __destroy_tiecache |
1575
|
|
|
|
|
|
|
{ |
1576
|
19164
|
|
|
19164
|
|
25422
|
delete $tiecache{ 0+$_[0] }; |
1577
|
|
|
|
|
|
|
} |
1578
|
|
|
|
|
|
|
|
1579
|
|
|
|
|
|
|
sub getAttributeHash |
1580
|
|
|
|
|
|
|
{ |
1581
|
24
|
|
|
24
|
|
1327
|
my $self = shift; |
1582
|
24
|
100
|
|
|
|
55
|
if (!exists $tiecache{ 0+$self }) { |
1583
|
5
|
|
|
|
|
40
|
tie my %attr, 'XML::LibXML::AttributeHash', $self, weaken => 1; |
1584
|
5
|
|
|
|
|
14
|
$tiecache{ 0+$self } = \%attr; |
1585
|
|
|
|
|
|
|
} |
1586
|
24
|
|
|
|
|
44
|
return $tiecache{ 0+$self }; |
1587
|
|
|
|
|
|
|
} |
1588
|
|
|
|
|
|
|
sub DESTROY |
1589
|
|
|
|
|
|
|
{ |
1590
|
19162
|
|
|
19162
|
|
233782
|
my ($self) = @_; |
1591
|
19162
|
|
|
|
|
29202
|
$self->__destroy_tiecache; |
1592
|
19162
|
|
|
|
|
43665
|
$self->SUPER::DESTROY; |
1593
|
|
|
|
|
|
|
} |
1594
|
|
|
|
|
|
|
} |
1595
|
|
|
|
|
|
|
|
1596
|
|
|
|
|
|
|
sub setNamespace { |
1597
|
33
|
|
|
33
|
|
65
|
my $self = shift; |
1598
|
33
|
|
|
|
|
140
|
my $n = $self->localname; |
1599
|
33
|
50
|
|
|
|
174
|
if ( $self->_setNamespace(@_) ){ |
1600
|
33
|
100
|
100
|
|
|
133
|
if ( scalar @_ < 3 || $_[2] == 1 ){ |
1601
|
5
|
|
|
|
|
34
|
$self->setNodeName( $n ); |
1602
|
|
|
|
|
|
|
} |
1603
|
33
|
|
|
|
|
86
|
return 1; |
1604
|
|
|
|
|
|
|
} |
1605
|
0
|
|
|
|
|
0
|
return 0; |
1606
|
|
|
|
|
|
|
} |
1607
|
|
|
|
|
|
|
|
1608
|
|
|
|
|
|
|
sub getAttribute { |
1609
|
67
|
|
|
67
|
|
8310
|
my $self = shift; |
1610
|
67
|
|
|
|
|
109
|
my $name = $_[0]; |
1611
|
67
|
100
|
|
|
|
215
|
if ( $name =~ /^xmlns(?::|$)/ ) { |
1612
|
|
|
|
|
|
|
# user wants to get a namespace ... |
1613
|
21
|
|
|
|
|
67
|
(my $prefix = $name )=~s/^xmlns:?//; |
1614
|
21
|
|
|
|
|
148
|
$self->_getNamespaceDeclURI($prefix); |
1615
|
|
|
|
|
|
|
} |
1616
|
|
|
|
|
|
|
else { |
1617
|
46
|
|
|
|
|
535
|
$self->_getAttribute(@_); |
1618
|
|
|
|
|
|
|
} |
1619
|
|
|
|
|
|
|
} |
1620
|
|
|
|
|
|
|
|
1621
|
|
|
|
|
|
|
sub setAttribute { |
1622
|
38
|
|
|
38
|
|
8276
|
my ( $self, $name, $value ) = @_; |
1623
|
38
|
100
|
|
|
|
135
|
if ( $name =~ /^xmlns(?::|$)/ ) { |
1624
|
|
|
|
|
|
|
# user wants to set the special attribute for declaring XML namespace ... |
1625
|
|
|
|
|
|
|
|
1626
|
|
|
|
|
|
|
# this is fine but not exactly DOM conformant behavior, btw (according to DOM we should |
1627
|
|
|
|
|
|
|
# probably declare an attribute which looks like XML namespace declaration |
1628
|
|
|
|
|
|
|
# but isn't) |
1629
|
10
|
|
|
|
|
41
|
(my $nsprefix = $name )=~s/^xmlns:?//; |
1630
|
10
|
|
|
|
|
71
|
my $nn = $self->nodeName; |
1631
|
10
|
100
|
|
|
|
170
|
if ( $nn =~ /^\Q${nsprefix}\E:/ ) { |
1632
|
|
|
|
|
|
|
# the element has the same prefix |
1633
|
1
|
50
|
|
|
|
27
|
$self->setNamespaceDeclURI($nsprefix,$value) || |
1634
|
|
|
|
|
|
|
$self->setNamespace($value,$nsprefix,1); |
1635
|
|
|
|
|
|
|
## |
1636
|
|
|
|
|
|
|
## We set the namespace here. |
1637
|
|
|
|
|
|
|
## This is helpful, as in: |
1638
|
|
|
|
|
|
|
## |
1639
|
|
|
|
|
|
|
## | $e = XML::LibXML::Element->new('foo:bar'); |
1640
|
|
|
|
|
|
|
## | $e->setAttribute('xmlns:foo','http://yoyodine') |
1641
|
|
|
|
|
|
|
## |
1642
|
|
|
|
|
|
|
} |
1643
|
|
|
|
|
|
|
else { |
1644
|
|
|
|
|
|
|
# just modify the namespace |
1645
|
9
|
100
|
|
|
|
63
|
$self->setNamespaceDeclURI($nsprefix, $value) || |
1646
|
|
|
|
|
|
|
$self->setNamespace($value,$nsprefix,0); |
1647
|
|
|
|
|
|
|
} |
1648
|
|
|
|
|
|
|
} |
1649
|
|
|
|
|
|
|
else { |
1650
|
28
|
|
|
|
|
376
|
$self->_setAttribute($name, $value); |
1651
|
|
|
|
|
|
|
} |
1652
|
|
|
|
|
|
|
} |
1653
|
|
|
|
|
|
|
|
1654
|
|
|
|
|
|
|
sub getAttributeNS { |
1655
|
23
|
|
|
23
|
|
62
|
my $self = shift; |
1656
|
23
|
|
|
|
|
58
|
my ($nsURI, $name) = @_; |
1657
|
23
|
50
|
33
|
|
|
146
|
croak("invalid attribute name") if !defined($name) or $name eq q{}; |
1658
|
23
|
100
|
100
|
|
|
106
|
if ( defined($nsURI) and $nsURI eq XML_XMLNS_NS ) { |
1659
|
1
|
50
|
|
|
|
11
|
$self->_getNamespaceDeclURI($name eq 'xmlns' ? undef : $name); |
1660
|
|
|
|
|
|
|
} |
1661
|
|
|
|
|
|
|
else { |
1662
|
22
|
|
|
|
|
210
|
$self->_getAttributeNS(@_); |
1663
|
|
|
|
|
|
|
} |
1664
|
|
|
|
|
|
|
} |
1665
|
|
|
|
|
|
|
|
1666
|
|
|
|
|
|
|
sub setAttributeNS { |
1667
|
50
|
|
|
50
|
|
6813
|
my ($self, $nsURI, $qname, $value)=@_; |
1668
|
50
|
50
|
33
|
|
|
250
|
unless (defined $qname and length $qname) { |
1669
|
0
|
|
|
|
|
0
|
croak("bad name"); |
1670
|
|
|
|
|
|
|
} |
1671
|
50
|
100
|
100
|
|
|
198
|
if (defined($nsURI) and $nsURI eq XML_XMLNS_NS) { |
1672
|
1
|
50
|
|
|
|
6
|
if ($qname !~ /^xmlns(?::|$)/) { |
1673
|
0
|
|
|
|
|
0
|
croak("NAMESPACE ERROR: Namespace declarations must have the prefix 'xmlns'"); |
1674
|
|
|
|
|
|
|
} |
1675
|
1
|
|
|
|
|
4
|
$self->setAttribute($qname,$value); # see implementation above |
1676
|
1
|
|
|
|
|
3
|
return; |
1677
|
|
|
|
|
|
|
} |
1678
|
49
|
100
|
66
|
|
|
305
|
if ($qname=~/:/ and not (defined($nsURI) and length($nsURI))) { |
|
|
|
100
|
|
|
|
|
1679
|
1
|
|
|
|
|
179
|
croak("NAMESPACE ERROR: Attribute without a prefix cannot be in a namespace"); |
1680
|
|
|
|
|
|
|
} |
1681
|
48
|
50
|
|
|
|
104
|
if ($qname=~/^xmlns(?:$|:)/) { |
1682
|
0
|
|
|
|
|
0
|
croak("NAMESPACE ERROR: 'xmlns' prefix and qualified-name are reserved for the namespace ".XML_XMLNS_NS); |
1683
|
|
|
|
|
|
|
} |
1684
|
48
|
50
|
33
|
|
|
121
|
if ($qname=~/^xml:/ and not (defined $nsURI and $nsURI eq XML_XML_NS)) { |
|
|
|
66
|
|
|
|
|
1685
|
0
|
|
|
|
|
0
|
croak("NAMESPACE ERROR: 'xml' prefix is reserved for the namespace ".XML_XML_NS); |
1686
|
|
|
|
|
|
|
} |
1687
|
48
|
100
|
|
|
|
529
|
$self->_setAttributeNS( defined $nsURI ? $nsURI : undef, $qname, $value ); |
1688
|
|
|
|
|
|
|
} |
1689
|
|
|
|
|
|
|
|
1690
|
|
|
|
|
|
|
sub getElementsByTagName { |
1691
|
12
|
|
|
12
|
|
1730
|
my ( $node , $name ) = @_; |
1692
|
12
|
100
|
|
|
|
45
|
my $xpath = $name eq '*' ? "descendant::*" : "descendant::*[name()='$name']"; |
1693
|
12
|
|
|
|
|
582
|
my @nodes = $node->_findnodes($xpath); |
1694
|
12
|
50
|
|
|
|
64
|
return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1); |
1695
|
|
|
|
|
|
|
} |
1696
|
|
|
|
|
|
|
|
1697
|
|
|
|
|
|
|
sub getElementsByTagNameNS { |
1698
|
13
|
|
|
13
|
|
193
|
my ( $node, $nsURI, $name ) = @_; |
1699
|
13
|
|
|
|
|
19
|
my $xpath; |
1700
|
13
|
100
|
|
|
|
36
|
if ( $name eq '*' ) { |
|
|
100
|
|
|
|
|
|
1701
|
6
|
100
|
|
|
|
16
|
if ( $nsURI eq '*' ) { |
1702
|
3
|
|
|
|
|
7
|
$xpath = "descendant::*"; |
1703
|
|
|
|
|
|
|
} else { |
1704
|
3
|
|
|
|
|
9
|
$xpath = "descendant::*[namespace-uri()='$nsURI']"; |
1705
|
|
|
|
|
|
|
} |
1706
|
|
|
|
|
|
|
} elsif ( $nsURI eq '*' ) { |
1707
|
5
|
|
|
|
|
13
|
$xpath = "descendant::*[local-name()='$name']"; |
1708
|
|
|
|
|
|
|
} else { |
1709
|
2
|
|
|
|
|
6
|
$xpath = "descendant::*[local-name()='$name' and namespace-uri()='$nsURI']"; |
1710
|
|
|
|
|
|
|
} |
1711
|
13
|
|
|
|
|
529
|
my @nodes = $node->_findnodes($xpath); |
1712
|
13
|
50
|
|
|
|
60
|
return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1); |
1713
|
|
|
|
|
|
|
} |
1714
|
|
|
|
|
|
|
|
1715
|
|
|
|
|
|
|
sub getElementsByLocalName { |
1716
|
4
|
|
|
4
|
|
70
|
my ( $node,$name ) = @_; |
1717
|
4
|
|
|
|
|
6
|
my $xpath; |
1718
|
4
|
100
|
|
|
|
9
|
if ($name eq '*') { |
1719
|
1
|
|
|
|
|
2
|
$xpath = "descendant::*"; |
1720
|
|
|
|
|
|
|
} else { |
1721
|
3
|
|
|
|
|
8
|
$xpath = "descendant::*[local-name()='$name']"; |
1722
|
|
|
|
|
|
|
} |
1723
|
4
|
|
|
|
|
168
|
my @nodes = $node->_findnodes($xpath); |
1724
|
4
|
50
|
|
|
|
23
|
return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1); |
1725
|
|
|
|
|
|
|
} |
1726
|
|
|
|
|
|
|
|
1727
|
|
|
|
|
|
|
sub getChildrenByTagName { |
1728
|
12
|
|
|
12
|
|
1867
|
my ( $node, $name ) = @_; |
1729
|
12
|
|
|
|
|
16
|
my @nodes; |
1730
|
12
|
100
|
|
|
|
30
|
if ($name eq '*') { |
1731
|
3
|
|
|
|
|
10
|
@nodes = grep { $_->nodeType == XML_ELEMENT_NODE() } |
|
9
|
|
|
|
|
32
|
|
1732
|
|
|
|
|
|
|
$node->childNodes(); |
1733
|
|
|
|
|
|
|
} else { |
1734
|
9
|
|
|
|
|
26
|
@nodes = grep { $_->nodeName eq $name } $node->childNodes(); |
|
27
|
|
|
|
|
110
|
|
1735
|
|
|
|
|
|
|
} |
1736
|
12
|
50
|
|
|
|
74
|
return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1); |
1737
|
|
|
|
|
|
|
} |
1738
|
|
|
|
|
|
|
|
1739
|
|
|
|
|
|
|
sub getChildrenByLocalName { |
1740
|
3
|
|
|
3
|
|
62
|
my ( $node, $name ) = @_; |
1741
|
|
|
|
|
|
|
# my @nodes; |
1742
|
|
|
|
|
|
|
# if ($name eq '*') { |
1743
|
|
|
|
|
|
|
# @nodes = grep { $_->nodeType == XML_ELEMENT_NODE() } |
1744
|
|
|
|
|
|
|
# $node->childNodes(); |
1745
|
|
|
|
|
|
|
# } else { |
1746
|
|
|
|
|
|
|
# @nodes = grep { $_->nodeType == XML_ELEMENT_NODE() and |
1747
|
|
|
|
|
|
|
# $_->localName eq $name } $node->childNodes(); |
1748
|
|
|
|
|
|
|
# } |
1749
|
|
|
|
|
|
|
# return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1); |
1750
|
3
|
|
|
|
|
24
|
my @nodes = $node->_getChildrenByTagNameNS('*',$name); |
1751
|
3
|
50
|
|
|
|
15
|
return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1); |
1752
|
|
|
|
|
|
|
} |
1753
|
|
|
|
|
|
|
|
1754
|
|
|
|
|
|
|
sub getChildrenByTagNameNS { |
1755
|
9
|
|
|
9
|
|
130
|
my ( $node, $nsURI, $name ) = @_; |
1756
|
9
|
|
|
|
|
71
|
my @nodes = $node->_getChildrenByTagNameNS($nsURI,$name); |
1757
|
9
|
50
|
|
|
|
29
|
return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1); |
1758
|
|
|
|
|
|
|
} |
1759
|
|
|
|
|
|
|
|
1760
|
|
|
|
|
|
|
sub appendWellBalancedChunk { |
1761
|
1
|
|
|
1
|
|
827
|
my ( $self, $chunk ) = @_; |
1762
|
|
|
|
|
|
|
|
1763
|
1
|
|
|
|
|
3
|
my $local_parser = XML::LibXML->new(); |
1764
|
1
|
|
|
|
|
4
|
my $frag = $local_parser->parse_xml_chunk( $chunk ); |
1765
|
|
|
|
|
|
|
|
1766
|
1
|
|
|
|
|
21
|
$self->appendChild( $frag ); |
1767
|
|
|
|
|
|
|
} |
1768
|
|
|
|
|
|
|
|
1769
|
|
|
|
|
|
|
1; |
1770
|
|
|
|
|
|
|
|
1771
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1772
|
|
|
|
|
|
|
# XML::LibXML::Text Interface # |
1773
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1774
|
|
|
|
|
|
|
package XML::LibXML::Text; |
1775
|
|
|
|
|
|
|
|
1776
|
67
|
|
|
67
|
|
98567
|
use vars qw(@ISA); |
|
67
|
|
|
|
|
161
|
|
|
67
|
|
|
|
|
18517
|
|
1777
|
|
|
|
|
|
|
@ISA = ('XML::LibXML::Node'); |
1778
|
|
|
|
|
|
|
|
1779
|
1
|
|
|
1
|
|
2061
|
sub attributes { return; } |
1780
|
|
|
|
|
|
|
|
1781
|
|
|
|
|
|
|
sub deleteDataString { |
1782
|
5
|
|
|
5
|
|
3214
|
my ($node, $string, $all) = @_; |
1783
|
|
|
|
|
|
|
|
1784
|
5
|
|
|
|
|
14
|
return $node->replaceDataString($string, '', $all); |
1785
|
|
|
|
|
|
|
} |
1786
|
|
|
|
|
|
|
|
1787
|
|
|
|
|
|
|
sub replaceDataString { |
1788
|
9
|
|
|
9
|
|
20577
|
my ( $node, $left_proto, $right,$all ) = @_; |
1789
|
|
|
|
|
|
|
|
1790
|
|
|
|
|
|
|
# Assure we exchange the strings and not expressions! |
1791
|
9
|
|
|
|
|
17
|
my $left = quotemeta($left_proto); |
1792
|
|
|
|
|
|
|
|
1793
|
9
|
|
|
|
|
35
|
my $datastr = $node->nodeValue(); |
1794
|
9
|
100
|
|
|
|
23
|
if ( $all ) { |
1795
|
3
|
|
|
|
|
45
|
$datastr =~ s/$left/$right/g; |
1796
|
|
|
|
|
|
|
} |
1797
|
|
|
|
|
|
|
else{ |
1798
|
6
|
|
|
|
|
111
|
$datastr =~ s/$left/$right/; |
1799
|
|
|
|
|
|
|
} |
1800
|
9
|
|
|
|
|
47
|
$node->setData( $datastr ); |
1801
|
|
|
|
|
|
|
} |
1802
|
|
|
|
|
|
|
|
1803
|
|
|
|
|
|
|
sub replaceDataRegEx { |
1804
|
6
|
|
|
6
|
|
3773
|
my ( $node, $leftre, $rightre, $flags ) = @_; |
1805
|
6
|
50
|
|
|
|
19
|
return unless defined $leftre; |
1806
|
6
|
|
50
|
|
|
13
|
$rightre ||= ""; |
1807
|
|
|
|
|
|
|
|
1808
|
6
|
|
|
|
|
30
|
my $datastr = $node->nodeValue(); |
1809
|
6
|
|
|
|
|
16
|
my $restr = "s/" . $leftre . "/" . $rightre . "/"; |
1810
|
6
|
100
|
|
|
|
15
|
$restr .= $flags if defined $flags; |
1811
|
|
|
|
|
|
|
|
1812
|
6
|
|
|
|
|
378
|
eval '$datastr =~ '. $restr; |
1813
|
|
|
|
|
|
|
|
1814
|
6
|
|
|
|
|
44
|
$node->setData( $datastr ); |
1815
|
|
|
|
|
|
|
} |
1816
|
|
|
|
|
|
|
|
1817
|
|
|
|
|
|
|
1; |
1818
|
|
|
|
|
|
|
|
1819
|
|
|
|
|
|
|
package XML::LibXML::Comment; |
1820
|
|
|
|
|
|
|
|
1821
|
67
|
|
|
67
|
|
507
|
use vars qw(@ISA); |
|
67
|
|
|
|
|
155
|
|
|
67
|
|
|
|
|
3809
|
|
1822
|
|
|
|
|
|
|
@ISA = ('XML::LibXML::Text'); |
1823
|
|
|
|
|
|
|
|
1824
|
|
|
|
|
|
|
1; |
1825
|
|
|
|
|
|
|
|
1826
|
|
|
|
|
|
|
package XML::LibXML::CDATASection; |
1827
|
|
|
|
|
|
|
|
1828
|
67
|
|
|
67
|
|
418
|
use vars qw(@ISA); |
|
67
|
|
|
|
|
175
|
|
|
67
|
|
|
|
|
3474
|
|
1829
|
|
|
|
|
|
|
@ISA = ('XML::LibXML::Text'); |
1830
|
|
|
|
|
|
|
|
1831
|
|
|
|
|
|
|
1; |
1832
|
|
|
|
|
|
|
|
1833
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1834
|
|
|
|
|
|
|
# XML::LibXML::Attribute Interface # |
1835
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1836
|
|
|
|
|
|
|
package XML::LibXML::Attr; |
1837
|
67
|
|
|
67
|
|
387
|
use vars qw( @ISA ) ; |
|
67
|
|
|
|
|
130
|
|
|
67
|
|
|
|
|
7410
|
|
1838
|
|
|
|
|
|
|
@ISA = ('XML::LibXML::Node') ; |
1839
|
|
|
|
|
|
|
|
1840
|
|
|
|
|
|
|
sub setNamespace { |
1841
|
2
|
|
|
2
|
|
9
|
my ($self,$href,$prefix) = @_; |
1842
|
2
|
|
|
|
|
14
|
my $n = $self->localname; |
1843
|
2
|
50
|
|
|
|
43
|
if ( $self->_setNamespace($href,$prefix) ) { |
1844
|
2
|
|
|
|
|
13
|
$self->setNodeName($n); |
1845
|
2
|
|
|
|
|
10
|
return 1; |
1846
|
|
|
|
|
|
|
} |
1847
|
|
|
|
|
|
|
|
1848
|
0
|
|
|
|
|
0
|
return 0; |
1849
|
|
|
|
|
|
|
} |
1850
|
|
|
|
|
|
|
|
1851
|
|
|
|
|
|
|
1; |
1852
|
|
|
|
|
|
|
|
1853
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1854
|
|
|
|
|
|
|
# XML::LibXML::Dtd Interface # |
1855
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1856
|
|
|
|
|
|
|
# this is still under construction |
1857
|
|
|
|
|
|
|
# |
1858
|
|
|
|
|
|
|
package XML::LibXML::Dtd; |
1859
|
67
|
|
|
67
|
|
472
|
use vars qw( @ISA ); |
|
67
|
|
|
|
|
153
|
|
|
67
|
|
|
|
|
3806
|
|
1860
|
|
|
|
|
|
|
@ISA = ('XML::LibXML::Node'); |
1861
|
|
|
|
|
|
|
|
1862
|
|
|
|
|
|
|
# at least DESTROY and CLONE_SKIP must be inherited |
1863
|
|
|
|
|
|
|
|
1864
|
|
|
|
|
|
|
1; |
1865
|
|
|
|
|
|
|
|
1866
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1867
|
|
|
|
|
|
|
# XML::LibXML::PI Interface # |
1868
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1869
|
|
|
|
|
|
|
package XML::LibXML::PI; |
1870
|
67
|
|
|
67
|
|
422
|
use vars qw( @ISA ); |
|
67
|
|
|
|
|
146
|
|
|
67
|
|
|
|
|
27043
|
|
1871
|
|
|
|
|
|
|
@ISA = ('XML::LibXML::Node'); |
1872
|
|
|
|
|
|
|
|
1873
|
|
|
|
|
|
|
sub setData { |
1874
|
3
|
|
|
3
|
|
2489
|
my $pi = shift; |
1875
|
|
|
|
|
|
|
|
1876
|
3
|
|
|
|
|
6
|
my $string = ""; |
1877
|
3
|
100
|
|
|
|
11
|
if ( scalar @_ == 1 ) { |
1878
|
2
|
|
|
|
|
6
|
$string = shift; |
1879
|
|
|
|
|
|
|
} |
1880
|
|
|
|
|
|
|
else { |
1881
|
1
|
|
|
|
|
3
|
my %h = @_; |
1882
|
1
|
|
|
|
|
5
|
$string = join " ", map {$_.'="'.$h{$_}.'"'} keys %h; |
|
1
|
|
|
|
|
6
|
|
1883
|
|
|
|
|
|
|
} |
1884
|
|
|
|
|
|
|
|
1885
|
|
|
|
|
|
|
# the spec says any char but "?>" [17] |
1886
|
3
|
50
|
|
|
|
28
|
$pi->_setData( $string ) unless $string =~ /\?>/; |
1887
|
|
|
|
|
|
|
} |
1888
|
|
|
|
|
|
|
|
1889
|
|
|
|
|
|
|
1; |
1890
|
|
|
|
|
|
|
|
1891
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1892
|
|
|
|
|
|
|
# XML::LibXML::Namespace Interface # |
1893
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1894
|
|
|
|
|
|
|
package XML::LibXML::Namespace; |
1895
|
|
|
|
|
|
|
|
1896
|
0
|
|
|
0
|
|
0
|
sub CLONE_SKIP { 1 } |
1897
|
|
|
|
|
|
|
|
1898
|
|
|
|
|
|
|
# In fact, this is not a node! |
1899
|
0
|
|
|
0
|
|
0
|
sub prefix { return "xmlns"; } |
1900
|
0
|
|
|
0
|
|
0
|
sub getPrefix { return "xmlns"; } |
1901
|
0
|
|
|
0
|
|
0
|
sub getNamespaceURI { return "http://www.w3.org/2000/xmlns/" }; |
1902
|
|
|
|
|
|
|
|
1903
|
0
|
|
|
0
|
|
0
|
sub getNamespaces { return (); } |
1904
|
|
|
|
|
|
|
|
1905
|
|
|
|
|
|
|
sub nodeName { |
1906
|
4
|
|
|
4
|
|
7
|
my $self = shift; |
1907
|
4
|
|
|
|
|
9
|
my $nsP = $self->localname; |
1908
|
4
|
100
|
66
|
|
|
20
|
return ( defined($nsP) && length($nsP) ) ? "xmlns:$nsP" : "xmlns"; |
1909
|
|
|
|
|
|
|
} |
1910
|
4
|
|
|
4
|
|
9
|
sub name { goto &nodeName } |
1911
|
0
|
|
|
0
|
|
0
|
sub getName { goto &nodeName } |
1912
|
|
|
|
|
|
|
|
1913
|
|
|
|
|
|
|
sub isEqualNode { |
1914
|
0
|
|
|
0
|
|
0
|
my ( $self, $ref ) = @_; |
1915
|
0
|
0
|
|
|
|
0
|
if ( ref($ref) eq "XML::LibXML::Namespace" ) { |
1916
|
0
|
|
|
|
|
0
|
return $self->_isEqual($ref); |
1917
|
|
|
|
|
|
|
} |
1918
|
0
|
|
|
|
|
0
|
return 0; |
1919
|
|
|
|
|
|
|
} |
1920
|
|
|
|
|
|
|
|
1921
|
|
|
|
|
|
|
sub isSameNode { |
1922
|
0
|
|
|
0
|
|
0
|
my ( $self, $ref ) = @_; |
1923
|
0
|
0
|
|
|
|
0
|
if ( $$self == $$ref ){ |
1924
|
0
|
|
|
|
|
0
|
return 1; |
1925
|
|
|
|
|
|
|
} |
1926
|
0
|
|
|
|
|
0
|
return 0; |
1927
|
|
|
|
|
|
|
} |
1928
|
|
|
|
|
|
|
|
1929
|
|
|
|
|
|
|
1; |
1930
|
|
|
|
|
|
|
|
1931
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1932
|
|
|
|
|
|
|
# XML::LibXML::NamedNodeMap Interface # |
1933
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
1934
|
|
|
|
|
|
|
package XML::LibXML::NamedNodeMap; |
1935
|
|
|
|
|
|
|
|
1936
|
67
|
|
|
67
|
|
514
|
use XML::LibXML qw(:libxml); |
|
67
|
|
|
|
|
179
|
|
|
67
|
|
|
|
|
418
|
|
1937
|
|
|
|
|
|
|
|
1938
|
|
|
|
|
|
|
sub CLONE_SKIP { |
1939
|
0
|
0
|
|
0
|
|
0
|
return $XML::LibXML::__threads_shared ? 0 : 1; |
1940
|
|
|
|
|
|
|
} |
1941
|
|
|
|
|
|
|
|
1942
|
|
|
|
|
|
|
sub new { |
1943
|
2
|
|
|
2
|
|
5
|
my $class = shift; |
1944
|
2
|
|
|
|
|
7
|
my $self = bless { Nodes => [@_] }, $class; |
1945
|
2
|
|
|
|
|
5
|
$self->{NodeMap} = { map { $_->nodeName => $_ } @_ }; |
|
2
|
|
|
|
|
32
|
|
1946
|
2
|
|
|
|
|
8
|
return $self; |
1947
|
|
|
|
|
|
|
} |
1948
|
|
|
|
|
|
|
|
1949
|
2
|
|
|
2
|
|
1942
|
sub length { return scalar( @{$_[0]->{Nodes}} ); } |
|
2
|
|
|
|
|
9
|
|
1950
|
0
|
|
|
0
|
|
0
|
sub nodes { return $_[0]->{Nodes}; } |
1951
|
0
|
|
|
0
|
|
0
|
sub item { $_[0]->{Nodes}->[$_[1]]; } |
1952
|
|
|
|
|
|
|
|
1953
|
|
|
|
|
|
|
sub getNamedItem { |
1954
|
1
|
|
|
1
|
|
4
|
my $self = shift; |
1955
|
1
|
|
|
|
|
2
|
my $name = shift; |
1956
|
|
|
|
|
|
|
|
1957
|
1
|
|
|
|
|
2
|
return $self->{NodeMap}->{$name}; |
1958
|
|
|
|
|
|
|
} |
1959
|
|
|
|
|
|
|
|
1960
|
|
|
|
|
|
|
sub setNamedItem { |
1961
|
3
|
|
|
3
|
|
2292
|
my $self = shift; |
1962
|
3
|
|
|
|
|
7
|
my $node = shift; |
1963
|
|
|
|
|
|
|
|
1964
|
3
|
|
|
|
|
3
|
my $retval; |
1965
|
3
|
50
|
|
|
|
8
|
if ( defined $node ) { |
1966
|
3
|
50
|
|
|
|
4
|
if ( scalar @{$self->{Nodes}} ) { |
|
3
|
|
|
|
|
8
|
|
1967
|
3
|
|
|
|
|
13
|
my $name = $node->nodeName(); |
1968
|
3
|
50
|
|
|
|
11
|
if ( $node->nodeType() == XML_NAMESPACE_DECL ) { |
1969
|
0
|
|
|
|
|
0
|
return; |
1970
|
|
|
|
|
|
|
} |
1971
|
3
|
100
|
|
|
|
10
|
if ( defined $self->{NodeMap}->{$name} ) { |
1972
|
1
|
50
|
|
|
|
13
|
if ( $node->isSameNode( $self->{NodeMap}->{$name} ) ) { |
1973
|
0
|
|
|
|
|
0
|
return; |
1974
|
|
|
|
|
|
|
} |
1975
|
1
|
|
|
|
|
8
|
$retval = $self->{NodeMap}->{$name}->replaceNode( $node ); |
1976
|
|
|
|
|
|
|
} |
1977
|
|
|
|
|
|
|
else { |
1978
|
2
|
|
|
|
|
13
|
$self->{Nodes}->[0]->addSibling($node); |
1979
|
|
|
|
|
|
|
} |
1980
|
|
|
|
|
|
|
|
1981
|
3
|
|
|
|
|
10
|
$self->{NodeMap}->{$name} = $node; |
1982
|
3
|
|
|
|
|
4
|
push @{$self->{Nodes}}, $node; |
|
3
|
|
|
|
|
8
|
|
1983
|
|
|
|
|
|
|
} |
1984
|
|
|
|
|
|
|
else { |
1985
|
|
|
|
|
|
|
# not done yet |
1986
|
|
|
|
|
|
|
# can this be properly be done??? |
1987
|
0
|
|
|
|
|
0
|
warn "not done yet\n"; |
1988
|
|
|
|
|
|
|
} |
1989
|
|
|
|
|
|
|
} |
1990
|
3
|
|
|
|
|
6
|
return $retval; |
1991
|
|
|
|
|
|
|
} |
1992
|
|
|
|
|
|
|
|
1993
|
|
|
|
|
|
|
sub removeNamedItem { |
1994
|
1
|
|
|
1
|
|
1328
|
my $self = shift; |
1995
|
1
|
|
|
|
|
2
|
my $name = shift; |
1996
|
1
|
|
|
|
|
2
|
my $retval; |
1997
|
1
|
50
|
|
|
|
7
|
if ( $name =~ /^xmlns/ ) { |
|
|
50
|
|
|
|
|
|
1998
|
0
|
|
|
|
|
0
|
warn "not done yet\n"; |
1999
|
|
|
|
|
|
|
} |
2000
|
|
|
|
|
|
|
elsif ( exists $self->{NodeMap}->{$name} ) { |
2001
|
1
|
|
|
|
|
2
|
$retval = $self->{NodeMap}->{$name}; |
2002
|
1
|
|
|
|
|
8
|
$retval->unbindNode; |
2003
|
1
|
|
|
|
|
2
|
delete $self->{NodeMap}->{$name}; |
2004
|
1
|
|
|
|
|
2
|
$self->{Nodes} = [grep {not($retval->isSameNode($_))} @{$self->{Nodes}}]; |
|
4
|
|
|
|
|
11
|
|
|
1
|
|
|
|
|
3
|
|
2005
|
|
|
|
|
|
|
} |
2006
|
|
|
|
|
|
|
|
2007
|
1
|
|
|
|
|
4
|
return $retval; |
2008
|
|
|
|
|
|
|
} |
2009
|
|
|
|
|
|
|
|
2010
|
|
|
|
|
|
|
sub getNamedItemNS { |
2011
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
2012
|
0
|
|
|
|
|
0
|
my $nsURI = shift; |
2013
|
0
|
|
|
|
|
0
|
my $name = shift; |
2014
|
0
|
|
|
|
|
0
|
return undef; |
2015
|
|
|
|
|
|
|
} |
2016
|
|
|
|
|
|
|
|
2017
|
|
|
|
|
|
|
sub setNamedItemNS { |
2018
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
2019
|
0
|
|
|
|
|
0
|
my $nsURI = shift; |
2020
|
0
|
|
|
|
|
0
|
my $node = shift; |
2021
|
0
|
|
|
|
|
0
|
return undef; |
2022
|
|
|
|
|
|
|
} |
2023
|
|
|
|
|
|
|
|
2024
|
|
|
|
|
|
|
sub removeNamedItemNS { |
2025
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
2026
|
0
|
|
|
|
|
0
|
my $nsURI = shift; |
2027
|
0
|
|
|
|
|
0
|
my $name = shift; |
2028
|
0
|
|
|
|
|
0
|
return undef; |
2029
|
|
|
|
|
|
|
} |
2030
|
|
|
|
|
|
|
|
2031
|
|
|
|
|
|
|
1; |
2032
|
|
|
|
|
|
|
|
2033
|
|
|
|
|
|
|
package XML::LibXML::_SAXParser; |
2034
|
|
|
|
|
|
|
|
2035
|
|
|
|
|
|
|
# this is pseudo class!!! and it will be removed as soon all functions |
2036
|
|
|
|
|
|
|
# moved to XS level |
2037
|
|
|
|
|
|
|
|
2038
|
67
|
|
|
67
|
|
31735
|
use XML::SAX::Exception; |
|
67
|
|
|
|
|
44291
|
|
|
67
|
|
|
|
|
43364
|
|
2039
|
|
|
|
|
|
|
|
2040
|
|
|
|
|
|
|
sub CLONE_SKIP { |
2041
|
0
|
0
|
|
0
|
|
0
|
return $XML::LibXML::__threads_shared ? 0 : 1; |
2042
|
|
|
|
|
|
|
} |
2043
|
|
|
|
|
|
|
|
2044
|
|
|
|
|
|
|
# these functions will use SAX exceptions as soon i know how things really work |
2045
|
|
|
|
|
|
|
sub warning { |
2046
|
0
|
|
|
0
|
|
0
|
my ( $parser, $message, $line, $col ) = @_; |
2047
|
0
|
|
|
|
|
0
|
my $error = XML::SAX::Exception::Parse->new( LineNumber => $line, |
2048
|
|
|
|
|
|
|
ColumnNumber => $col, |
2049
|
|
|
|
|
|
|
Message => $message, ); |
2050
|
0
|
|
|
|
|
0
|
$parser->{HANDLER}->warning( $error ); |
2051
|
|
|
|
|
|
|
} |
2052
|
|
|
|
|
|
|
|
2053
|
|
|
|
|
|
|
sub error { |
2054
|
0
|
|
|
0
|
|
0
|
my ( $parser, $message, $line, $col ) = @_; |
2055
|
|
|
|
|
|
|
|
2056
|
0
|
|
|
|
|
0
|
my $error = XML::SAX::Exception::Parse->new( LineNumber => $line, |
2057
|
|
|
|
|
|
|
ColumnNumber => $col, |
2058
|
|
|
|
|
|
|
Message => $message, ); |
2059
|
0
|
|
|
|
|
0
|
$parser->{HANDLER}->error( $error ); |
2060
|
|
|
|
|
|
|
} |
2061
|
|
|
|
|
|
|
|
2062
|
|
|
|
|
|
|
sub fatal_error { |
2063
|
1
|
|
|
1
|
|
34
|
my ( $parser, $message, $line, $col ) = @_; |
2064
|
1
|
|
|
|
|
9
|
my $error = XML::SAX::Exception::Parse->new( LineNumber => $line, |
2065
|
|
|
|
|
|
|
ColumnNumber => $col, |
2066
|
|
|
|
|
|
|
Message => $message, ); |
2067
|
1
|
|
|
|
|
18
|
$parser->{HANDLER}->fatal_error( $error ); |
2068
|
|
|
|
|
|
|
} |
2069
|
|
|
|
|
|
|
|
2070
|
|
|
|
|
|
|
1; |
2071
|
|
|
|
|
|
|
|
2072
|
|
|
|
|
|
|
package XML::LibXML::RelaxNG; |
2073
|
|
|
|
|
|
|
|
2074
|
0
|
|
|
0
|
|
0
|
sub CLONE_SKIP { 1 } |
2075
|
|
|
|
|
|
|
|
2076
|
|
|
|
|
|
|
sub new { |
2077
|
11
|
|
|
11
|
|
3292
|
my $class = shift; |
2078
|
11
|
|
|
|
|
36
|
my %args = @_; |
2079
|
|
|
|
|
|
|
|
2080
|
11
|
|
|
|
|
16
|
my $self = undef; |
2081
|
11
|
100
|
|
|
|
38
|
if ( defined $args{location} ) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2082
|
6
|
|
|
|
|
25
|
$self = $class->parse_location( $args{location}, XML::LibXML->_parser_options(\%args), $args{recover} ); |
2083
|
|
|
|
|
|
|
} |
2084
|
|
|
|
|
|
|
elsif ( defined $args{string} ) { |
2085
|
3
|
|
|
|
|
13
|
$self = $class->parse_buffer( $args{string}, XML::LibXML->_parser_options(\%args), $args{recover} ); |
2086
|
|
|
|
|
|
|
} |
2087
|
|
|
|
|
|
|
elsif ( defined $args{DOM} ) { |
2088
|
2
|
|
|
|
|
7
|
$self = $class->parse_document( $args{DOM}, XML::LibXML->_parser_options(\%args), $args{recover} ); |
2089
|
|
|
|
|
|
|
} |
2090
|
|
|
|
|
|
|
|
2091
|
6
|
|
|
|
|
41
|
return $self; |
2092
|
|
|
|
|
|
|
} |
2093
|
|
|
|
|
|
|
|
2094
|
|
|
|
|
|
|
1; |
2095
|
|
|
|
|
|
|
|
2096
|
|
|
|
|
|
|
package XML::LibXML::Schema; |
2097
|
|
|
|
|
|
|
|
2098
|
0
|
|
|
0
|
|
0
|
sub CLONE_SKIP { 1 } |
2099
|
|
|
|
|
|
|
|
2100
|
|
|
|
|
|
|
sub new { |
2101
|
9
|
|
|
9
|
|
2293
|
my $class = shift; |
2102
|
9
|
|
|
|
|
27
|
my %args = @_; |
2103
|
|
|
|
|
|
|
|
2104
|
9
|
|
|
|
|
15
|
my $self = undef; |
2105
|
9
|
100
|
|
|
|
28
|
if ( defined $args{location} ) { |
|
|
50
|
|
|
|
|
|
2106
|
5
|
|
|
|
|
14
|
$self = $class->parse_location( $args{location}, XML::LibXML->_parser_options(\%args), $args{recover} ); |
2107
|
|
|
|
|
|
|
} |
2108
|
|
|
|
|
|
|
elsif ( defined $args{string} ) { |
2109
|
4
|
|
|
|
|
13
|
$self = $class->parse_buffer( $args{string}, XML::LibXML->_parser_options(\%args), $args{recover} ); |
2110
|
|
|
|
|
|
|
} |
2111
|
|
|
|
|
|
|
|
2112
|
5
|
|
|
|
|
33
|
return $self; |
2113
|
|
|
|
|
|
|
} |
2114
|
|
|
|
|
|
|
|
2115
|
|
|
|
|
|
|
1; |
2116
|
|
|
|
|
|
|
|
2117
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
2118
|
|
|
|
|
|
|
# XML::LibXML::Pattern Interface # |
2119
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
2120
|
|
|
|
|
|
|
|
2121
|
|
|
|
|
|
|
package XML::LibXML::Pattern; |
2122
|
|
|
|
|
|
|
|
2123
|
0
|
|
|
0
|
|
0
|
sub CLONE_SKIP { 1 } |
2124
|
|
|
|
|
|
|
|
2125
|
|
|
|
|
|
|
sub new { |
2126
|
1
|
|
|
1
|
|
36
|
my $class = shift; |
2127
|
1
|
|
|
|
|
4
|
my ($pattern,$ns_map)=@_; |
2128
|
1
|
|
|
|
|
2
|
my $self = undef; |
2129
|
|
|
|
|
|
|
|
2130
|
1
|
50
|
|
|
|
7
|
unless (UNIVERSAL::can($class,'_compilePattern')) { |
2131
|
0
|
|
|
|
|
0
|
croak("Cannot create XML::LibXML::Pattern - ". |
2132
|
|
|
|
|
|
|
"your libxml2 is compiled without pattern support!"); |
2133
|
|
|
|
|
|
|
} |
2134
|
|
|
|
|
|
|
|
2135
|
1
|
50
|
|
|
|
5
|
if (ref($ns_map) eq 'HASH') { |
2136
|
|
|
|
|
|
|
# translate prefix=>URL hash to a (URL,prefix) list |
2137
|
1
|
|
|
|
|
17
|
$self = $class->_compilePattern($pattern,0,[reverse %$ns_map]); |
2138
|
|
|
|
|
|
|
} else { |
2139
|
0
|
|
|
|
|
0
|
$self = $class->_compilePattern($pattern,0); |
2140
|
|
|
|
|
|
|
} |
2141
|
1
|
|
|
|
|
3
|
return $self; |
2142
|
|
|
|
|
|
|
} |
2143
|
|
|
|
|
|
|
|
2144
|
|
|
|
|
|
|
1; |
2145
|
|
|
|
|
|
|
|
2146
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
2147
|
|
|
|
|
|
|
# XML::LibXML::RegExp Interface # |
2148
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
2149
|
|
|
|
|
|
|
|
2150
|
|
|
|
|
|
|
package XML::LibXML::RegExp; |
2151
|
|
|
|
|
|
|
|
2152
|
0
|
|
|
0
|
|
0
|
sub CLONE_SKIP { 1 } |
2153
|
|
|
|
|
|
|
|
2154
|
|
|
|
|
|
|
sub new { |
2155
|
3
|
|
|
3
|
|
3279
|
my $class = shift; |
2156
|
3
|
|
|
|
|
7
|
my ($regexp)=@_; |
2157
|
3
|
50
|
|
|
|
12
|
unless (UNIVERSAL::can($class,'_compile')) { |
2158
|
0
|
|
|
|
|
0
|
croak("Cannot create XML::LibXML::RegExp - ". |
2159
|
|
|
|
|
|
|
"your libxml2 is compiled without regexp support!"); |
2160
|
|
|
|
|
|
|
} |
2161
|
3
|
|
|
|
|
88
|
return $class->_compile($regexp); |
2162
|
|
|
|
|
|
|
} |
2163
|
|
|
|
|
|
|
|
2164
|
|
|
|
|
|
|
1; |
2165
|
|
|
|
|
|
|
|
2166
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
2167
|
|
|
|
|
|
|
# XML::LibXML::XPathExpression Interface # |
2168
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
2169
|
|
|
|
|
|
|
|
2170
|
|
|
|
|
|
|
package XML::LibXML::XPathExpression; |
2171
|
|
|
|
|
|
|
|
2172
|
0
|
|
|
0
|
|
0
|
sub CLONE_SKIP { 1 } |
2173
|
|
|
|
|
|
|
|
2174
|
|
|
|
|
|
|
1; |
2175
|
|
|
|
|
|
|
|
2176
|
|
|
|
|
|
|
|
2177
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
2178
|
|
|
|
|
|
|
# XML::LibXML::InputCallback Interface # |
2179
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
2180
|
|
|
|
|
|
|
package XML::LibXML::InputCallback; |
2181
|
|
|
|
|
|
|
|
2182
|
67
|
|
|
67
|
|
538
|
use vars qw($_CUR_CB @_GLOBAL_CALLBACKS @_CB_STACK $_CB_NESTED_DEPTH @_CB_NESTED_STACK); |
|
67
|
|
|
|
|
136
|
|
|
67
|
|
|
|
|
6330
|
|
2183
|
|
|
|
|
|
|
|
2184
|
|
|
|
|
|
|
BEGIN { |
2185
|
67
|
|
|
67
|
|
246
|
$_CUR_CB = undef; |
2186
|
67
|
|
|
|
|
155
|
@_GLOBAL_CALLBACKS = (); |
2187
|
67
|
|
|
|
|
342
|
@_CB_STACK = (); |
2188
|
67
|
|
|
|
|
119
|
$_CB_NESTED_DEPTH = 0; |
2189
|
67
|
|
|
|
|
51352
|
@_CB_NESTED_STACK = (); |
2190
|
|
|
|
|
|
|
} |
2191
|
|
|
|
|
|
|
|
2192
|
|
|
|
|
|
|
sub CLONE_SKIP { |
2193
|
0
|
0
|
|
0
|
|
0
|
return $XML::LibXML::__threads_shared ? 0 : 1; |
2194
|
|
|
|
|
|
|
} |
2195
|
|
|
|
|
|
|
|
2196
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
2197
|
|
|
|
|
|
|
# global callbacks # |
2198
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
2199
|
|
|
|
|
|
|
sub _callback_match { |
2200
|
116
|
|
|
116
|
|
370
|
my $uri = shift; |
2201
|
116
|
|
|
|
|
172
|
my $retval = 0; |
2202
|
|
|
|
|
|
|
|
2203
|
|
|
|
|
|
|
# loop through the callbacks, and find the first matching one. |
2204
|
|
|
|
|
|
|
# The callbacks are stored in execution order (reverse stack order). |
2205
|
|
|
|
|
|
|
# Any new global callbacks are shifted to the callback stack. |
2206
|
116
|
|
|
|
|
249
|
foreach my $cb ( @_GLOBAL_CALLBACKS ) { |
2207
|
|
|
|
|
|
|
|
2208
|
|
|
|
|
|
|
# callbacks have to return 1, 0 or undef, while 0 and undef |
2209
|
|
|
|
|
|
|
# are handled the same way. |
2210
|
|
|
|
|
|
|
# in fact, if callbacks return other values, the global match |
2211
|
|
|
|
|
|
|
# assumes silently that the callback failed. |
2212
|
|
|
|
|
|
|
|
2213
|
37
|
|
|
|
|
102
|
$retval = $cb->[0]->($uri); |
2214
|
|
|
|
|
|
|
|
2215
|
37
|
100
|
100
|
|
|
885
|
if ( defined $retval and $retval == 1 ) { |
2216
|
|
|
|
|
|
|
# make the other callbacks use this callback |
2217
|
25
|
|
|
|
|
40
|
$_CUR_CB = $cb; |
2218
|
25
|
|
|
|
|
44
|
unshift @_CB_STACK, $cb; |
2219
|
25
|
|
|
|
|
38
|
last; |
2220
|
|
|
|
|
|
|
} |
2221
|
|
|
|
|
|
|
} |
2222
|
|
|
|
|
|
|
|
2223
|
116
|
|
|
|
|
10264
|
return $retval; |
2224
|
|
|
|
|
|
|
} |
2225
|
|
|
|
|
|
|
|
2226
|
|
|
|
|
|
|
sub _callback_open { |
2227
|
25
|
|
|
25
|
|
44
|
my $uri = shift; |
2228
|
25
|
|
|
|
|
34
|
my $retval = undef; |
2229
|
|
|
|
|
|
|
|
2230
|
|
|
|
|
|
|
# the open callback has to return a defined value. |
2231
|
|
|
|
|
|
|
# if one works on files this can be a file handle. But |
2232
|
|
|
|
|
|
|
# depending on the needs of the callback it also can be a |
2233
|
|
|
|
|
|
|
# database handle or a integer labeling a certain dataset. |
2234
|
|
|
|
|
|
|
|
2235
|
25
|
50
|
|
|
|
45
|
if ( defined $_CUR_CB ) { |
2236
|
25
|
|
|
|
|
62
|
$retval = $_CUR_CB->[1]->( $uri ); |
2237
|
|
|
|
|
|
|
|
2238
|
|
|
|
|
|
|
# reset the callbacks, if one callback cannot open an uri |
2239
|
25
|
50
|
33
|
|
|
1586
|
if ( not defined $retval or $retval == 0 ) { |
2240
|
0
|
|
|
|
|
0
|
shift @_CB_STACK; |
2241
|
0
|
|
|
|
|
0
|
$_CUR_CB = $_CB_STACK[0]; |
2242
|
|
|
|
|
|
|
} |
2243
|
|
|
|
|
|
|
} |
2244
|
|
|
|
|
|
|
|
2245
|
25
|
|
|
|
|
428
|
return $retval; |
2246
|
|
|
|
|
|
|
} |
2247
|
|
|
|
|
|
|
|
2248
|
|
|
|
|
|
|
sub _callback_read { |
2249
|
74
|
|
|
74
|
|
118
|
my $fh = shift; |
2250
|
74
|
|
|
|
|
80
|
my $buflen = shift; |
2251
|
|
|
|
|
|
|
|
2252
|
74
|
|
|
|
|
84
|
my $retval = undef; |
2253
|
|
|
|
|
|
|
|
2254
|
74
|
50
|
|
|
|
172
|
if ( defined $_CUR_CB ) { |
2255
|
74
|
|
|
|
|
161
|
$retval = $_CUR_CB->[2]->( $fh, $buflen ); |
2256
|
|
|
|
|
|
|
} |
2257
|
|
|
|
|
|
|
|
2258
|
74
|
|
|
|
|
2873
|
return $retval; |
2259
|
|
|
|
|
|
|
} |
2260
|
|
|
|
|
|
|
|
2261
|
|
|
|
|
|
|
sub _callback_close { |
2262
|
25
|
|
|
25
|
|
49
|
my $fh = shift; |
2263
|
25
|
|
|
|
|
37
|
my $retval = 0; |
2264
|
|
|
|
|
|
|
|
2265
|
25
|
50
|
|
|
|
53
|
if ( defined $_CUR_CB ) { |
2266
|
25
|
|
|
|
|
65
|
$retval = $_CUR_CB->[3]->( $fh ); |
2267
|
25
|
|
|
|
|
824
|
shift @_CB_STACK; |
2268
|
25
|
|
|
|
|
44
|
$_CUR_CB = $_CB_STACK[0]; |
2269
|
|
|
|
|
|
|
} |
2270
|
|
|
|
|
|
|
|
2271
|
25
|
|
|
|
|
817
|
return $retval; |
2272
|
|
|
|
|
|
|
} |
2273
|
|
|
|
|
|
|
|
2274
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
2275
|
|
|
|
|
|
|
# member functions and methods # |
2276
|
|
|
|
|
|
|
#-------------------------------------------------------------------------# |
2277
|
|
|
|
|
|
|
|
2278
|
|
|
|
|
|
|
sub new { |
2279
|
168
|
|
|
168
|
|
18664
|
my $CLASS = shift; |
2280
|
168
|
|
|
|
|
566
|
return bless {'_CALLBACKS' => []}, $CLASS; |
2281
|
|
|
|
|
|
|
} |
2282
|
|
|
|
|
|
|
|
2283
|
|
|
|
|
|
|
# add a callback set to the callback stack |
2284
|
|
|
|
|
|
|
# synopsis: $icb->register_callbacks( [$match_cb, $open_cb, $read_cb, $close_cb] ); |
2285
|
|
|
|
|
|
|
sub register_callbacks { |
2286
|
11
|
|
|
11
|
|
2507
|
my $self = shift; |
2287
|
11
|
|
|
|
|
17
|
my $cbset = shift; |
2288
|
|
|
|
|
|
|
|
2289
|
|
|
|
|
|
|
# test if callback set is complete |
2290
|
11
|
50
|
33
|
|
|
64
|
if ( ref $cbset eq "ARRAY" and scalar( @$cbset ) == 4 ) { |
2291
|
11
|
|
|
|
|
18
|
unshift @{$self->{_CALLBACKS}}, $cbset; |
|
11
|
|
|
|
|
36
|
|
2292
|
|
|
|
|
|
|
} |
2293
|
|
|
|
|
|
|
} |
2294
|
|
|
|
|
|
|
|
2295
|
|
|
|
|
|
|
# remove a callback set to the callback stack |
2296
|
|
|
|
|
|
|
# if a callback set is passed, this function will check for the match function |
2297
|
|
|
|
|
|
|
sub unregister_callbacks { |
2298
|
1
|
|
|
1
|
|
4275
|
my $self = shift; |
2299
|
1
|
|
|
|
|
2
|
my $cbset = shift; |
2300
|
1
|
50
|
33
|
|
|
13
|
if ( ref $cbset eq "ARRAY" and scalar( @$cbset ) == 4 ) { |
2301
|
1
|
|
|
|
|
2
|
$self->{_CALLBACKS} = [grep { $_->[0] != $cbset->[0] } @{$self->{_CALLBACKS}}]; |
|
2
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
4
|
|
2302
|
|
|
|
|
|
|
} |
2303
|
|
|
|
|
|
|
else { |
2304
|
0
|
|
|
|
|
0
|
shift @{$self->{_CALLBACKS}}; |
|
0
|
|
|
|
|
0
|
|
2305
|
|
|
|
|
|
|
} |
2306
|
|
|
|
|
|
|
} |
2307
|
|
|
|
|
|
|
|
2308
|
|
|
|
|
|
|
# make libxml2 use the callbacks |
2309
|
|
|
|
|
|
|
sub init_callbacks { |
2310
|
684
|
|
|
684
|
|
874
|
my $self = shift; |
2311
|
684
|
|
|
|
|
787
|
my $parser = shift; |
2312
|
|
|
|
|
|
|
|
2313
|
|
|
|
|
|
|
#initialize the libxml2 callbacks unless this is a nested callback |
2314
|
684
|
100
|
|
|
|
3326
|
$self->lib_init_callbacks() unless($_CB_NESTED_DEPTH); |
2315
|
|
|
|
|
|
|
|
2316
|
|
|
|
|
|
|
#store the callbacks for any outer executing parser instance |
2317
|
684
|
|
|
|
|
885
|
$_CB_NESTED_DEPTH++; |
2318
|
684
|
|
|
|
|
1682
|
push @_CB_NESTED_STACK, [ |
2319
|
|
|
|
|
|
|
$_CUR_CB, |
2320
|
|
|
|
|
|
|
[@_CB_STACK], |
2321
|
|
|
|
|
|
|
[@_GLOBAL_CALLBACKS], |
2322
|
|
|
|
|
|
|
]; |
2323
|
|
|
|
|
|
|
|
2324
|
|
|
|
|
|
|
#initialize the callback variables for the current parser |
2325
|
684
|
|
|
|
|
933
|
$_CUR_CB = undef; |
2326
|
684
|
|
|
|
|
961
|
@_CB_STACK = (); |
2327
|
684
|
|
|
|
|
782
|
@_GLOBAL_CALLBACKS = @{ $self->{_CALLBACKS} }; |
|
684
|
|
|
|
|
1335
|
|
2328
|
|
|
|
|
|
|
|
2329
|
|
|
|
|
|
|
#attach parser specific callbacks |
2330
|
684
|
50
|
|
|
|
1275
|
if($parser) { |
2331
|
684
|
|
|
|
|
1259
|
my $mcb = $parser->match_callback(); |
2332
|
684
|
|
|
|
|
1252
|
my $ocb = $parser->open_callback(); |
2333
|
684
|
|
|
|
|
1185
|
my $rcb = $parser->read_callback(); |
2334
|
684
|
|
|
|
|
1176
|
my $ccb = $parser->close_callback(); |
2335
|
684
|
50
|
66
|
|
|
1532
|
if ( defined $mcb and defined $ocb and defined $rcb and defined $ccb ) { |
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
2336
|
4
|
|
|
|
|
12
|
unshift @_GLOBAL_CALLBACKS, [$mcb, $ocb, $rcb, $ccb]; |
2337
|
|
|
|
|
|
|
} |
2338
|
|
|
|
|
|
|
} |
2339
|
|
|
|
|
|
|
|
2340
|
|
|
|
|
|
|
#attach global callbacks |
2341
|
684
|
50
|
66
|
|
|
1456
|
if ( defined $XML::LibXML::match_cb and |
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
2342
|
|
|
|
|
|
|
defined $XML::LibXML::open_cb and |
2343
|
|
|
|
|
|
|
defined $XML::LibXML::read_cb and |
2344
|
|
|
|
|
|
|
defined $XML::LibXML::close_cb ) { |
2345
|
1
|
|
|
|
|
2
|
push @_GLOBAL_CALLBACKS, [$XML::LibXML::match_cb, |
2346
|
|
|
|
|
|
|
$XML::LibXML::open_cb, |
2347
|
|
|
|
|
|
|
$XML::LibXML::read_cb, |
2348
|
|
|
|
|
|
|
$XML::LibXML::close_cb]; |
2349
|
|
|
|
|
|
|
} |
2350
|
|
|
|
|
|
|
} |
2351
|
|
|
|
|
|
|
|
2352
|
|
|
|
|
|
|
# reset libxml2's callbacks |
2353
|
|
|
|
|
|
|
sub cleanup_callbacks { |
2354
|
684
|
|
|
684
|
|
838
|
my $self = shift; |
2355
|
|
|
|
|
|
|
|
2356
|
|
|
|
|
|
|
#restore the callbacks for the outer parser instance |
2357
|
684
|
|
|
|
|
849
|
$_CB_NESTED_DEPTH--; |
2358
|
684
|
|
|
|
|
919
|
my $saved = pop @_CB_NESTED_STACK; |
2359
|
684
|
|
|
|
|
1051
|
$_CUR_CB = $saved->[0]; |
2360
|
684
|
|
|
|
|
826
|
@_CB_STACK = (@{$saved->[1]}); |
|
684
|
|
|
|
|
1047
|
|
2361
|
684
|
|
|
|
|
817
|
@_GLOBAL_CALLBACKS = (@{$saved->[2]}); |
|
684
|
|
|
|
|
892
|
|
2362
|
|
|
|
|
|
|
|
2363
|
|
|
|
|
|
|
#clean up the libxml2 callbacks unless there are still outer parsing instances |
2364
|
684
|
100
|
|
|
|
2390
|
$self->lib_cleanup_callbacks() unless($_CB_NESTED_DEPTH); |
2365
|
|
|
|
|
|
|
} |
2366
|
|
|
|
|
|
|
|
2367
|
|
|
|
|
|
|
$XML::LibXML::__loaded=1; |
2368
|
|
|
|
|
|
|
|
2369
|
|
|
|
|
|
|
1; |
2370
|
|
|
|
|
|
|
|
2371
|
|
|
|
|
|
|
__END__ |