line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
################################################################################ |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# Perl module: XML::DOM |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# By Enno Derksen |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
################################################################################ |
8
|
|
|
|
|
|
|
# |
9
|
|
|
|
|
|
|
# To do: |
10
|
|
|
|
|
|
|
# |
11
|
|
|
|
|
|
|
# * optimize Attr if it only contains 1 Text node to hold the value |
12
|
|
|
|
|
|
|
# * fix setDocType! |
13
|
|
|
|
|
|
|
# |
14
|
|
|
|
|
|
|
# * BUG: setOwnerDocument - does not process default attr values correctly, |
15
|
|
|
|
|
|
|
# they still point to the old doc. |
16
|
|
|
|
|
|
|
# * change Exception mechanism |
17
|
|
|
|
|
|
|
# * maybe: more checking of sysId etc. |
18
|
|
|
|
|
|
|
# * NoExpand mode (don't know what else is useful) |
19
|
|
|
|
|
|
|
# * various odds and ends: see comments starting with "??" |
20
|
|
|
|
|
|
|
# * normalize(1) could also expand CDataSections and EntityReferences |
21
|
|
|
|
|
|
|
# * parse a DocumentFragment? |
22
|
|
|
|
|
|
|
# * encoding support |
23
|
|
|
|
|
|
|
# |
24
|
|
|
|
|
|
|
###################################################################### |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
###################################################################### |
27
|
|
|
|
|
|
|
package XML::DOM; |
28
|
|
|
|
|
|
|
###################################################################### |
29
|
|
|
|
|
|
|
|
30
|
21
|
|
|
21
|
|
14525
|
use strict; |
|
21
|
|
|
|
|
24
|
|
|
21
|
|
|
|
|
630
|
|
31
|
|
|
|
|
|
|
|
32
|
21
|
|
|
|
|
1549
|
use vars qw( $VERSION @ISA @EXPORT |
33
|
|
|
|
|
|
|
$IgnoreReadOnly $SafeMode $TagStyle |
34
|
|
|
|
|
|
|
%DefaultEntities %DecodeDefaultEntity |
35
|
21
|
|
|
21
|
|
63
|
); |
|
21
|
|
|
|
|
20
|
|
36
|
21
|
|
|
21
|
|
69
|
use Carp; |
|
21
|
|
|
|
|
24
|
|
|
21
|
|
|
|
|
1146
|
|
37
|
21
|
|
|
21
|
|
8177
|
use XML::RegExp; |
|
21
|
|
|
|
|
8509
|
|
|
21
|
|
|
|
|
1720
|
|
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
BEGIN |
40
|
|
|
|
|
|
|
{ |
41
|
21
|
|
|
21
|
|
14522
|
require XML::Parser; |
42
|
0
|
|
|
|
|
|
$VERSION = '1.46'; |
43
|
|
|
|
|
|
|
|
44
|
0
|
|
|
|
|
|
my $needVersion = '2.28'; |
45
|
0
|
0
|
|
|
|
|
die "need at least XML::Parser version $needVersion (current=${XML::Parser::VERSION})" |
46
|
|
|
|
|
|
|
unless $XML::Parser::VERSION >= $needVersion; |
47
|
|
|
|
|
|
|
|
48
|
0
|
|
|
|
|
|
@ISA = qw( Exporter ); |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# Constants for XML::DOM Node types |
51
|
0
|
|
|
|
|
|
@EXPORT = qw( |
52
|
|
|
|
|
|
|
UNKNOWN_NODE |
53
|
|
|
|
|
|
|
ELEMENT_NODE |
54
|
|
|
|
|
|
|
ATTRIBUTE_NODE |
55
|
|
|
|
|
|
|
TEXT_NODE |
56
|
|
|
|
|
|
|
CDATA_SECTION_NODE |
57
|
|
|
|
|
|
|
ENTITY_REFERENCE_NODE |
58
|
|
|
|
|
|
|
ENTITY_NODE |
59
|
|
|
|
|
|
|
PROCESSING_INSTRUCTION_NODE |
60
|
|
|
|
|
|
|
COMMENT_NODE |
61
|
|
|
|
|
|
|
DOCUMENT_NODE |
62
|
|
|
|
|
|
|
DOCUMENT_TYPE_NODE |
63
|
|
|
|
|
|
|
DOCUMENT_FRAGMENT_NODE |
64
|
|
|
|
|
|
|
NOTATION_NODE |
65
|
|
|
|
|
|
|
ELEMENT_DECL_NODE |
66
|
|
|
|
|
|
|
ATT_DEF_NODE |
67
|
|
|
|
|
|
|
XML_DECL_NODE |
68
|
|
|
|
|
|
|
ATTLIST_DECL_NODE |
69
|
|
|
|
|
|
|
); |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
#---- Constant definitions |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# Node types |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub UNKNOWN_NODE () { 0 } # not in the DOM Spec |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub ELEMENT_NODE () { 1 } |
79
|
|
|
|
|
|
|
sub ATTRIBUTE_NODE () { 2 } |
80
|
|
|
|
|
|
|
sub TEXT_NODE () { 3 } |
81
|
|
|
|
|
|
|
sub CDATA_SECTION_NODE () { 4 } |
82
|
|
|
|
|
|
|
sub ENTITY_REFERENCE_NODE () { 5 } |
83
|
|
|
|
|
|
|
sub ENTITY_NODE () { 6 } |
84
|
|
|
|
|
|
|
sub PROCESSING_INSTRUCTION_NODE () { 7 } |
85
|
|
|
|
|
|
|
sub COMMENT_NODE () { 8 } |
86
|
|
|
|
|
|
|
sub DOCUMENT_NODE () { 9 } |
87
|
|
|
|
|
|
|
sub DOCUMENT_TYPE_NODE () { 10} |
88
|
|
|
|
|
|
|
sub DOCUMENT_FRAGMENT_NODE () { 11} |
89
|
|
|
|
|
|
|
sub NOTATION_NODE () { 12} |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub ELEMENT_DECL_NODE () { 13 } # not in the DOM Spec |
92
|
|
|
|
|
|
|
sub ATT_DEF_NODE () { 14 } # not in the DOM Spec |
93
|
|
|
|
|
|
|
sub XML_DECL_NODE () { 15 } # not in the DOM Spec |
94
|
|
|
|
|
|
|
sub ATTLIST_DECL_NODE () { 16 } # not in the DOM Spec |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
%DefaultEntities = |
97
|
|
|
|
|
|
|
( |
98
|
|
|
|
|
|
|
"quot" => '"', |
99
|
|
|
|
|
|
|
"gt" => ">", |
100
|
|
|
|
|
|
|
"lt" => "<", |
101
|
|
|
|
|
|
|
"apos" => "'", |
102
|
|
|
|
|
|
|
"amp" => "&" |
103
|
|
|
|
|
|
|
); |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
%DecodeDefaultEntity = |
106
|
|
|
|
|
|
|
( |
107
|
|
|
|
|
|
|
'"' => """, |
108
|
|
|
|
|
|
|
">" => ">", |
109
|
|
|
|
|
|
|
"<" => "<", |
110
|
|
|
|
|
|
|
"'" => "'", |
111
|
|
|
|
|
|
|
"&" => "&" |
112
|
|
|
|
|
|
|
); |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
# |
115
|
|
|
|
|
|
|
# If you don't want DOM warnings to use 'warn', override this method like this: |
116
|
|
|
|
|
|
|
# |
117
|
|
|
|
|
|
|
# { # start block scope |
118
|
|
|
|
|
|
|
# local *XML::DOM::warning = \&my_warn; |
119
|
|
|
|
|
|
|
# ... your code here ... |
120
|
|
|
|
|
|
|
# } # end block scope (old XML::DOM::warning takes effect again) |
121
|
|
|
|
|
|
|
# |
122
|
|
|
|
|
|
|
sub warning # static |
123
|
|
|
|
|
|
|
{ |
124
|
|
|
|
|
|
|
warn @_; |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
# |
128
|
|
|
|
|
|
|
# This method defines several things in the caller's package, so you can use named constants to |
129
|
|
|
|
|
|
|
# access the array that holds the member data, i.e. $self->[_Data]. It assumes the caller's package |
130
|
|
|
|
|
|
|
# defines a class that is implemented as a blessed array reference. |
131
|
|
|
|
|
|
|
# Note that this is very similar to using 'use fields' and 'use base'. |
132
|
|
|
|
|
|
|
# |
133
|
|
|
|
|
|
|
# E.g. if $fields eq "Name Model", $parent eq "XML::DOM::Node" and |
134
|
|
|
|
|
|
|
# XML::DOM::Node had "A B C" as fields and it was called from package "XML::DOM::ElementDecl", |
135
|
|
|
|
|
|
|
# then this code would basically do the following: |
136
|
|
|
|
|
|
|
# |
137
|
|
|
|
|
|
|
# package XML::DOM::ElementDecl; |
138
|
|
|
|
|
|
|
# |
139
|
|
|
|
|
|
|
# sub _Name () { 3 } # Note that parent class had three fields |
140
|
|
|
|
|
|
|
# sub _Model () { 4 } |
141
|
|
|
|
|
|
|
# |
142
|
|
|
|
|
|
|
# # Maps constant names (without '_') to constant (int) value |
143
|
|
|
|
|
|
|
# %HFIELDS = ( %XML::DOM::Node::HFIELDS, Name => _Name, Model => _Model ); |
144
|
|
|
|
|
|
|
# |
145
|
|
|
|
|
|
|
# # Define XML:DOM::ElementDecl as a subclass of XML::DOM::Node |
146
|
|
|
|
|
|
|
# @ISA = qw{ XML::DOM::Node }; |
147
|
|
|
|
|
|
|
# |
148
|
|
|
|
|
|
|
# # The following function names can be exported into the user's namespace. |
149
|
|
|
|
|
|
|
# @EXPORT_OK = qw{ _Name _Model }; |
150
|
|
|
|
|
|
|
# |
151
|
|
|
|
|
|
|
# # The following function names can be exported into the user's namespace |
152
|
|
|
|
|
|
|
# # with: import XML::DOM::ElementDecl qw( :Fields ); |
153
|
|
|
|
|
|
|
# %EXPORT_TAGS = ( Fields => qw{ _Name _Model } ); |
154
|
|
|
|
|
|
|
# |
155
|
|
|
|
|
|
|
sub def_fields # static |
156
|
|
|
|
|
|
|
{ |
157
|
|
|
|
|
|
|
my ($fields, $parent) = @_; |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
my ($pkg) = caller; |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
no strict 'refs'; |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
my @f = split (/\s+/, $fields); |
164
|
|
|
|
|
|
|
my $n = 0; |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
my %hfields; |
167
|
|
|
|
|
|
|
if (defined $parent) |
168
|
|
|
|
|
|
|
{ |
169
|
|
|
|
|
|
|
my %pf = %{"$parent\::HFIELDS"}; |
170
|
|
|
|
|
|
|
%hfields = %pf; |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
$n = scalar (keys %pf); |
173
|
|
|
|
|
|
|
@{"$pkg\::ISA"} = ( $parent ); |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
my $i = $n; |
177
|
|
|
|
|
|
|
for (@f) |
178
|
|
|
|
|
|
|
{ |
179
|
|
|
|
|
|
|
eval "sub $pkg\::_$_ () { $i }"; |
180
|
|
|
|
|
|
|
$hfields{$_} = $i; |
181
|
|
|
|
|
|
|
$i++; |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
%{"$pkg\::HFIELDS"} = %hfields; |
184
|
|
|
|
|
|
|
@{"$pkg\::EXPORT_OK"} = map { "_$_" } @f; |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
${"$pkg\::EXPORT_TAGS"}{Fields} = [ map { "_$_" } @f ]; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
# sub blesh |
190
|
|
|
|
|
|
|
# { |
191
|
|
|
|
|
|
|
# my $hashref = shift; |
192
|
|
|
|
|
|
|
# my $class = shift; |
193
|
|
|
|
|
|
|
# no strict 'refs'; |
194
|
|
|
|
|
|
|
# my $self = bless [\%{"$class\::FIELDS"}], $class; |
195
|
|
|
|
|
|
|
# if (defined $hashref) |
196
|
|
|
|
|
|
|
# { |
197
|
|
|
|
|
|
|
# for (keys %$hashref) |
198
|
|
|
|
|
|
|
# { |
199
|
|
|
|
|
|
|
# $self->{$_} = $hashref->{$_}; |
200
|
|
|
|
|
|
|
# } |
201
|
|
|
|
|
|
|
# } |
202
|
|
|
|
|
|
|
# $self; |
203
|
|
|
|
|
|
|
# } |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
# sub blesh2 |
206
|
|
|
|
|
|
|
# { |
207
|
|
|
|
|
|
|
# my $hashref = shift; |
208
|
|
|
|
|
|
|
# my $class = shift; |
209
|
|
|
|
|
|
|
# no strict 'refs'; |
210
|
|
|
|
|
|
|
# my $self = bless [\%{"$class\::FIELDS"}], $class; |
211
|
|
|
|
|
|
|
# if (defined $hashref) |
212
|
|
|
|
|
|
|
# { |
213
|
|
|
|
|
|
|
# for (keys %$hashref) |
214
|
|
|
|
|
|
|
# { |
215
|
|
|
|
|
|
|
# eval { $self->{$_} = $hashref->{$_}; }; |
216
|
|
|
|
|
|
|
# croak "ERROR in field [$_] $@" if $@; |
217
|
|
|
|
|
|
|
# } |
218
|
|
|
|
|
|
|
# } |
219
|
|
|
|
|
|
|
# $self; |
220
|
|
|
|
|
|
|
#} |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
# |
223
|
|
|
|
|
|
|
# CDATA section may not contain "]]>" |
224
|
|
|
|
|
|
|
# |
225
|
|
|
|
|
|
|
sub encodeCDATA |
226
|
|
|
|
|
|
|
{ |
227
|
|
|
|
|
|
|
my ($str) = shift; |
228
|
|
|
|
|
|
|
$str =~ s/]]>/]]>/go; |
229
|
|
|
|
|
|
|
$str; |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
# |
233
|
|
|
|
|
|
|
# PI may not contain "?>" |
234
|
|
|
|
|
|
|
# |
235
|
|
|
|
|
|
|
sub encodeProcessingInstruction |
236
|
|
|
|
|
|
|
{ |
237
|
|
|
|
|
|
|
my ($str) = shift; |
238
|
|
|
|
|
|
|
$str =~ s/\?>/?>/go; |
239
|
|
|
|
|
|
|
$str; |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
# |
243
|
|
|
|
|
|
|
#?? Not sure if this is right - must prevent double minus somehow... |
244
|
|
|
|
|
|
|
# |
245
|
|
|
|
|
|
|
sub encodeComment |
246
|
|
|
|
|
|
|
{ |
247
|
|
|
|
|
|
|
my ($str) = shift; |
248
|
|
|
|
|
|
|
return undef unless defined $str; |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
$str =~ s/--/--/go; |
251
|
|
|
|
|
|
|
$str; |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
# |
255
|
|
|
|
|
|
|
# For debugging |
256
|
|
|
|
|
|
|
# |
257
|
|
|
|
|
|
|
sub toHex |
258
|
|
|
|
|
|
|
{ |
259
|
|
|
|
|
|
|
my $str = shift; |
260
|
|
|
|
|
|
|
my $len = length($str); |
261
|
|
|
|
|
|
|
my @a = unpack ("C$len", $str); |
262
|
|
|
|
|
|
|
my $s = ""; |
263
|
|
|
|
|
|
|
for (@a) |
264
|
|
|
|
|
|
|
{ |
265
|
|
|
|
|
|
|
$s .= sprintf ("%02x", $_); |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
$s; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
# |
271
|
|
|
|
|
|
|
# 2nd parameter $default: list of Default Entity characters that need to be |
272
|
|
|
|
|
|
|
# converted (e.g. "&<" for conversion to "&" and "<" resp.) |
273
|
|
|
|
|
|
|
# |
274
|
|
|
|
|
|
|
sub encodeText |
275
|
|
|
|
|
|
|
{ |
276
|
|
|
|
|
|
|
my ($str, $default) = @_; |
277
|
|
|
|
|
|
|
return undef unless defined $str; |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
if ($] >= 5.006) { |
280
|
|
|
|
|
|
|
$str =~ s/([$default])|(]]>)/ |
281
|
|
|
|
|
|
|
defined ($1) ? $DecodeDefaultEntity{$1} : "]]>" /egs; |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
else { |
284
|
|
|
|
|
|
|
$str =~ s/([\xC0-\xDF].|[\xE0-\xEF]..|[\xF0-\xFF]...)|([$default])|(]]>)/ |
285
|
|
|
|
|
|
|
defined($1) ? XmlUtf8Decode ($1) : |
286
|
|
|
|
|
|
|
defined ($2) ? $DecodeDefaultEntity{$2} : "]]>" /egs; |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
#?? could there be references that should not be expanded? |
290
|
|
|
|
|
|
|
# e.g. should not replace nn; ¯ and &abc; |
291
|
|
|
|
|
|
|
# $str =~ s/&(?!($ReName|#[0-9]+|#x[0-9a-fA-F]+);)/&/go; |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
$str; |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
# |
297
|
|
|
|
|
|
|
# Used by AttDef - default value |
298
|
|
|
|
|
|
|
# |
299
|
|
|
|
|
|
|
sub encodeAttrValue |
300
|
|
|
|
|
|
|
{ |
301
|
|
|
|
|
|
|
encodeText (shift, '"&<>'); |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
# |
305
|
|
|
|
|
|
|
# Converts an integer (Unicode - ISO/IEC 10646) to a UTF-8 encoded character |
306
|
|
|
|
|
|
|
# sequence. |
307
|
|
|
|
|
|
|
# Used when converting e.g. { or Ͽ to a string value. |
308
|
|
|
|
|
|
|
# |
309
|
|
|
|
|
|
|
# Algorithm borrowed from expat/xmltok.c/XmlUtf8Encode() |
310
|
|
|
|
|
|
|
# |
311
|
|
|
|
|
|
|
# not checking for bad characters: < 0, x00-x08, x0B-x0C, x0E-x1F, xFFFE-xFFFF |
312
|
|
|
|
|
|
|
# |
313
|
|
|
|
|
|
|
sub XmlUtf8Encode |
314
|
|
|
|
|
|
|
{ |
315
|
|
|
|
|
|
|
my $n = shift; |
316
|
|
|
|
|
|
|
if ($n < 0x80) |
317
|
|
|
|
|
|
|
{ |
318
|
|
|
|
|
|
|
return chr ($n); |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
elsif ($n < 0x800) |
321
|
|
|
|
|
|
|
{ |
322
|
|
|
|
|
|
|
return pack ("CC", (($n >> 6) | 0xc0), (($n & 0x3f) | 0x80)); |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
elsif ($n < 0x10000) |
325
|
|
|
|
|
|
|
{ |
326
|
|
|
|
|
|
|
return pack ("CCC", (($n >> 12) | 0xe0), ((($n >> 6) & 0x3f) | 0x80), |
327
|
|
|
|
|
|
|
(($n & 0x3f) | 0x80)); |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
elsif ($n < 0x110000) |
330
|
|
|
|
|
|
|
{ |
331
|
|
|
|
|
|
|
return pack ("CCCC", (($n >> 18) | 0xf0), ((($n >> 12) & 0x3f) | 0x80), |
332
|
|
|
|
|
|
|
((($n >> 6) & 0x3f) | 0x80), (($n & 0x3f) | 0x80)); |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
croak "number is too large for Unicode [$n] in &XmlUtf8Encode"; |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
# |
338
|
|
|
|
|
|
|
# Opposite of XmlUtf8Decode plus it adds prefix "" or "" and suffix ";" |
339
|
|
|
|
|
|
|
# The 2nd parameter ($hex) indicates whether the result is hex encoded or not. |
340
|
|
|
|
|
|
|
# |
341
|
|
|
|
|
|
|
sub XmlUtf8Decode |
342
|
|
|
|
|
|
|
{ |
343
|
|
|
|
|
|
|
my ($str, $hex) = @_; |
344
|
|
|
|
|
|
|
my $len = length ($str); |
345
|
|
|
|
|
|
|
my $n; |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
if ($len == 2) |
348
|
|
|
|
|
|
|
{ |
349
|
|
|
|
|
|
|
my @n = unpack "C2", $str; |
350
|
|
|
|
|
|
|
$n = (($n[0] & 0x3f) << 6) + ($n[1] & 0x3f); |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
elsif ($len == 3) |
353
|
|
|
|
|
|
|
{ |
354
|
|
|
|
|
|
|
my @n = unpack "C3", $str; |
355
|
|
|
|
|
|
|
$n = (($n[0] & 0x1f) << 12) + (($n[1] & 0x3f) << 6) + |
356
|
|
|
|
|
|
|
($n[2] & 0x3f); |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
elsif ($len == 4) |
359
|
|
|
|
|
|
|
{ |
360
|
|
|
|
|
|
|
my @n = unpack "C4", $str; |
361
|
|
|
|
|
|
|
$n = (($n[0] & 0x0f) << 18) + (($n[1] & 0x3f) << 12) + |
362
|
|
|
|
|
|
|
(($n[2] & 0x3f) << 6) + ($n[3] & 0x3f); |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
elsif ($len == 1) # just to be complete... |
365
|
|
|
|
|
|
|
{ |
366
|
|
|
|
|
|
|
$n = ord ($str); |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
else |
369
|
|
|
|
|
|
|
{ |
370
|
|
|
|
|
|
|
croak "bad value [$str] for XmlUtf8Decode"; |
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
$hex ? sprintf ("%x;", $n) : "$n;"; |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
$IgnoreReadOnly = 0; |
376
|
|
|
|
|
|
|
$SafeMode = 1; |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
sub getIgnoreReadOnly |
379
|
|
|
|
|
|
|
{ |
380
|
|
|
|
|
|
|
$IgnoreReadOnly; |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
# |
384
|
|
|
|
|
|
|
# The global flag $IgnoreReadOnly is set to the specified value and the old |
385
|
|
|
|
|
|
|
# value of $IgnoreReadOnly is returned. |
386
|
|
|
|
|
|
|
# |
387
|
|
|
|
|
|
|
# To temporarily disable read-only related exceptions (i.e. when parsing |
388
|
|
|
|
|
|
|
# XML or temporarily), do the following: |
389
|
|
|
|
|
|
|
# |
390
|
|
|
|
|
|
|
# my $oldIgnore = XML::DOM::ignoreReadOnly (1); |
391
|
|
|
|
|
|
|
# ... do whatever you want ... |
392
|
|
|
|
|
|
|
# XML::DOM::ignoreReadOnly ($oldIgnore); |
393
|
|
|
|
|
|
|
# |
394
|
|
|
|
|
|
|
sub ignoreReadOnly |
395
|
|
|
|
|
|
|
{ |
396
|
|
|
|
|
|
|
my $i = $IgnoreReadOnly; |
397
|
|
|
|
|
|
|
$IgnoreReadOnly = $_[0]; |
398
|
|
|
|
|
|
|
return $i; |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
# |
402
|
|
|
|
|
|
|
# XML spec seems to break its own rules... (see ENTITY xmlpio) |
403
|
|
|
|
|
|
|
# |
404
|
|
|
|
|
|
|
sub forgiving_isValidName |
405
|
|
|
|
|
|
|
{ |
406
|
|
|
|
|
|
|
use bytes; # XML::RegExp expressed in terms encoded UTF8 |
407
|
|
|
|
|
|
|
$_[0] =~ /^$XML::RegExp::Name$/o; |
408
|
|
|
|
|
|
|
} |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
# |
411
|
|
|
|
|
|
|
# Don't allow names starting with xml (either case) |
412
|
|
|
|
|
|
|
# |
413
|
|
|
|
|
|
|
sub picky_isValidName |
414
|
|
|
|
|
|
|
{ |
415
|
|
|
|
|
|
|
use bytes; # XML::RegExp expressed in terms encoded UTF8 |
416
|
|
|
|
|
|
|
$_[0] =~ /^$XML::RegExp::Name$/o and $_[0] !~ /^xml/i; |
417
|
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
# Be forgiving by default, |
420
|
|
|
|
|
|
|
*isValidName = \&forgiving_isValidName; |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
sub allowReservedNames # static |
423
|
|
|
|
|
|
|
{ |
424
|
|
|
|
|
|
|
*isValidName = ($_[0] ? \&forgiving_isValidName : \&picky_isValidName); |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
sub getAllowReservedNames # static |
428
|
|
|
|
|
|
|
{ |
429
|
|
|
|
|
|
|
*isValidName == \&forgiving_isValidName; |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
# |
433
|
|
|
|
|
|
|
# Always compress empty tags by default |
434
|
|
|
|
|
|
|
# This is used by Element::print. |
435
|
|
|
|
|
|
|
# |
436
|
|
|
|
|
|
|
$TagStyle = sub { 0 }; |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
sub setTagCompression |
439
|
|
|
|
|
|
|
{ |
440
|
|
|
|
|
|
|
$TagStyle = shift; |
441
|
|
|
|
|
|
|
} |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
###################################################################### |
444
|
|
|
|
|
|
|
package XML::DOM::PrintToFileHandle; |
445
|
|
|
|
|
|
|
###################################################################### |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
# |
448
|
|
|
|
|
|
|
# Used by XML::DOM::Node::printToFileHandle |
449
|
|
|
|
|
|
|
# |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
sub new |
452
|
|
|
|
|
|
|
{ |
453
|
|
|
|
|
|
|
my($class, $fn) = @_; |
454
|
|
|
|
|
|
|
bless $fn, $class; |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
sub print |
458
|
|
|
|
|
|
|
{ |
459
|
|
|
|
|
|
|
my ($self, $str) = @_; |
460
|
|
|
|
|
|
|
print $self $str; |
461
|
|
|
|
|
|
|
} |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
###################################################################### |
464
|
|
|
|
|
|
|
package XML::DOM::PrintToString; |
465
|
|
|
|
|
|
|
###################################################################### |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
use vars qw{ $Singleton }; |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
# |
470
|
|
|
|
|
|
|
# Used by XML::DOM::Node::toString to concatenate strings |
471
|
|
|
|
|
|
|
# |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
sub new |
474
|
|
|
|
|
|
|
{ |
475
|
|
|
|
|
|
|
my($class) = @_; |
476
|
|
|
|
|
|
|
my $str = ""; |
477
|
|
|
|
|
|
|
bless \$str, $class; |
478
|
|
|
|
|
|
|
} |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
sub print |
481
|
|
|
|
|
|
|
{ |
482
|
|
|
|
|
|
|
my ($self, $str) = @_; |
483
|
|
|
|
|
|
|
$$self .= $str; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
sub toString |
487
|
|
|
|
|
|
|
{ |
488
|
|
|
|
|
|
|
my $self = shift; |
489
|
|
|
|
|
|
|
$$self; |
490
|
|
|
|
|
|
|
} |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
sub reset |
493
|
|
|
|
|
|
|
{ |
494
|
|
|
|
|
|
|
${$_[0]} = ""; |
495
|
|
|
|
|
|
|
} |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
$Singleton = new XML::DOM::PrintToString; |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
###################################################################### |
500
|
|
|
|
|
|
|
package XML::DOM::DOMImplementation; |
501
|
|
|
|
|
|
|
###################################################################### |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
$XML::DOM::DOMImplementation::Singleton = |
504
|
|
|
|
|
|
|
bless \$XML::DOM::DOMImplementation::Singleton, 'XML::DOM::DOMImplementation'; |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
sub hasFeature |
507
|
|
|
|
|
|
|
{ |
508
|
|
|
|
|
|
|
my ($self, $feature, $version) = @_; |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
uc($feature) eq 'XML' and ($version eq '1.0' || $version eq ''); |
511
|
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
###################################################################### |
515
|
|
|
|
|
|
|
package XML::XQL::Node; # forward declaration |
516
|
|
|
|
|
|
|
###################################################################### |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
###################################################################### |
519
|
|
|
|
|
|
|
package XML::DOM::Node; |
520
|
|
|
|
|
|
|
###################################################################### |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
use vars qw( @NodeNames @EXPORT @ISA %HFIELDS @EXPORT_OK @EXPORT_TAGS ); |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
BEGIN |
525
|
|
|
|
|
|
|
{ |
526
|
|
|
|
|
|
|
use XML::DOM::DOMException; |
527
|
|
|
|
|
|
|
import Carp; |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
require FileHandle; |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
@ISA = qw( Exporter XML::XQL::Node ); |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
# NOTE: SortKey is used in XML::XQL::Node. |
534
|
|
|
|
|
|
|
# UserData is reserved for users (Hang your data here!) |
535
|
|
|
|
|
|
|
XML::DOM::def_fields ("C A Doc Parent ReadOnly UsedIn Hidden SortKey UserData"); |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
push (@EXPORT, qw( |
538
|
|
|
|
|
|
|
UNKNOWN_NODE |
539
|
|
|
|
|
|
|
ELEMENT_NODE |
540
|
|
|
|
|
|
|
ATTRIBUTE_NODE |
541
|
|
|
|
|
|
|
TEXT_NODE |
542
|
|
|
|
|
|
|
CDATA_SECTION_NODE |
543
|
|
|
|
|
|
|
ENTITY_REFERENCE_NODE |
544
|
|
|
|
|
|
|
ENTITY_NODE |
545
|
|
|
|
|
|
|
PROCESSING_INSTRUCTION_NODE |
546
|
|
|
|
|
|
|
COMMENT_NODE |
547
|
|
|
|
|
|
|
DOCUMENT_NODE |
548
|
|
|
|
|
|
|
DOCUMENT_TYPE_NODE |
549
|
|
|
|
|
|
|
DOCUMENT_FRAGMENT_NODE |
550
|
|
|
|
|
|
|
NOTATION_NODE |
551
|
|
|
|
|
|
|
ELEMENT_DECL_NODE |
552
|
|
|
|
|
|
|
ATT_DEF_NODE |
553
|
|
|
|
|
|
|
XML_DECL_NODE |
554
|
|
|
|
|
|
|
ATTLIST_DECL_NODE |
555
|
|
|
|
|
|
|
)); |
556
|
|
|
|
|
|
|
} |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
#---- Constant definitions |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
# Node types |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
sub UNKNOWN_NODE () {0;} # not in the DOM Spec |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
sub ELEMENT_NODE () {1;} |
565
|
|
|
|
|
|
|
sub ATTRIBUTE_NODE () {2;} |
566
|
|
|
|
|
|
|
sub TEXT_NODE () {3;} |
567
|
|
|
|
|
|
|
sub CDATA_SECTION_NODE () {4;} |
568
|
|
|
|
|
|
|
sub ENTITY_REFERENCE_NODE () {5;} |
569
|
|
|
|
|
|
|
sub ENTITY_NODE () {6;} |
570
|
|
|
|
|
|
|
sub PROCESSING_INSTRUCTION_NODE () {7;} |
571
|
|
|
|
|
|
|
sub COMMENT_NODE () {8;} |
572
|
|
|
|
|
|
|
sub DOCUMENT_NODE () {9;} |
573
|
|
|
|
|
|
|
sub DOCUMENT_TYPE_NODE () {10;} |
574
|
|
|
|
|
|
|
sub DOCUMENT_FRAGMENT_NODE () {11;} |
575
|
|
|
|
|
|
|
sub NOTATION_NODE () {12;} |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
sub ELEMENT_DECL_NODE () {13;} # not in the DOM Spec |
578
|
|
|
|
|
|
|
sub ATT_DEF_NODE () {14;} # not in the DOM Spec |
579
|
|
|
|
|
|
|
sub XML_DECL_NODE () {15;} # not in the DOM Spec |
580
|
|
|
|
|
|
|
sub ATTLIST_DECL_NODE () {16;} # not in the DOM Spec |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
@NodeNames = ( |
583
|
|
|
|
|
|
|
"UNKNOWN_NODE", # not in the DOM Spec! |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
"ELEMENT_NODE", |
586
|
|
|
|
|
|
|
"ATTRIBUTE_NODE", |
587
|
|
|
|
|
|
|
"TEXT_NODE", |
588
|
|
|
|
|
|
|
"CDATA_SECTION_NODE", |
589
|
|
|
|
|
|
|
"ENTITY_REFERENCE_NODE", |
590
|
|
|
|
|
|
|
"ENTITY_NODE", |
591
|
|
|
|
|
|
|
"PROCESSING_INSTRUCTION_NODE", |
592
|
|
|
|
|
|
|
"COMMENT_NODE", |
593
|
|
|
|
|
|
|
"DOCUMENT_NODE", |
594
|
|
|
|
|
|
|
"DOCUMENT_TYPE_NODE", |
595
|
|
|
|
|
|
|
"DOCUMENT_FRAGMENT_NODE", |
596
|
|
|
|
|
|
|
"NOTATION_NODE", |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
"ELEMENT_DECL_NODE", |
599
|
|
|
|
|
|
|
"ATT_DEF_NODE", |
600
|
|
|
|
|
|
|
"XML_DECL_NODE", |
601
|
|
|
|
|
|
|
"ATTLIST_DECL_NODE" |
602
|
|
|
|
|
|
|
); |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
sub decoupleUsedIn |
605
|
|
|
|
|
|
|
{ |
606
|
|
|
|
|
|
|
my $self = shift; |
607
|
|
|
|
|
|
|
undef $self->[_UsedIn]; # was delete |
608
|
|
|
|
|
|
|
} |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
sub getParentNode |
611
|
|
|
|
|
|
|
{ |
612
|
|
|
|
|
|
|
$_[0]->[_Parent]; |
613
|
|
|
|
|
|
|
} |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
sub appendChild |
616
|
|
|
|
|
|
|
{ |
617
|
|
|
|
|
|
|
my ($self, $node) = @_; |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
# REC 7473 |
620
|
|
|
|
|
|
|
if ($XML::DOM::SafeMode) |
621
|
|
|
|
|
|
|
{ |
622
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, |
623
|
|
|
|
|
|
|
"node is ReadOnly") |
624
|
|
|
|
|
|
|
if $self->isReadOnly; |
625
|
|
|
|
|
|
|
} |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
my $doc = $self->[_Doc]; |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
if ($node->isDocumentFragmentNode) |
630
|
|
|
|
|
|
|
{ |
631
|
|
|
|
|
|
|
if ($XML::DOM::SafeMode) |
632
|
|
|
|
|
|
|
{ |
633
|
|
|
|
|
|
|
for my $n (@{$node->[_C]}) |
634
|
|
|
|
|
|
|
{ |
635
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR, |
636
|
|
|
|
|
|
|
"nodes belong to different documents") |
637
|
|
|
|
|
|
|
if $doc != $n->[_Doc]; |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, |
640
|
|
|
|
|
|
|
"node is ancestor of parent node") |
641
|
|
|
|
|
|
|
if $n->isAncestor ($self); |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, |
644
|
|
|
|
|
|
|
"bad node type") |
645
|
|
|
|
|
|
|
if $self->rejectChild ($n); |
646
|
|
|
|
|
|
|
} |
647
|
|
|
|
|
|
|
} |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
my @list = @{$node->[_C]}; # don't try to compress this |
650
|
|
|
|
|
|
|
for my $n (@list) |
651
|
|
|
|
|
|
|
{ |
652
|
|
|
|
|
|
|
$n->setParentNode ($self); |
653
|
|
|
|
|
|
|
} |
654
|
|
|
|
|
|
|
push @{$self->[_C]}, @list; |
655
|
|
|
|
|
|
|
} |
656
|
|
|
|
|
|
|
else |
657
|
|
|
|
|
|
|
{ |
658
|
|
|
|
|
|
|
if ($XML::DOM::SafeMode) |
659
|
|
|
|
|
|
|
{ |
660
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR, |
661
|
|
|
|
|
|
|
"nodes belong to different documents") |
662
|
|
|
|
|
|
|
if $doc != $node->[_Doc]; |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, |
665
|
|
|
|
|
|
|
"node is ancestor of parent node") |
666
|
|
|
|
|
|
|
if $node->isAncestor ($self); |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, |
669
|
|
|
|
|
|
|
"bad node type") |
670
|
|
|
|
|
|
|
if $self->rejectChild ($node); |
671
|
|
|
|
|
|
|
} |
672
|
|
|
|
|
|
|
$node->setParentNode ($self); |
673
|
|
|
|
|
|
|
push @{$self->[_C]}, $node; |
674
|
|
|
|
|
|
|
} |
675
|
|
|
|
|
|
|
$node; |
676
|
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
sub getChildNodes |
679
|
|
|
|
|
|
|
{ |
680
|
|
|
|
|
|
|
# NOTE: if node can't have children, $self->[_C] is undef. |
681
|
|
|
|
|
|
|
my $kids = $_[0]->[_C]; |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
# Return a list if called in list context. |
684
|
|
|
|
|
|
|
wantarray ? (defined ($kids) ? @{ $kids } : ()) : |
685
|
|
|
|
|
|
|
(defined ($kids) ? $kids : $XML::DOM::NodeList::EMPTY); |
686
|
|
|
|
|
|
|
} |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
sub hasChildNodes |
689
|
|
|
|
|
|
|
{ |
690
|
|
|
|
|
|
|
my $kids = $_[0]->[_C]; |
691
|
|
|
|
|
|
|
defined ($kids) && @$kids > 0; |
692
|
|
|
|
|
|
|
} |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
# This method is overriden in Document |
695
|
|
|
|
|
|
|
sub getOwnerDocument |
696
|
|
|
|
|
|
|
{ |
697
|
|
|
|
|
|
|
$_[0]->[_Doc]; |
698
|
|
|
|
|
|
|
} |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
sub getFirstChild |
701
|
|
|
|
|
|
|
{ |
702
|
|
|
|
|
|
|
my $kids = $_[0]->[_C]; |
703
|
|
|
|
|
|
|
defined $kids ? $kids->[0] : undef; |
704
|
|
|
|
|
|
|
} |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
sub getLastChild |
707
|
|
|
|
|
|
|
{ |
708
|
|
|
|
|
|
|
my $kids = $_[0]->[_C]; |
709
|
|
|
|
|
|
|
defined $kids ? $kids->[-1] : undef; |
710
|
|
|
|
|
|
|
} |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
sub getPreviousSibling |
713
|
|
|
|
|
|
|
{ |
714
|
|
|
|
|
|
|
my $self = shift; |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
my $pa = $self->[_Parent]; |
717
|
|
|
|
|
|
|
return undef unless $pa; |
718
|
|
|
|
|
|
|
my $index = $pa->getChildIndex ($self); |
719
|
|
|
|
|
|
|
return undef unless $index; |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
$pa->getChildAtIndex ($index - 1); |
722
|
|
|
|
|
|
|
} |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
sub getNextSibling |
725
|
|
|
|
|
|
|
{ |
726
|
|
|
|
|
|
|
my $self = shift; |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
my $pa = $self->[_Parent]; |
729
|
|
|
|
|
|
|
return undef unless $pa; |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
$pa->getChildAtIndex ($pa->getChildIndex ($self) + 1); |
732
|
|
|
|
|
|
|
} |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
sub insertBefore |
735
|
|
|
|
|
|
|
{ |
736
|
|
|
|
|
|
|
my ($self, $node, $refNode) = @_; |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
return $self->appendChild ($node) unless $refNode; # append at the end |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, |
741
|
|
|
|
|
|
|
"node is ReadOnly") |
742
|
|
|
|
|
|
|
if $self->isReadOnly; |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
my @nodes = ($node); |
745
|
|
|
|
|
|
|
@nodes = @{$node->[_C]} |
746
|
|
|
|
|
|
|
if $node->getNodeType == DOCUMENT_FRAGMENT_NODE; |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
my $doc = $self->[_Doc]; |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
for my $n (@nodes) |
751
|
|
|
|
|
|
|
{ |
752
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR, |
753
|
|
|
|
|
|
|
"nodes belong to different documents") |
754
|
|
|
|
|
|
|
if $doc != $n->[_Doc]; |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, |
757
|
|
|
|
|
|
|
"node is ancestor of parent node") |
758
|
|
|
|
|
|
|
if $n->isAncestor ($self); |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, |
761
|
|
|
|
|
|
|
"bad node type") |
762
|
|
|
|
|
|
|
if $self->rejectChild ($n); |
763
|
|
|
|
|
|
|
} |
764
|
|
|
|
|
|
|
my $index = $self->getChildIndex ($refNode); |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (NOT_FOUND_ERR, |
767
|
|
|
|
|
|
|
"reference node not found") |
768
|
|
|
|
|
|
|
if $index == -1; |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
for my $n (@nodes) |
771
|
|
|
|
|
|
|
{ |
772
|
|
|
|
|
|
|
$n->setParentNode ($self); |
773
|
|
|
|
|
|
|
} |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
splice (@{$self->[_C]}, $index, 0, @nodes); |
776
|
|
|
|
|
|
|
$node; |
777
|
|
|
|
|
|
|
} |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
sub replaceChild |
780
|
|
|
|
|
|
|
{ |
781
|
|
|
|
|
|
|
my ($self, $node, $refNode) = @_; |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, |
784
|
|
|
|
|
|
|
"node is ReadOnly") |
785
|
|
|
|
|
|
|
if $self->isReadOnly; |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
my @nodes = ($node); |
788
|
|
|
|
|
|
|
@nodes = @{$node->[_C]} |
789
|
|
|
|
|
|
|
if $node->getNodeType == DOCUMENT_FRAGMENT_NODE; |
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
for my $n (@nodes) |
792
|
|
|
|
|
|
|
{ |
793
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR, |
794
|
|
|
|
|
|
|
"nodes belong to different documents") |
795
|
|
|
|
|
|
|
if $self->[_Doc] != $n->[_Doc]; |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, |
798
|
|
|
|
|
|
|
"node is ancestor of parent node") |
799
|
|
|
|
|
|
|
if $n->isAncestor ($self); |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, |
802
|
|
|
|
|
|
|
"bad node type") |
803
|
|
|
|
|
|
|
if $self->rejectChild ($n); |
804
|
|
|
|
|
|
|
} |
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
my $index = $self->getChildIndex ($refNode); |
807
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (NOT_FOUND_ERR, |
808
|
|
|
|
|
|
|
"reference node not found") |
809
|
|
|
|
|
|
|
if $index == -1; |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
for my $n (@nodes) |
812
|
|
|
|
|
|
|
{ |
813
|
|
|
|
|
|
|
$n->setParentNode ($self); |
814
|
|
|
|
|
|
|
} |
815
|
|
|
|
|
|
|
splice (@{$self->[_C]}, $index, 1, @nodes); |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
$refNode->removeChildHoodMemories; |
818
|
|
|
|
|
|
|
$refNode; |
819
|
|
|
|
|
|
|
} |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
sub removeChild |
822
|
|
|
|
|
|
|
{ |
823
|
|
|
|
|
|
|
my ($self, $node) = @_; |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, |
826
|
|
|
|
|
|
|
"node is ReadOnly") |
827
|
|
|
|
|
|
|
if $self->isReadOnly; |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
my $index = $self->getChildIndex ($node); |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (NOT_FOUND_ERR, |
832
|
|
|
|
|
|
|
"reference node not found") |
833
|
|
|
|
|
|
|
if $index == -1; |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
splice (@{$self->[_C]}, $index, 1, ()); |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
$node->removeChildHoodMemories; |
838
|
|
|
|
|
|
|
$node; |
839
|
|
|
|
|
|
|
} |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
# Merge all subsequent Text nodes in this subtree |
842
|
|
|
|
|
|
|
sub normalize |
843
|
|
|
|
|
|
|
{ |
844
|
|
|
|
|
|
|
my ($self) = shift; |
845
|
|
|
|
|
|
|
my $prev = undef; # previous Text node |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
return unless defined $self->[_C]; |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
my @nodes = @{$self->[_C]}; |
850
|
|
|
|
|
|
|
my $i = 0; |
851
|
|
|
|
|
|
|
my $n = @nodes; |
852
|
|
|
|
|
|
|
while ($i < $n) |
853
|
|
|
|
|
|
|
{ |
854
|
|
|
|
|
|
|
my $node = $self->getChildAtIndex($i); |
855
|
|
|
|
|
|
|
my $type = $node->getNodeType; |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
if (defined $prev) |
858
|
|
|
|
|
|
|
{ |
859
|
|
|
|
|
|
|
# It should not merge CDATASections. Dom Spec says: |
860
|
|
|
|
|
|
|
# Adjacent CDATASections nodes are not merged by use |
861
|
|
|
|
|
|
|
# of the Element.normalize() method. |
862
|
|
|
|
|
|
|
if ($type == TEXT_NODE) |
863
|
|
|
|
|
|
|
{ |
864
|
|
|
|
|
|
|
$prev->appendData ($node->getData); |
865
|
|
|
|
|
|
|
$self->removeChild ($node); |
866
|
|
|
|
|
|
|
$i--; |
867
|
|
|
|
|
|
|
$n--; |
868
|
|
|
|
|
|
|
} |
869
|
|
|
|
|
|
|
else |
870
|
|
|
|
|
|
|
{ |
871
|
|
|
|
|
|
|
$prev = undef; |
872
|
|
|
|
|
|
|
if ($type == ELEMENT_NODE) |
873
|
|
|
|
|
|
|
{ |
874
|
|
|
|
|
|
|
$node->normalize; |
875
|
|
|
|
|
|
|
if (defined $node->[_A]) |
876
|
|
|
|
|
|
|
{ |
877
|
|
|
|
|
|
|
for my $attr (@{$node->[_A]->getValues}) |
878
|
|
|
|
|
|
|
{ |
879
|
|
|
|
|
|
|
$attr->normalize; |
880
|
|
|
|
|
|
|
} |
881
|
|
|
|
|
|
|
} |
882
|
|
|
|
|
|
|
} |
883
|
|
|
|
|
|
|
} |
884
|
|
|
|
|
|
|
} |
885
|
|
|
|
|
|
|
else |
886
|
|
|
|
|
|
|
{ |
887
|
|
|
|
|
|
|
if ($type == TEXT_NODE) |
888
|
|
|
|
|
|
|
{ |
889
|
|
|
|
|
|
|
$prev = $node; |
890
|
|
|
|
|
|
|
} |
891
|
|
|
|
|
|
|
elsif ($type == ELEMENT_NODE) |
892
|
|
|
|
|
|
|
{ |
893
|
|
|
|
|
|
|
$node->normalize; |
894
|
|
|
|
|
|
|
if (defined $node->[_A]) |
895
|
|
|
|
|
|
|
{ |
896
|
|
|
|
|
|
|
for my $attr (@{$node->[_A]->getValues}) |
897
|
|
|
|
|
|
|
{ |
898
|
|
|
|
|
|
|
$attr->normalize; |
899
|
|
|
|
|
|
|
} |
900
|
|
|
|
|
|
|
} |
901
|
|
|
|
|
|
|
} |
902
|
|
|
|
|
|
|
} |
903
|
|
|
|
|
|
|
$i++; |
904
|
|
|
|
|
|
|
} |
905
|
|
|
|
|
|
|
} |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
# |
908
|
|
|
|
|
|
|
# Return all Element nodes in the subtree that have the specified tagName. |
909
|
|
|
|
|
|
|
# If tagName is "*", all Element nodes are returned. |
910
|
|
|
|
|
|
|
# NOTE: the DOM Spec does not specify a 3rd or 4th parameter |
911
|
|
|
|
|
|
|
# |
912
|
|
|
|
|
|
|
sub getElementsByTagName |
913
|
|
|
|
|
|
|
{ |
914
|
|
|
|
|
|
|
my ($self, $tagName, $recurse, $list) = @_; |
915
|
|
|
|
|
|
|
$recurse = 1 unless defined $recurse; |
916
|
|
|
|
|
|
|
$list = (wantarray ? [] : new XML::DOM::NodeList) unless defined $list; |
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
return unless defined $self->[_C]; |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
# preorder traversal: check parent node first |
921
|
|
|
|
|
|
|
for my $kid (@{$self->[_C]}) |
922
|
|
|
|
|
|
|
{ |
923
|
|
|
|
|
|
|
if ($kid->isElementNode) |
924
|
|
|
|
|
|
|
{ |
925
|
|
|
|
|
|
|
if ($tagName eq "*" || $tagName eq $kid->getTagName) |
926
|
|
|
|
|
|
|
{ |
927
|
|
|
|
|
|
|
push @{$list}, $kid; |
928
|
|
|
|
|
|
|
} |
929
|
|
|
|
|
|
|
$kid->getElementsByTagName ($tagName, $recurse, $list) if $recurse; |
930
|
|
|
|
|
|
|
} |
931
|
|
|
|
|
|
|
} |
932
|
|
|
|
|
|
|
wantarray ? @{ $list } : $list; |
933
|
|
|
|
|
|
|
} |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
sub getNodeValue |
936
|
|
|
|
|
|
|
{ |
937
|
|
|
|
|
|
|
undef; |
938
|
|
|
|
|
|
|
} |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
sub setNodeValue |
941
|
|
|
|
|
|
|
{ |
942
|
|
|
|
|
|
|
# no-op |
943
|
|
|
|
|
|
|
} |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
# |
946
|
|
|
|
|
|
|
# Redefined by XML::DOM::Element |
947
|
|
|
|
|
|
|
# |
948
|
|
|
|
|
|
|
sub getAttributes |
949
|
|
|
|
|
|
|
{ |
950
|
|
|
|
|
|
|
undef; |
951
|
|
|
|
|
|
|
} |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
#------------------------------------------------------------ |
954
|
|
|
|
|
|
|
# Extra method implementations |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
sub setOwnerDocument |
957
|
|
|
|
|
|
|
{ |
958
|
|
|
|
|
|
|
my ($self, $doc) = @_; |
959
|
|
|
|
|
|
|
$self->[_Doc] = $doc; |
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
return unless defined $self->[_C]; |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
for my $kid (@{$self->[_C]}) |
964
|
|
|
|
|
|
|
{ |
965
|
|
|
|
|
|
|
$kid->setOwnerDocument ($doc); |
966
|
|
|
|
|
|
|
} |
967
|
|
|
|
|
|
|
} |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
sub cloneChildren |
970
|
|
|
|
|
|
|
{ |
971
|
|
|
|
|
|
|
my ($self, $node, $deep) = @_; |
972
|
|
|
|
|
|
|
return unless $deep; |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
return unless defined $self->[_C]; |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
local $XML::DOM::IgnoreReadOnly = 1; |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
for my $kid (@{$node->[_C]}) |
979
|
|
|
|
|
|
|
{ |
980
|
|
|
|
|
|
|
my $newNode = $kid->cloneNode ($deep); |
981
|
|
|
|
|
|
|
push @{$self->[_C]}, $newNode; |
982
|
|
|
|
|
|
|
$newNode->setParentNode ($self); |
983
|
|
|
|
|
|
|
} |
984
|
|
|
|
|
|
|
} |
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
# |
987
|
|
|
|
|
|
|
# For internal use only! |
988
|
|
|
|
|
|
|
# |
989
|
|
|
|
|
|
|
sub removeChildHoodMemories |
990
|
|
|
|
|
|
|
{ |
991
|
|
|
|
|
|
|
my ($self) = @_; |
992
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
undef $self->[_Parent]; # was delete |
994
|
|
|
|
|
|
|
} |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
# |
997
|
|
|
|
|
|
|
# Remove circular dependencies. The Node and its children should |
998
|
|
|
|
|
|
|
# not be used afterwards. |
999
|
|
|
|
|
|
|
# |
1000
|
|
|
|
|
|
|
sub dispose |
1001
|
|
|
|
|
|
|
{ |
1002
|
|
|
|
|
|
|
my $self = shift; |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
$self->removeChildHoodMemories; |
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
if (defined $self->[_C]) |
1007
|
|
|
|
|
|
|
{ |
1008
|
|
|
|
|
|
|
$self->[_C]->dispose; |
1009
|
|
|
|
|
|
|
undef $self->[_C]; # was delete |
1010
|
|
|
|
|
|
|
} |
1011
|
|
|
|
|
|
|
undef $self->[_Doc]; # was delete |
1012
|
|
|
|
|
|
|
} |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
# |
1015
|
|
|
|
|
|
|
# For internal use only! |
1016
|
|
|
|
|
|
|
# |
1017
|
|
|
|
|
|
|
sub setParentNode |
1018
|
|
|
|
|
|
|
{ |
1019
|
|
|
|
|
|
|
my ($self, $parent) = @_; |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
# REC 7473 |
1022
|
|
|
|
|
|
|
my $oldParent = $self->[_Parent]; |
1023
|
|
|
|
|
|
|
if (defined $oldParent) |
1024
|
|
|
|
|
|
|
{ |
1025
|
|
|
|
|
|
|
# remove from current parent |
1026
|
|
|
|
|
|
|
my $index = $oldParent->getChildIndex ($self); |
1027
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
# NOTE: we don't have to check if [_C] is defined, |
1029
|
|
|
|
|
|
|
# because were removing a child here! |
1030
|
|
|
|
|
|
|
splice (@{$oldParent->[_C]}, $index, 1, ()); |
1031
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
$self->removeChildHoodMemories; |
1033
|
|
|
|
|
|
|
} |
1034
|
|
|
|
|
|
|
$self->[_Parent] = $parent; |
1035
|
|
|
|
|
|
|
} |
1036
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
# |
1038
|
|
|
|
|
|
|
# This function can return 3 values: |
1039
|
|
|
|
|
|
|
# 1: always readOnly |
1040
|
|
|
|
|
|
|
# 0: never readOnly |
1041
|
|
|
|
|
|
|
# undef: depends on parent node |
1042
|
|
|
|
|
|
|
# |
1043
|
|
|
|
|
|
|
# Returns 1 for DocumentType, Notation, Entity, EntityReference, Attlist, |
1044
|
|
|
|
|
|
|
# ElementDecl, AttDef. |
1045
|
|
|
|
|
|
|
# The first 4 are readOnly according to the DOM Spec, the others are always |
1046
|
|
|
|
|
|
|
# children of DocumentType. (Naturally, children of a readOnly node have to be |
1047
|
|
|
|
|
|
|
# readOnly as well...) |
1048
|
|
|
|
|
|
|
# These nodes are always readOnly regardless of who their ancestors are. |
1049
|
|
|
|
|
|
|
# Other nodes, e.g. Comment, are readOnly only if their parent is readOnly, |
1050
|
|
|
|
|
|
|
# which basically means that one of its ancestors has to be one of the |
1051
|
|
|
|
|
|
|
# aforementioned node types. |
1052
|
|
|
|
|
|
|
# Document and DocumentFragment return 0 for obvious reasons. |
1053
|
|
|
|
|
|
|
# Attr, Element, CDATASection, Text return 0. The DOM spec says that they can |
1054
|
|
|
|
|
|
|
# be children of an Entity, but I don't think that that's possible |
1055
|
|
|
|
|
|
|
# with the current XML::Parser. |
1056
|
|
|
|
|
|
|
# Attr uses a {ReadOnly} property, which is only set if it's part of a AttDef. |
1057
|
|
|
|
|
|
|
# Always returns 0 if ignoreReadOnly is set. |
1058
|
|
|
|
|
|
|
# |
1059
|
|
|
|
|
|
|
sub isReadOnly |
1060
|
|
|
|
|
|
|
{ |
1061
|
|
|
|
|
|
|
# default implementation for Nodes that are always readOnly |
1062
|
|
|
|
|
|
|
! $XML::DOM::IgnoreReadOnly; |
1063
|
|
|
|
|
|
|
} |
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
sub rejectChild |
1066
|
|
|
|
|
|
|
{ |
1067
|
|
|
|
|
|
|
1; |
1068
|
|
|
|
|
|
|
} |
1069
|
|
|
|
|
|
|
|
1070
|
|
|
|
|
|
|
sub getNodeTypeName |
1071
|
|
|
|
|
|
|
{ |
1072
|
|
|
|
|
|
|
$NodeNames[$_[0]->getNodeType]; |
1073
|
|
|
|
|
|
|
} |
1074
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
sub getChildIndex |
1076
|
|
|
|
|
|
|
{ |
1077
|
|
|
|
|
|
|
my ($self, $node) = @_; |
1078
|
|
|
|
|
|
|
my $i = 0; |
1079
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
return -1 unless defined $self->[_C]; |
1081
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
for my $kid (@{$self->[_C]}) |
1083
|
|
|
|
|
|
|
{ |
1084
|
|
|
|
|
|
|
return $i if $kid == $node; |
1085
|
|
|
|
|
|
|
$i++; |
1086
|
|
|
|
|
|
|
} |
1087
|
|
|
|
|
|
|
-1; |
1088
|
|
|
|
|
|
|
} |
1089
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
sub getChildAtIndex |
1091
|
|
|
|
|
|
|
{ |
1092
|
|
|
|
|
|
|
my $kids = $_[0]->[_C]; |
1093
|
|
|
|
|
|
|
defined ($kids) ? $kids->[$_[1]] : undef; |
1094
|
|
|
|
|
|
|
} |
1095
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
sub isAncestor |
1097
|
|
|
|
|
|
|
{ |
1098
|
|
|
|
|
|
|
my ($self, $node) = @_; |
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
do |
1101
|
|
|
|
|
|
|
{ |
1102
|
|
|
|
|
|
|
return 1 if $self == $node; |
1103
|
|
|
|
|
|
|
$node = $node->[_Parent]; |
1104
|
|
|
|
|
|
|
} |
1105
|
|
|
|
|
|
|
while (defined $node); |
1106
|
|
|
|
|
|
|
|
1107
|
|
|
|
|
|
|
0; |
1108
|
|
|
|
|
|
|
} |
1109
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
# |
1111
|
|
|
|
|
|
|
# Added for optimization. Overriden in XML::DOM::Text |
1112
|
|
|
|
|
|
|
# |
1113
|
|
|
|
|
|
|
sub isTextNode |
1114
|
|
|
|
|
|
|
{ |
1115
|
|
|
|
|
|
|
0; |
1116
|
|
|
|
|
|
|
} |
1117
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
# |
1119
|
|
|
|
|
|
|
# Added for optimization. Overriden in XML::DOM::DocumentFragment |
1120
|
|
|
|
|
|
|
# |
1121
|
|
|
|
|
|
|
sub isDocumentFragmentNode |
1122
|
|
|
|
|
|
|
{ |
1123
|
|
|
|
|
|
|
0; |
1124
|
|
|
|
|
|
|
} |
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
# |
1127
|
|
|
|
|
|
|
# Added for optimization. Overriden in XML::DOM::Element |
1128
|
|
|
|
|
|
|
# |
1129
|
|
|
|
|
|
|
sub isElementNode |
1130
|
|
|
|
|
|
|
{ |
1131
|
|
|
|
|
|
|
0; |
1132
|
|
|
|
|
|
|
} |
1133
|
|
|
|
|
|
|
|
1134
|
|
|
|
|
|
|
# |
1135
|
|
|
|
|
|
|
# Add a Text node with the specified value or append the text to the |
1136
|
|
|
|
|
|
|
# previous Node if it is a Text node. |
1137
|
|
|
|
|
|
|
# |
1138
|
|
|
|
|
|
|
sub addText |
1139
|
|
|
|
|
|
|
{ |
1140
|
|
|
|
|
|
|
# REC 9456 (if it was called) |
1141
|
|
|
|
|
|
|
my ($self, $str) = @_; |
1142
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
my $node = ${$self->[_C]}[-1]; # $self->getLastChild |
1144
|
|
|
|
|
|
|
|
1145
|
|
|
|
|
|
|
if (defined ($node) && $node->isTextNode) |
1146
|
|
|
|
|
|
|
{ |
1147
|
|
|
|
|
|
|
# REC 5475 (if it was called) |
1148
|
|
|
|
|
|
|
$node->appendData ($str); |
1149
|
|
|
|
|
|
|
} |
1150
|
|
|
|
|
|
|
else |
1151
|
|
|
|
|
|
|
{ |
1152
|
|
|
|
|
|
|
$node = $self->[_Doc]->createTextNode ($str); |
1153
|
|
|
|
|
|
|
$self->appendChild ($node); |
1154
|
|
|
|
|
|
|
} |
1155
|
|
|
|
|
|
|
$node; |
1156
|
|
|
|
|
|
|
} |
1157
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
# |
1159
|
|
|
|
|
|
|
# Add a CDATASection node with the specified value or append the text to the |
1160
|
|
|
|
|
|
|
# previous Node if it is a CDATASection node. |
1161
|
|
|
|
|
|
|
# |
1162
|
|
|
|
|
|
|
sub addCDATA |
1163
|
|
|
|
|
|
|
{ |
1164
|
|
|
|
|
|
|
my ($self, $str) = @_; |
1165
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
my $node = ${$self->[_C]}[-1]; # $self->getLastChild |
1167
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
if (defined ($node) && $node->getNodeType == CDATA_SECTION_NODE) |
1169
|
|
|
|
|
|
|
{ |
1170
|
|
|
|
|
|
|
$node->appendData ($str); |
1171
|
|
|
|
|
|
|
} |
1172
|
|
|
|
|
|
|
else |
1173
|
|
|
|
|
|
|
{ |
1174
|
|
|
|
|
|
|
$node = $self->[_Doc]->createCDATASection ($str); |
1175
|
|
|
|
|
|
|
$self->appendChild ($node); |
1176
|
|
|
|
|
|
|
} |
1177
|
|
|
|
|
|
|
} |
1178
|
|
|
|
|
|
|
|
1179
|
|
|
|
|
|
|
sub removeChildNodes |
1180
|
|
|
|
|
|
|
{ |
1181
|
|
|
|
|
|
|
my $self = shift; |
1182
|
|
|
|
|
|
|
|
1183
|
|
|
|
|
|
|
my $cref = $self->[_C]; |
1184
|
|
|
|
|
|
|
return unless defined $cref; |
1185
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
my $kid; |
1187
|
|
|
|
|
|
|
while ($kid = pop @{$cref}) |
1188
|
|
|
|
|
|
|
{ |
1189
|
|
|
|
|
|
|
undef $kid->[_Parent]; # was delete |
1190
|
|
|
|
|
|
|
} |
1191
|
|
|
|
|
|
|
} |
1192
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
sub toString |
1194
|
|
|
|
|
|
|
{ |
1195
|
|
|
|
|
|
|
my $self = shift; |
1196
|
|
|
|
|
|
|
my $pr = $XML::DOM::PrintToString::Singleton; |
1197
|
|
|
|
|
|
|
$pr->reset; |
1198
|
|
|
|
|
|
|
$self->print ($pr); |
1199
|
|
|
|
|
|
|
$pr->toString; |
1200
|
|
|
|
|
|
|
} |
1201
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
sub to_sax |
1203
|
|
|
|
|
|
|
{ |
1204
|
|
|
|
|
|
|
my $self = shift; |
1205
|
|
|
|
|
|
|
unshift @_, 'Handler' if (@_ == 1); |
1206
|
|
|
|
|
|
|
my %h = @_; |
1207
|
|
|
|
|
|
|
|
1208
|
|
|
|
|
|
|
my $doch = exists ($h{DocumentHandler}) ? $h{DocumentHandler} |
1209
|
|
|
|
|
|
|
: $h{Handler}; |
1210
|
|
|
|
|
|
|
my $dtdh = exists ($h{DTDHandler}) ? $h{DTDHandler} |
1211
|
|
|
|
|
|
|
: $h{Handler}; |
1212
|
|
|
|
|
|
|
my $enth = exists ($h{EntityResolver}) ? $h{EntityResolver} |
1213
|
|
|
|
|
|
|
: $h{Handler}; |
1214
|
|
|
|
|
|
|
|
1215
|
|
|
|
|
|
|
$self->_to_sax ($doch, $dtdh, $enth); |
1216
|
|
|
|
|
|
|
} |
1217
|
|
|
|
|
|
|
|
1218
|
|
|
|
|
|
|
sub printToFile |
1219
|
|
|
|
|
|
|
{ |
1220
|
|
|
|
|
|
|
my ($self, $fileName) = @_; |
1221
|
|
|
|
|
|
|
my $encoding = $self->getXMLDecl()->getEncoding(); |
1222
|
|
|
|
|
|
|
my $fh = new FileHandle ($fileName, ">:encoding($encoding)") || |
1223
|
|
|
|
|
|
|
croak "printToFile - can't open output file $fileName"; |
1224
|
|
|
|
|
|
|
|
1225
|
|
|
|
|
|
|
$self->print ($fh); |
1226
|
|
|
|
|
|
|
$fh->close; |
1227
|
|
|
|
|
|
|
} |
1228
|
|
|
|
|
|
|
|
1229
|
|
|
|
|
|
|
# |
1230
|
|
|
|
|
|
|
# Use print to print to a FileHandle object (see printToFile code) |
1231
|
|
|
|
|
|
|
# |
1232
|
|
|
|
|
|
|
sub printToFileHandle |
1233
|
|
|
|
|
|
|
{ |
1234
|
|
|
|
|
|
|
my ($self, $FH) = @_; |
1235
|
|
|
|
|
|
|
my $pr = new XML::DOM::PrintToFileHandle ($FH); |
1236
|
|
|
|
|
|
|
$self->print ($pr); |
1237
|
|
|
|
|
|
|
} |
1238
|
|
|
|
|
|
|
|
1239
|
|
|
|
|
|
|
# |
1240
|
|
|
|
|
|
|
# Used by AttDef::setDefault to convert unexpanded default attribute value |
1241
|
|
|
|
|
|
|
# |
1242
|
|
|
|
|
|
|
sub expandEntityRefs |
1243
|
|
|
|
|
|
|
{ |
1244
|
|
|
|
|
|
|
my ($self, $str) = @_; |
1245
|
|
|
|
|
|
|
my $doctype = $self->[_Doc]->getDoctype; |
1246
|
|
|
|
|
|
|
|
1247
|
|
|
|
|
|
|
use bytes; # XML::RegExp expressed in terms encoded UTF8 |
1248
|
|
|
|
|
|
|
$str =~ s/&($XML::RegExp::Name|(#([0-9]+)|#x([0-9a-fA-F]+)));/ |
1249
|
|
|
|
|
|
|
defined($2) ? XML::DOM::XmlUtf8Encode ($3 || hex ($4)) |
1250
|
|
|
|
|
|
|
: expandEntityRef ($1, $doctype)/ego; |
1251
|
|
|
|
|
|
|
$str; |
1252
|
|
|
|
|
|
|
} |
1253
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
sub expandEntityRef |
1255
|
|
|
|
|
|
|
{ |
1256
|
|
|
|
|
|
|
my ($entity, $doctype) = @_; |
1257
|
|
|
|
|
|
|
|
1258
|
|
|
|
|
|
|
my $expanded = $XML::DOM::DefaultEntities{$entity}; |
1259
|
|
|
|
|
|
|
return $expanded if defined $expanded; |
1260
|
|
|
|
|
|
|
|
1261
|
|
|
|
|
|
|
$expanded = $doctype->getEntity ($entity); |
1262
|
|
|
|
|
|
|
return $expanded->getValue if (defined $expanded); |
1263
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
#?? is this an error? |
1265
|
|
|
|
|
|
|
croak "Could not expand entity reference of [$entity]\n"; |
1266
|
|
|
|
|
|
|
# return "&$entity;"; # entity not found |
1267
|
|
|
|
|
|
|
} |
1268
|
|
|
|
|
|
|
|
1269
|
|
|
|
|
|
|
sub isHidden |
1270
|
|
|
|
|
|
|
{ |
1271
|
|
|
|
|
|
|
$_[0]->[_Hidden]; |
1272
|
|
|
|
|
|
|
} |
1273
|
|
|
|
|
|
|
|
1274
|
|
|
|
|
|
|
###################################################################### |
1275
|
|
|
|
|
|
|
package XML::DOM::Attr; |
1276
|
|
|
|
|
|
|
###################################################################### |
1277
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; |
1279
|
|
|
|
|
|
|
|
1280
|
|
|
|
|
|
|
BEGIN |
1281
|
|
|
|
|
|
|
{ |
1282
|
|
|
|
|
|
|
import XML::DOM::Node qw( :DEFAULT :Fields ); |
1283
|
|
|
|
|
|
|
XML::DOM::def_fields ("Name Specified", "XML::DOM::Node"); |
1284
|
|
|
|
|
|
|
} |
1285
|
|
|
|
|
|
|
|
1286
|
|
|
|
|
|
|
use XML::DOM::DOMException; |
1287
|
|
|
|
|
|
|
use Carp; |
1288
|
|
|
|
|
|
|
|
1289
|
|
|
|
|
|
|
sub new |
1290
|
|
|
|
|
|
|
{ |
1291
|
|
|
|
|
|
|
my ($class, $doc, $name, $value, $specified) = @_; |
1292
|
|
|
|
|
|
|
|
1293
|
|
|
|
|
|
|
if ($XML::DOM::SafeMode) |
1294
|
|
|
|
|
|
|
{ |
1295
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, |
1296
|
|
|
|
|
|
|
"bad Attr name [$name]") |
1297
|
|
|
|
|
|
|
unless XML::DOM::isValidName ($name); |
1298
|
|
|
|
|
|
|
} |
1299
|
|
|
|
|
|
|
|
1300
|
|
|
|
|
|
|
my $self = bless [], $class; |
1301
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
$self->[_Doc] = $doc; |
1303
|
|
|
|
|
|
|
$self->[_C] = new XML::DOM::NodeList; |
1304
|
|
|
|
|
|
|
$self->[_Name] = $name; |
1305
|
|
|
|
|
|
|
|
1306
|
|
|
|
|
|
|
if (defined $value) |
1307
|
|
|
|
|
|
|
{ |
1308
|
|
|
|
|
|
|
$self->setValue ($value); |
1309
|
|
|
|
|
|
|
$self->[_Specified] = (defined $specified) ? $specified : 1; |
1310
|
|
|
|
|
|
|
} |
1311
|
|
|
|
|
|
|
else |
1312
|
|
|
|
|
|
|
{ |
1313
|
|
|
|
|
|
|
$self->[_Specified] = 0; |
1314
|
|
|
|
|
|
|
} |
1315
|
|
|
|
|
|
|
$self; |
1316
|
|
|
|
|
|
|
} |
1317
|
|
|
|
|
|
|
|
1318
|
|
|
|
|
|
|
sub getNodeType |
1319
|
|
|
|
|
|
|
{ |
1320
|
|
|
|
|
|
|
ATTRIBUTE_NODE; |
1321
|
|
|
|
|
|
|
} |
1322
|
|
|
|
|
|
|
|
1323
|
|
|
|
|
|
|
sub isSpecified |
1324
|
|
|
|
|
|
|
{ |
1325
|
|
|
|
|
|
|
$_[0]->[_Specified]; |
1326
|
|
|
|
|
|
|
} |
1327
|
|
|
|
|
|
|
|
1328
|
|
|
|
|
|
|
sub getName |
1329
|
|
|
|
|
|
|
{ |
1330
|
|
|
|
|
|
|
$_[0]->[_Name]; |
1331
|
|
|
|
|
|
|
} |
1332
|
|
|
|
|
|
|
|
1333
|
|
|
|
|
|
|
sub getValue |
1334
|
|
|
|
|
|
|
{ |
1335
|
|
|
|
|
|
|
my $self = shift; |
1336
|
|
|
|
|
|
|
my $value = ""; |
1337
|
|
|
|
|
|
|
|
1338
|
|
|
|
|
|
|
for my $kid (@{$self->[_C]}) |
1339
|
|
|
|
|
|
|
{ |
1340
|
|
|
|
|
|
|
$value .= $kid->getData if defined $kid->getData; |
1341
|
|
|
|
|
|
|
} |
1342
|
|
|
|
|
|
|
$value; |
1343
|
|
|
|
|
|
|
} |
1344
|
|
|
|
|
|
|
|
1345
|
|
|
|
|
|
|
sub setValue |
1346
|
|
|
|
|
|
|
{ |
1347
|
|
|
|
|
|
|
my ($self, $value) = @_; |
1348
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
# REC 1147 |
1350
|
|
|
|
|
|
|
$self->removeChildNodes; |
1351
|
|
|
|
|
|
|
$self->appendChild ($self->[_Doc]->createTextNode ($value)); |
1352
|
|
|
|
|
|
|
$self->[_Specified] = 1; |
1353
|
|
|
|
|
|
|
} |
1354
|
|
|
|
|
|
|
|
1355
|
|
|
|
|
|
|
sub getNodeName |
1356
|
|
|
|
|
|
|
{ |
1357
|
|
|
|
|
|
|
$_[0]->getName; |
1358
|
|
|
|
|
|
|
} |
1359
|
|
|
|
|
|
|
|
1360
|
|
|
|
|
|
|
sub getNodeValue |
1361
|
|
|
|
|
|
|
{ |
1362
|
|
|
|
|
|
|
$_[0]->getValue; |
1363
|
|
|
|
|
|
|
} |
1364
|
|
|
|
|
|
|
|
1365
|
|
|
|
|
|
|
sub setNodeValue |
1366
|
|
|
|
|
|
|
{ |
1367
|
|
|
|
|
|
|
$_[0]->setValue ($_[1]); |
1368
|
|
|
|
|
|
|
} |
1369
|
|
|
|
|
|
|
|
1370
|
|
|
|
|
|
|
sub cloneNode |
1371
|
|
|
|
|
|
|
{ |
1372
|
|
|
|
|
|
|
my ($self) = @_; # parameter deep is ignored |
1373
|
|
|
|
|
|
|
|
1374
|
|
|
|
|
|
|
my $node = $self->[_Doc]->createAttribute ($self->getName); |
1375
|
|
|
|
|
|
|
$node->[_Specified] = $self->[_Specified]; |
1376
|
|
|
|
|
|
|
$node->[_ReadOnly] = 1 if $self->[_ReadOnly]; |
1377
|
|
|
|
|
|
|
|
1378
|
|
|
|
|
|
|
$node->cloneChildren ($self, 1); |
1379
|
|
|
|
|
|
|
$node; |
1380
|
|
|
|
|
|
|
} |
1381
|
|
|
|
|
|
|
|
1382
|
|
|
|
|
|
|
#------------------------------------------------------------ |
1383
|
|
|
|
|
|
|
# Extra method implementations |
1384
|
|
|
|
|
|
|
# |
1385
|
|
|
|
|
|
|
|
1386
|
|
|
|
|
|
|
sub isReadOnly |
1387
|
|
|
|
|
|
|
{ |
1388
|
|
|
|
|
|
|
# ReadOnly property is set if it's part of a AttDef |
1389
|
|
|
|
|
|
|
! $XML::DOM::IgnoreReadOnly && defined ($_[0]->[_ReadOnly]); |
1390
|
|
|
|
|
|
|
} |
1391
|
|
|
|
|
|
|
|
1392
|
|
|
|
|
|
|
sub print |
1393
|
|
|
|
|
|
|
{ |
1394
|
|
|
|
|
|
|
my ($self, $FILE) = @_; |
1395
|
|
|
|
|
|
|
|
1396
|
|
|
|
|
|
|
my $name = $self->[_Name]; |
1397
|
|
|
|
|
|
|
|
1398
|
|
|
|
|
|
|
$FILE->print ("$name=\""); |
1399
|
|
|
|
|
|
|
for my $kid (@{$self->[_C]}) |
1400
|
|
|
|
|
|
|
{ |
1401
|
|
|
|
|
|
|
if ($kid->getNodeType == TEXT_NODE) |
1402
|
|
|
|
|
|
|
{ |
1403
|
|
|
|
|
|
|
$FILE->print (XML::DOM::encodeAttrValue ($kid->getData)); |
1404
|
|
|
|
|
|
|
} |
1405
|
|
|
|
|
|
|
else # ENTITY_REFERENCE_NODE |
1406
|
|
|
|
|
|
|
{ |
1407
|
|
|
|
|
|
|
$kid->print ($FILE); |
1408
|
|
|
|
|
|
|
} |
1409
|
|
|
|
|
|
|
} |
1410
|
|
|
|
|
|
|
$FILE->print ("\""); |
1411
|
|
|
|
|
|
|
} |
1412
|
|
|
|
|
|
|
|
1413
|
|
|
|
|
|
|
sub rejectChild |
1414
|
|
|
|
|
|
|
{ |
1415
|
|
|
|
|
|
|
my $t = $_[1]->getNodeType; |
1416
|
|
|
|
|
|
|
|
1417
|
|
|
|
|
|
|
$t != TEXT_NODE |
1418
|
|
|
|
|
|
|
&& $t != ENTITY_REFERENCE_NODE; |
1419
|
|
|
|
|
|
|
} |
1420
|
|
|
|
|
|
|
|
1421
|
|
|
|
|
|
|
###################################################################### |
1422
|
|
|
|
|
|
|
package XML::DOM::ProcessingInstruction; |
1423
|
|
|
|
|
|
|
###################################################################### |
1424
|
|
|
|
|
|
|
|
1425
|
|
|
|
|
|
|
use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; |
1426
|
|
|
|
|
|
|
BEGIN |
1427
|
|
|
|
|
|
|
{ |
1428
|
|
|
|
|
|
|
import XML::DOM::Node qw( :DEFAULT :Fields ); |
1429
|
|
|
|
|
|
|
XML::DOM::def_fields ("Target Data", "XML::DOM::Node"); |
1430
|
|
|
|
|
|
|
} |
1431
|
|
|
|
|
|
|
|
1432
|
|
|
|
|
|
|
use XML::DOM::DOMException; |
1433
|
|
|
|
|
|
|
use Carp; |
1434
|
|
|
|
|
|
|
|
1435
|
|
|
|
|
|
|
sub new |
1436
|
|
|
|
|
|
|
{ |
1437
|
|
|
|
|
|
|
my ($class, $doc, $target, $data, $hidden) = @_; |
1438
|
|
|
|
|
|
|
|
1439
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, |
1440
|
|
|
|
|
|
|
"bad ProcessingInstruction Target [$target]") |
1441
|
|
|
|
|
|
|
unless (XML::DOM::isValidName ($target) && $target !~ /^xml$/io); |
1442
|
|
|
|
|
|
|
|
1443
|
|
|
|
|
|
|
my $self = bless [], $class; |
1444
|
|
|
|
|
|
|
|
1445
|
|
|
|
|
|
|
$self->[_Doc] = $doc; |
1446
|
|
|
|
|
|
|
$self->[_Target] = $target; |
1447
|
|
|
|
|
|
|
$self->[_Data] = $data; |
1448
|
|
|
|
|
|
|
$self->[_Hidden] = $hidden; |
1449
|
|
|
|
|
|
|
$self; |
1450
|
|
|
|
|
|
|
} |
1451
|
|
|
|
|
|
|
|
1452
|
|
|
|
|
|
|
sub getNodeType |
1453
|
|
|
|
|
|
|
{ |
1454
|
|
|
|
|
|
|
PROCESSING_INSTRUCTION_NODE; |
1455
|
|
|
|
|
|
|
} |
1456
|
|
|
|
|
|
|
|
1457
|
|
|
|
|
|
|
sub getTarget |
1458
|
|
|
|
|
|
|
{ |
1459
|
|
|
|
|
|
|
$_[0]->[_Target]; |
1460
|
|
|
|
|
|
|
} |
1461
|
|
|
|
|
|
|
|
1462
|
|
|
|
|
|
|
sub getData |
1463
|
|
|
|
|
|
|
{ |
1464
|
|
|
|
|
|
|
$_[0]->[_Data]; |
1465
|
|
|
|
|
|
|
} |
1466
|
|
|
|
|
|
|
|
1467
|
|
|
|
|
|
|
sub setData |
1468
|
|
|
|
|
|
|
{ |
1469
|
|
|
|
|
|
|
my ($self, $data) = @_; |
1470
|
|
|
|
|
|
|
|
1471
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, |
1472
|
|
|
|
|
|
|
"node is ReadOnly") |
1473
|
|
|
|
|
|
|
if $self->isReadOnly; |
1474
|
|
|
|
|
|
|
|
1475
|
|
|
|
|
|
|
$self->[_Data] = $data; |
1476
|
|
|
|
|
|
|
} |
1477
|
|
|
|
|
|
|
|
1478
|
|
|
|
|
|
|
sub getNodeName |
1479
|
|
|
|
|
|
|
{ |
1480
|
|
|
|
|
|
|
$_[0]->[_Target]; |
1481
|
|
|
|
|
|
|
} |
1482
|
|
|
|
|
|
|
|
1483
|
|
|
|
|
|
|
# |
1484
|
|
|
|
|
|
|
# Same as getData |
1485
|
|
|
|
|
|
|
# |
1486
|
|
|
|
|
|
|
sub getNodeValue |
1487
|
|
|
|
|
|
|
{ |
1488
|
|
|
|
|
|
|
$_[0]->[_Data]; |
1489
|
|
|
|
|
|
|
} |
1490
|
|
|
|
|
|
|
|
1491
|
|
|
|
|
|
|
sub setNodeValue |
1492
|
|
|
|
|
|
|
{ |
1493
|
|
|
|
|
|
|
$_[0]->setData ($_[1]); |
1494
|
|
|
|
|
|
|
} |
1495
|
|
|
|
|
|
|
|
1496
|
|
|
|
|
|
|
sub cloneNode |
1497
|
|
|
|
|
|
|
{ |
1498
|
|
|
|
|
|
|
my $self = shift; |
1499
|
|
|
|
|
|
|
$self->[_Doc]->createProcessingInstruction ($self->getTarget, |
1500
|
|
|
|
|
|
|
$self->getData, |
1501
|
|
|
|
|
|
|
$self->isHidden); |
1502
|
|
|
|
|
|
|
} |
1503
|
|
|
|
|
|
|
|
1504
|
|
|
|
|
|
|
#------------------------------------------------------------ |
1505
|
|
|
|
|
|
|
# Extra method implementations |
1506
|
|
|
|
|
|
|
|
1507
|
|
|
|
|
|
|
sub isReadOnly |
1508
|
|
|
|
|
|
|
{ |
1509
|
|
|
|
|
|
|
return 0 if $XML::DOM::IgnoreReadOnly; |
1510
|
|
|
|
|
|
|
|
1511
|
|
|
|
|
|
|
my $pa = $_[0]->[_Parent]; |
1512
|
|
|
|
|
|
|
defined ($pa) ? $pa->isReadOnly : 0; |
1513
|
|
|
|
|
|
|
} |
1514
|
|
|
|
|
|
|
|
1515
|
|
|
|
|
|
|
sub print |
1516
|
|
|
|
|
|
|
{ |
1517
|
|
|
|
|
|
|
my ($self, $FILE) = @_; |
1518
|
|
|
|
|
|
|
|
1519
|
|
|
|
|
|
|
$FILE->print (""); |
1520
|
|
|
|
|
|
|
$FILE->print ($self->[_Target]); |
1521
|
|
|
|
|
|
|
$FILE->print (" "); |
1522
|
|
|
|
|
|
|
$FILE->print (XML::DOM::encodeProcessingInstruction ($self->[_Data])); |
1523
|
|
|
|
|
|
|
$FILE->print ("?>"); |
1524
|
|
|
|
|
|
|
} |
1525
|
|
|
|
|
|
|
|
1526
|
|
|
|
|
|
|
sub _to_sax { |
1527
|
|
|
|
|
|
|
my ($self, $doch) = @_; |
1528
|
|
|
|
|
|
|
$doch->processing_instruction({Target => $self->getTarget, Data => $self->getData}); |
1529
|
|
|
|
|
|
|
} |
1530
|
|
|
|
|
|
|
|
1531
|
|
|
|
|
|
|
###################################################################### |
1532
|
|
|
|
|
|
|
package XML::DOM::Notation; |
1533
|
|
|
|
|
|
|
###################################################################### |
1534
|
|
|
|
|
|
|
use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; |
1535
|
|
|
|
|
|
|
|
1536
|
|
|
|
|
|
|
BEGIN |
1537
|
|
|
|
|
|
|
{ |
1538
|
|
|
|
|
|
|
import XML::DOM::Node qw( :DEFAULT :Fields ); |
1539
|
|
|
|
|
|
|
XML::DOM::def_fields ("Name Base SysId PubId", "XML::DOM::Node"); |
1540
|
|
|
|
|
|
|
} |
1541
|
|
|
|
|
|
|
|
1542
|
|
|
|
|
|
|
use XML::DOM::DOMException; |
1543
|
|
|
|
|
|
|
use Carp; |
1544
|
|
|
|
|
|
|
|
1545
|
|
|
|
|
|
|
sub new |
1546
|
|
|
|
|
|
|
{ |
1547
|
|
|
|
|
|
|
my ($class, $doc, $name, $base, $sysId, $pubId, $hidden) = @_; |
1548
|
|
|
|
|
|
|
|
1549
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, |
1550
|
|
|
|
|
|
|
"bad Notation Name [$name]") |
1551
|
|
|
|
|
|
|
unless XML::DOM::isValidName ($name); |
1552
|
|
|
|
|
|
|
|
1553
|
|
|
|
|
|
|
my $self = bless [], $class; |
1554
|
|
|
|
|
|
|
|
1555
|
|
|
|
|
|
|
$self->[_Doc] = $doc; |
1556
|
|
|
|
|
|
|
$self->[_Name] = $name; |
1557
|
|
|
|
|
|
|
$self->[_Base] = $base; |
1558
|
|
|
|
|
|
|
$self->[_SysId] = $sysId; |
1559
|
|
|
|
|
|
|
$self->[_PubId] = $pubId; |
1560
|
|
|
|
|
|
|
$self->[_Hidden] = $hidden; |
1561
|
|
|
|
|
|
|
$self; |
1562
|
|
|
|
|
|
|
} |
1563
|
|
|
|
|
|
|
|
1564
|
|
|
|
|
|
|
sub getNodeType |
1565
|
|
|
|
|
|
|
{ |
1566
|
|
|
|
|
|
|
NOTATION_NODE; |
1567
|
|
|
|
|
|
|
} |
1568
|
|
|
|
|
|
|
|
1569
|
|
|
|
|
|
|
sub getPubId |
1570
|
|
|
|
|
|
|
{ |
1571
|
|
|
|
|
|
|
$_[0]->[_PubId]; |
1572
|
|
|
|
|
|
|
} |
1573
|
|
|
|
|
|
|
|
1574
|
|
|
|
|
|
|
sub setPubId |
1575
|
|
|
|
|
|
|
{ |
1576
|
|
|
|
|
|
|
$_[0]->[_PubId] = $_[1]; |
1577
|
|
|
|
|
|
|
} |
1578
|
|
|
|
|
|
|
|
1579
|
|
|
|
|
|
|
sub getSysId |
1580
|
|
|
|
|
|
|
{ |
1581
|
|
|
|
|
|
|
$_[0]->[_SysId]; |
1582
|
|
|
|
|
|
|
} |
1583
|
|
|
|
|
|
|
|
1584
|
|
|
|
|
|
|
sub setSysId |
1585
|
|
|
|
|
|
|
{ |
1586
|
|
|
|
|
|
|
$_[0]->[_SysId] = $_[1]; |
1587
|
|
|
|
|
|
|
} |
1588
|
|
|
|
|
|
|
|
1589
|
|
|
|
|
|
|
sub getName |
1590
|
|
|
|
|
|
|
{ |
1591
|
|
|
|
|
|
|
$_[0]->[_Name]; |
1592
|
|
|
|
|
|
|
} |
1593
|
|
|
|
|
|
|
|
1594
|
|
|
|
|
|
|
sub setName |
1595
|
|
|
|
|
|
|
{ |
1596
|
|
|
|
|
|
|
$_[0]->[_Name] = $_[1]; |
1597
|
|
|
|
|
|
|
} |
1598
|
|
|
|
|
|
|
|
1599
|
|
|
|
|
|
|
sub getBase |
1600
|
|
|
|
|
|
|
{ |
1601
|
|
|
|
|
|
|
$_[0]->[_Base]; |
1602
|
|
|
|
|
|
|
} |
1603
|
|
|
|
|
|
|
|
1604
|
|
|
|
|
|
|
sub getNodeName |
1605
|
|
|
|
|
|
|
{ |
1606
|
|
|
|
|
|
|
$_[0]->[_Name]; |
1607
|
|
|
|
|
|
|
} |
1608
|
|
|
|
|
|
|
|
1609
|
|
|
|
|
|
|
sub print |
1610
|
|
|
|
|
|
|
{ |
1611
|
|
|
|
|
|
|
my ($self, $FILE) = @_; |
1612
|
|
|
|
|
|
|
|
1613
|
|
|
|
|
|
|
my $name = $self->[_Name]; |
1614
|
|
|
|
|
|
|
my $sysId = $self->[_SysId]; |
1615
|
|
|
|
|
|
|
my $pubId = $self->[_PubId]; |
1616
|
|
|
|
|
|
|
|
1617
|
|
|
|
|
|
|
$FILE->print ("
|
1618
|
|
|
|
|
|
|
|
1619
|
|
|
|
|
|
|
if (defined $pubId) |
1620
|
|
|
|
|
|
|
{ |
1621
|
|
|
|
|
|
|
$FILE->print (" PUBLIC \"$pubId\""); |
1622
|
|
|
|
|
|
|
} |
1623
|
|
|
|
|
|
|
if (defined $sysId) |
1624
|
|
|
|
|
|
|
{ |
1625
|
|
|
|
|
|
|
$FILE->print (" SYSTEM \"$sysId\""); |
1626
|
|
|
|
|
|
|
} |
1627
|
|
|
|
|
|
|
$FILE->print (">"); |
1628
|
|
|
|
|
|
|
} |
1629
|
|
|
|
|
|
|
|
1630
|
|
|
|
|
|
|
sub cloneNode |
1631
|
|
|
|
|
|
|
{ |
1632
|
|
|
|
|
|
|
my ($self) = @_; |
1633
|
|
|
|
|
|
|
$self->[_Doc]->createNotation ($self->[_Name], $self->[_Base], |
1634
|
|
|
|
|
|
|
$self->[_SysId], $self->[_PubId], |
1635
|
|
|
|
|
|
|
$self->[_Hidden]); |
1636
|
|
|
|
|
|
|
} |
1637
|
|
|
|
|
|
|
|
1638
|
|
|
|
|
|
|
sub to_expat |
1639
|
|
|
|
|
|
|
{ |
1640
|
|
|
|
|
|
|
my ($self, $iter) = @_; |
1641
|
|
|
|
|
|
|
$iter->Notation ($self->getName, $self->getBase, |
1642
|
|
|
|
|
|
|
$self->getSysId, $self->getPubId); |
1643
|
|
|
|
|
|
|
} |
1644
|
|
|
|
|
|
|
|
1645
|
|
|
|
|
|
|
sub _to_sax |
1646
|
|
|
|
|
|
|
{ |
1647
|
|
|
|
|
|
|
my ($self, $doch, $dtdh, $enth) = @_; |
1648
|
|
|
|
|
|
|
$dtdh->notation_decl ( { Name => $self->getName, |
1649
|
|
|
|
|
|
|
Base => $self->getBase, |
1650
|
|
|
|
|
|
|
SystemId => $self->getSysId, |
1651
|
|
|
|
|
|
|
PublicId => $self->getPubId }); |
1652
|
|
|
|
|
|
|
} |
1653
|
|
|
|
|
|
|
|
1654
|
|
|
|
|
|
|
###################################################################### |
1655
|
|
|
|
|
|
|
package XML::DOM::Entity; |
1656
|
|
|
|
|
|
|
###################################################################### |
1657
|
|
|
|
|
|
|
use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; |
1658
|
|
|
|
|
|
|
|
1659
|
|
|
|
|
|
|
BEGIN |
1660
|
|
|
|
|
|
|
{ |
1661
|
|
|
|
|
|
|
import XML::DOM::Node qw( :DEFAULT :Fields ); |
1662
|
|
|
|
|
|
|
XML::DOM::def_fields ("NotationName Parameter Value Ndata SysId PubId", "XML::DOM::Node"); |
1663
|
|
|
|
|
|
|
} |
1664
|
|
|
|
|
|
|
|
1665
|
|
|
|
|
|
|
use XML::DOM::DOMException; |
1666
|
|
|
|
|
|
|
use Carp; |
1667
|
|
|
|
|
|
|
|
1668
|
|
|
|
|
|
|
sub new |
1669
|
|
|
|
|
|
|
{ |
1670
|
|
|
|
|
|
|
my ($class, $doc, $notationName, $value, $sysId, $pubId, $ndata, $isParam, $hidden) = @_; |
1671
|
|
|
|
|
|
|
|
1672
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, |
1673
|
|
|
|
|
|
|
"bad Entity Name [$notationName]") |
1674
|
|
|
|
|
|
|
unless XML::DOM::isValidName ($notationName); |
1675
|
|
|
|
|
|
|
|
1676
|
|
|
|
|
|
|
my $self = bless [], $class; |
1677
|
|
|
|
|
|
|
|
1678
|
|
|
|
|
|
|
$self->[_Doc] = $doc; |
1679
|
|
|
|
|
|
|
$self->[_NotationName] = $notationName; |
1680
|
|
|
|
|
|
|
$self->[_Parameter] = $isParam; |
1681
|
|
|
|
|
|
|
$self->[_Value] = $value; |
1682
|
|
|
|
|
|
|
$self->[_Ndata] = $ndata; |
1683
|
|
|
|
|
|
|
$self->[_SysId] = $sysId; |
1684
|
|
|
|
|
|
|
$self->[_PubId] = $pubId; |
1685
|
|
|
|
|
|
|
$self->[_Hidden] = $hidden; |
1686
|
|
|
|
|
|
|
$self; |
1687
|
|
|
|
|
|
|
#?? maybe Value should be a Text node |
1688
|
|
|
|
|
|
|
} |
1689
|
|
|
|
|
|
|
|
1690
|
|
|
|
|
|
|
sub getNodeType |
1691
|
|
|
|
|
|
|
{ |
1692
|
|
|
|
|
|
|
ENTITY_NODE; |
1693
|
|
|
|
|
|
|
} |
1694
|
|
|
|
|
|
|
|
1695
|
|
|
|
|
|
|
sub getPubId |
1696
|
|
|
|
|
|
|
{ |
1697
|
|
|
|
|
|
|
$_[0]->[_PubId]; |
1698
|
|
|
|
|
|
|
} |
1699
|
|
|
|
|
|
|
|
1700
|
|
|
|
|
|
|
sub getSysId |
1701
|
|
|
|
|
|
|
{ |
1702
|
|
|
|
|
|
|
$_[0]->[_SysId]; |
1703
|
|
|
|
|
|
|
} |
1704
|
|
|
|
|
|
|
|
1705
|
|
|
|
|
|
|
# Dom Spec says: |
1706
|
|
|
|
|
|
|
# For unparsed entities, the name of the notation for the |
1707
|
|
|
|
|
|
|
# entity. For parsed entities, this is null. |
1708
|
|
|
|
|
|
|
|
1709
|
|
|
|
|
|
|
#?? do we have unparsed entities? |
1710
|
|
|
|
|
|
|
sub getNotationName |
1711
|
|
|
|
|
|
|
{ |
1712
|
|
|
|
|
|
|
$_[0]->[_NotationName]; |
1713
|
|
|
|
|
|
|
} |
1714
|
|
|
|
|
|
|
|
1715
|
|
|
|
|
|
|
sub getNodeName |
1716
|
|
|
|
|
|
|
{ |
1717
|
|
|
|
|
|
|
$_[0]->[_NotationName]; |
1718
|
|
|
|
|
|
|
} |
1719
|
|
|
|
|
|
|
|
1720
|
|
|
|
|
|
|
sub cloneNode |
1721
|
|
|
|
|
|
|
{ |
1722
|
|
|
|
|
|
|
my $self = shift; |
1723
|
|
|
|
|
|
|
$self->[_Doc]->createEntity ($self->[_NotationName], $self->[_Value], |
1724
|
|
|
|
|
|
|
$self->[_SysId], $self->[_PubId], |
1725
|
|
|
|
|
|
|
$self->[_Ndata], $self->[_Parameter], $self->[_Hidden]); |
1726
|
|
|
|
|
|
|
} |
1727
|
|
|
|
|
|
|
|
1728
|
|
|
|
|
|
|
sub rejectChild |
1729
|
|
|
|
|
|
|
{ |
1730
|
|
|
|
|
|
|
return 1; |
1731
|
|
|
|
|
|
|
#?? if value is split over subnodes, recode this section |
1732
|
|
|
|
|
|
|
# also add: C => new XML::DOM::NodeList, |
1733
|
|
|
|
|
|
|
|
1734
|
|
|
|
|
|
|
my $t = $_[1]; |
1735
|
|
|
|
|
|
|
|
1736
|
|
|
|
|
|
|
return $t == TEXT_NODE |
1737
|
|
|
|
|
|
|
|| $t == ENTITY_REFERENCE_NODE |
1738
|
|
|
|
|
|
|
|| $t == PROCESSING_INSTRUCTION_NODE |
1739
|
|
|
|
|
|
|
|| $t == COMMENT_NODE |
1740
|
|
|
|
|
|
|
|| $t == CDATA_SECTION_NODE |
1741
|
|
|
|
|
|
|
|| $t == ELEMENT_NODE; |
1742
|
|
|
|
|
|
|
} |
1743
|
|
|
|
|
|
|
|
1744
|
|
|
|
|
|
|
sub getValue |
1745
|
|
|
|
|
|
|
{ |
1746
|
|
|
|
|
|
|
$_[0]->[_Value]; |
1747
|
|
|
|
|
|
|
} |
1748
|
|
|
|
|
|
|
|
1749
|
|
|
|
|
|
|
sub isParameterEntity |
1750
|
|
|
|
|
|
|
{ |
1751
|
|
|
|
|
|
|
$_[0]->[_Parameter]; |
1752
|
|
|
|
|
|
|
} |
1753
|
|
|
|
|
|
|
|
1754
|
|
|
|
|
|
|
sub getNdata |
1755
|
|
|
|
|
|
|
{ |
1756
|
|
|
|
|
|
|
$_[0]->[_Ndata]; |
1757
|
|
|
|
|
|
|
} |
1758
|
|
|
|
|
|
|
|
1759
|
|
|
|
|
|
|
sub print |
1760
|
|
|
|
|
|
|
{ |
1761
|
|
|
|
|
|
|
my ($self, $FILE) = @_; |
1762
|
|
|
|
|
|
|
|
1763
|
|
|
|
|
|
|
my $name = $self->[_NotationName]; |
1764
|
|
|
|
|
|
|
|
1765
|
|
|
|
|
|
|
my $par = $self->isParameterEntity ? "% " : ""; |
1766
|
|
|
|
|
|
|
|
1767
|
|
|
|
|
|
|
$FILE->print ("
|
1768
|
|
|
|
|
|
|
|
1769
|
|
|
|
|
|
|
my $value = $self->[_Value]; |
1770
|
|
|
|
|
|
|
my $sysId = $self->[_SysId]; |
1771
|
|
|
|
|
|
|
my $pubId = $self->[_PubId]; |
1772
|
|
|
|
|
|
|
my $ndata = $self->[_Ndata]; |
1773
|
|
|
|
|
|
|
|
1774
|
|
|
|
|
|
|
if (defined $value) |
1775
|
|
|
|
|
|
|
{ |
1776
|
|
|
|
|
|
|
#?? Not sure what to do if it contains both single and double quote |
1777
|
|
|
|
|
|
|
$value = ($value =~ /\"/) ? "'$value'" : "\"$value\""; |
1778
|
|
|
|
|
|
|
$FILE->print (" $value"); |
1779
|
|
|
|
|
|
|
} |
1780
|
|
|
|
|
|
|
if (defined $pubId) |
1781
|
|
|
|
|
|
|
{ |
1782
|
|
|
|
|
|
|
$FILE->print (" PUBLIC \"$pubId\""); |
1783
|
|
|
|
|
|
|
} |
1784
|
|
|
|
|
|
|
elsif (defined $sysId) |
1785
|
|
|
|
|
|
|
{ |
1786
|
|
|
|
|
|
|
$FILE->print (" SYSTEM"); |
1787
|
|
|
|
|
|
|
} |
1788
|
|
|
|
|
|
|
|
1789
|
|
|
|
|
|
|
if (defined $sysId) |
1790
|
|
|
|
|
|
|
{ |
1791
|
|
|
|
|
|
|
$FILE->print (" \"$sysId\""); |
1792
|
|
|
|
|
|
|
} |
1793
|
|
|
|
|
|
|
$FILE->print (" NDATA $ndata") if defined $ndata; |
1794
|
|
|
|
|
|
|
$FILE->print (">"); |
1795
|
|
|
|
|
|
|
} |
1796
|
|
|
|
|
|
|
|
1797
|
|
|
|
|
|
|
sub to_expat |
1798
|
|
|
|
|
|
|
{ |
1799
|
|
|
|
|
|
|
my ($self, $iter) = @_; |
1800
|
|
|
|
|
|
|
my $name = ($self->isParameterEntity ? '%' : "") . $self->getNotationName; |
1801
|
|
|
|
|
|
|
$iter->Entity ($name, |
1802
|
|
|
|
|
|
|
$self->getValue, $self->getSysId, $self->getPubId, |
1803
|
|
|
|
|
|
|
$self->getNdata); |
1804
|
|
|
|
|
|
|
} |
1805
|
|
|
|
|
|
|
|
1806
|
|
|
|
|
|
|
sub _to_sax |
1807
|
|
|
|
|
|
|
{ |
1808
|
|
|
|
|
|
|
my ($self, $doch, $dtdh, $enth) = @_; |
1809
|
|
|
|
|
|
|
my $name = ($self->isParameterEntity ? '%' : "") . $self->getNotationName; |
1810
|
|
|
|
|
|
|
$dtdh->entity_decl ( { Name => $name, |
1811
|
|
|
|
|
|
|
Value => $self->getValue, |
1812
|
|
|
|
|
|
|
SystemId => $self->getSysId, |
1813
|
|
|
|
|
|
|
PublicId => $self->getPubId, |
1814
|
|
|
|
|
|
|
Notation => $self->getNdata } ); |
1815
|
|
|
|
|
|
|
} |
1816
|
|
|
|
|
|
|
|
1817
|
|
|
|
|
|
|
###################################################################### |
1818
|
|
|
|
|
|
|
package XML::DOM::EntityReference; |
1819
|
|
|
|
|
|
|
###################################################################### |
1820
|
|
|
|
|
|
|
use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; |
1821
|
|
|
|
|
|
|
|
1822
|
|
|
|
|
|
|
BEGIN |
1823
|
|
|
|
|
|
|
{ |
1824
|
|
|
|
|
|
|
import XML::DOM::Node qw( :DEFAULT :Fields ); |
1825
|
|
|
|
|
|
|
XML::DOM::def_fields ("EntityName Parameter NoExpand", "XML::DOM::Node"); |
1826
|
|
|
|
|
|
|
} |
1827
|
|
|
|
|
|
|
|
1828
|
|
|
|
|
|
|
use XML::DOM::DOMException; |
1829
|
|
|
|
|
|
|
use Carp; |
1830
|
|
|
|
|
|
|
|
1831
|
|
|
|
|
|
|
sub new |
1832
|
|
|
|
|
|
|
{ |
1833
|
|
|
|
|
|
|
my ($class, $doc, $name, $parameter, $noExpand) = @_; |
1834
|
|
|
|
|
|
|
|
1835
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, |
1836
|
|
|
|
|
|
|
"bad Entity Name [$name] in EntityReference") |
1837
|
|
|
|
|
|
|
unless XML::DOM::isValidName ($name); |
1838
|
|
|
|
|
|
|
|
1839
|
|
|
|
|
|
|
my $self = bless [], $class; |
1840
|
|
|
|
|
|
|
|
1841
|
|
|
|
|
|
|
$self->[_Doc] = $doc; |
1842
|
|
|
|
|
|
|
$self->[_EntityName] = $name; |
1843
|
|
|
|
|
|
|
$self->[_Parameter] = ($parameter || 0); |
1844
|
|
|
|
|
|
|
$self->[_NoExpand] = ($noExpand || 0); |
1845
|
|
|
|
|
|
|
|
1846
|
|
|
|
|
|
|
$self; |
1847
|
|
|
|
|
|
|
} |
1848
|
|
|
|
|
|
|
|
1849
|
|
|
|
|
|
|
sub getNodeType |
1850
|
|
|
|
|
|
|
{ |
1851
|
|
|
|
|
|
|
ENTITY_REFERENCE_NODE; |
1852
|
|
|
|
|
|
|
} |
1853
|
|
|
|
|
|
|
|
1854
|
|
|
|
|
|
|
sub getNodeName |
1855
|
|
|
|
|
|
|
{ |
1856
|
|
|
|
|
|
|
$_[0]->[_EntityName]; |
1857
|
|
|
|
|
|
|
} |
1858
|
|
|
|
|
|
|
|
1859
|
|
|
|
|
|
|
#------------------------------------------------------------ |
1860
|
|
|
|
|
|
|
# Extra method implementations |
1861
|
|
|
|
|
|
|
|
1862
|
|
|
|
|
|
|
sub getEntityName |
1863
|
|
|
|
|
|
|
{ |
1864
|
|
|
|
|
|
|
$_[0]->[_EntityName]; |
1865
|
|
|
|
|
|
|
} |
1866
|
|
|
|
|
|
|
|
1867
|
|
|
|
|
|
|
sub isParameterEntity |
1868
|
|
|
|
|
|
|
{ |
1869
|
|
|
|
|
|
|
$_[0]->[_Parameter]; |
1870
|
|
|
|
|
|
|
} |
1871
|
|
|
|
|
|
|
|
1872
|
|
|
|
|
|
|
sub getData |
1873
|
|
|
|
|
|
|
{ |
1874
|
|
|
|
|
|
|
my $self = shift; |
1875
|
|
|
|
|
|
|
my $name = $self->[_EntityName]; |
1876
|
|
|
|
|
|
|
my $parameter = $self->[_Parameter]; |
1877
|
|
|
|
|
|
|
|
1878
|
|
|
|
|
|
|
my $data; |
1879
|
|
|
|
|
|
|
if ($self->[_NoExpand]) { |
1880
|
|
|
|
|
|
|
$data = "&$name;" if $name; |
1881
|
|
|
|
|
|
|
} else { |
1882
|
|
|
|
|
|
|
$data = $self->[_Doc]->expandEntity ($name, $parameter); |
1883
|
|
|
|
|
|
|
} |
1884
|
|
|
|
|
|
|
|
1885
|
|
|
|
|
|
|
unless (defined $data) |
1886
|
|
|
|
|
|
|
{ |
1887
|
|
|
|
|
|
|
#?? this is probably an error, but perhaps requires check to NoExpand |
1888
|
|
|
|
|
|
|
# will fix it? |
1889
|
|
|
|
|
|
|
my $pc = $parameter ? "%" : "&"; |
1890
|
|
|
|
|
|
|
$data = "$pc$name;"; |
1891
|
|
|
|
|
|
|
} |
1892
|
|
|
|
|
|
|
$data; |
1893
|
|
|
|
|
|
|
} |
1894
|
|
|
|
|
|
|
|
1895
|
|
|
|
|
|
|
sub print |
1896
|
|
|
|
|
|
|
{ |
1897
|
|
|
|
|
|
|
my ($self, $FILE) = @_; |
1898
|
|
|
|
|
|
|
|
1899
|
|
|
|
|
|
|
my $name = $self->[_EntityName]; |
1900
|
|
|
|
|
|
|
|
1901
|
|
|
|
|
|
|
#?? or do we expand the entities? |
1902
|
|
|
|
|
|
|
|
1903
|
|
|
|
|
|
|
my $pc = $self->[_Parameter] ? "%" : "&"; |
1904
|
|
|
|
|
|
|
$FILE->print ("$pc$name;"); |
1905
|
|
|
|
|
|
|
} |
1906
|
|
|
|
|
|
|
|
1907
|
|
|
|
|
|
|
# Dom Spec says: |
1908
|
|
|
|
|
|
|
# [...] but if such an Entity exists, then |
1909
|
|
|
|
|
|
|
# the child list of the EntityReference node is the same as that of the |
1910
|
|
|
|
|
|
|
# Entity node. |
1911
|
|
|
|
|
|
|
# |
1912
|
|
|
|
|
|
|
# The resolution of the children of the EntityReference (the replacement |
1913
|
|
|
|
|
|
|
# value of the referenced Entity) may be lazily evaluated; actions by the |
1914
|
|
|
|
|
|
|
# user (such as calling the childNodes method on the EntityReference |
1915
|
|
|
|
|
|
|
# node) are assumed to trigger the evaluation. |
1916
|
|
|
|
|
|
|
sub getChildNodes |
1917
|
|
|
|
|
|
|
{ |
1918
|
|
|
|
|
|
|
my $self = shift; |
1919
|
|
|
|
|
|
|
my $entity = $self->[_Doc]->getEntity ($self->[_EntityName]); |
1920
|
|
|
|
|
|
|
defined ($entity) ? $entity->getChildNodes : new XML::DOM::NodeList; |
1921
|
|
|
|
|
|
|
} |
1922
|
|
|
|
|
|
|
|
1923
|
|
|
|
|
|
|
sub cloneNode |
1924
|
|
|
|
|
|
|
{ |
1925
|
|
|
|
|
|
|
my $self = shift; |
1926
|
|
|
|
|
|
|
$self->[_Doc]->createEntityReference ($self->[_EntityName], |
1927
|
|
|
|
|
|
|
$self->[_Parameter], |
1928
|
|
|
|
|
|
|
$self->[_NoExpand], |
1929
|
|
|
|
|
|
|
); |
1930
|
|
|
|
|
|
|
} |
1931
|
|
|
|
|
|
|
|
1932
|
|
|
|
|
|
|
sub to_expat |
1933
|
|
|
|
|
|
|
{ |
1934
|
|
|
|
|
|
|
my ($self, $iter) = @_; |
1935
|
|
|
|
|
|
|
$iter->EntityRef ($self->getEntityName, $self->isParameterEntity); |
1936
|
|
|
|
|
|
|
} |
1937
|
|
|
|
|
|
|
|
1938
|
|
|
|
|
|
|
sub _to_sax |
1939
|
|
|
|
|
|
|
{ |
1940
|
|
|
|
|
|
|
my ($self, $doch, $dtdh, $enth) = @_; |
1941
|
|
|
|
|
|
|
my @par = $self->isParameterEntity ? (Parameter => 1) : (); |
1942
|
|
|
|
|
|
|
#?? not supported by PerlSAX: $self->isParameterEntity |
1943
|
|
|
|
|
|
|
|
1944
|
|
|
|
|
|
|
$doch->entity_reference ( { Name => $self->getEntityName, @par } ); |
1945
|
|
|
|
|
|
|
} |
1946
|
|
|
|
|
|
|
|
1947
|
|
|
|
|
|
|
# NOTE: an EntityReference can't really have children, so rejectChild |
1948
|
|
|
|
|
|
|
# is not reimplemented (i.e. it always returns 0.) |
1949
|
|
|
|
|
|
|
|
1950
|
|
|
|
|
|
|
###################################################################### |
1951
|
|
|
|
|
|
|
package XML::DOM::AttDef; |
1952
|
|
|
|
|
|
|
###################################################################### |
1953
|
|
|
|
|
|
|
use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; |
1954
|
|
|
|
|
|
|
|
1955
|
|
|
|
|
|
|
BEGIN |
1956
|
|
|
|
|
|
|
{ |
1957
|
|
|
|
|
|
|
import XML::DOM::Node qw( :DEFAULT :Fields ); |
1958
|
|
|
|
|
|
|
XML::DOM::def_fields ("Name Type Fixed Default Required Implied Quote", "XML::DOM::Node"); |
1959
|
|
|
|
|
|
|
} |
1960
|
|
|
|
|
|
|
|
1961
|
|
|
|
|
|
|
use XML::DOM::DOMException; |
1962
|
|
|
|
|
|
|
use Carp; |
1963
|
|
|
|
|
|
|
|
1964
|
|
|
|
|
|
|
#------------------------------------------------------------ |
1965
|
|
|
|
|
|
|
# Extra method implementations |
1966
|
|
|
|
|
|
|
|
1967
|
|
|
|
|
|
|
# AttDef is not part of DOM Spec |
1968
|
|
|
|
|
|
|
sub new |
1969
|
|
|
|
|
|
|
{ |
1970
|
|
|
|
|
|
|
my ($class, $doc, $name, $attrType, $default, $fixed, $hidden) = @_; |
1971
|
|
|
|
|
|
|
|
1972
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, |
1973
|
|
|
|
|
|
|
"bad Attr name in AttDef [$name]") |
1974
|
|
|
|
|
|
|
unless XML::DOM::isValidName ($name); |
1975
|
|
|
|
|
|
|
|
1976
|
|
|
|
|
|
|
my $self = bless [], $class; |
1977
|
|
|
|
|
|
|
|
1978
|
|
|
|
|
|
|
$self->[_Doc] = $doc; |
1979
|
|
|
|
|
|
|
$self->[_Name] = $name; |
1980
|
|
|
|
|
|
|
$self->[_Type] = $attrType; |
1981
|
|
|
|
|
|
|
|
1982
|
|
|
|
|
|
|
if (defined $default) |
1983
|
|
|
|
|
|
|
{ |
1984
|
|
|
|
|
|
|
if ($default eq "#REQUIRED") |
1985
|
|
|
|
|
|
|
{ |
1986
|
|
|
|
|
|
|
$self->[_Required] = 1; |
1987
|
|
|
|
|
|
|
} |
1988
|
|
|
|
|
|
|
elsif ($default eq "#IMPLIED") |
1989
|
|
|
|
|
|
|
{ |
1990
|
|
|
|
|
|
|
$self->[_Implied] = 1; |
1991
|
|
|
|
|
|
|
} |
1992
|
|
|
|
|
|
|
else |
1993
|
|
|
|
|
|
|
{ |
1994
|
|
|
|
|
|
|
# strip off quotes - see Attlist handler in XML::Parser |
1995
|
|
|
|
|
|
|
# this regexp doesn't work with 5.8.0 unicode |
1996
|
|
|
|
|
|
|
# $default =~ m#^(["'])(.*)['"]$#; |
1997
|
|
|
|
|
|
|
# $self->[_Quote] = $1; # keep track of the quote character |
1998
|
|
|
|
|
|
|
# $self->[_Default] = $self->setDefault ($2); |
1999
|
|
|
|
|
|
|
|
2000
|
|
|
|
|
|
|
# workaround for 5.8.0 unicode |
2001
|
|
|
|
|
|
|
$default =~ s!^(["'])!!; |
2002
|
|
|
|
|
|
|
$self->[_Quote] = $1; |
2003
|
|
|
|
|
|
|
$default =~ s!(["'])$!!; |
2004
|
|
|
|
|
|
|
$self->[_Default] = $self->setDefault ($default); |
2005
|
|
|
|
|
|
|
|
2006
|
|
|
|
|
|
|
#?? should default value be decoded - what if it contains e.g. "&" |
2007
|
|
|
|
|
|
|
} |
2008
|
|
|
|
|
|
|
} |
2009
|
|
|
|
|
|
|
$self->[_Fixed] = $fixed if defined $fixed; |
2010
|
|
|
|
|
|
|
$self->[_Hidden] = $hidden if defined $hidden; |
2011
|
|
|
|
|
|
|
|
2012
|
|
|
|
|
|
|
$self; |
2013
|
|
|
|
|
|
|
} |
2014
|
|
|
|
|
|
|
|
2015
|
|
|
|
|
|
|
sub getNodeType |
2016
|
|
|
|
|
|
|
{ |
2017
|
|
|
|
|
|
|
ATT_DEF_NODE; |
2018
|
|
|
|
|
|
|
} |
2019
|
|
|
|
|
|
|
|
2020
|
|
|
|
|
|
|
sub getName |
2021
|
|
|
|
|
|
|
{ |
2022
|
|
|
|
|
|
|
$_[0]->[_Name]; |
2023
|
|
|
|
|
|
|
} |
2024
|
|
|
|
|
|
|
|
2025
|
|
|
|
|
|
|
# So it can be added to a NamedNodeMap |
2026
|
|
|
|
|
|
|
sub getNodeName |
2027
|
|
|
|
|
|
|
{ |
2028
|
|
|
|
|
|
|
$_[0]->[_Name]; |
2029
|
|
|
|
|
|
|
} |
2030
|
|
|
|
|
|
|
|
2031
|
|
|
|
|
|
|
sub getType |
2032
|
|
|
|
|
|
|
{ |
2033
|
|
|
|
|
|
|
$_[0]->[_Type]; |
2034
|
|
|
|
|
|
|
} |
2035
|
|
|
|
|
|
|
|
2036
|
|
|
|
|
|
|
sub setType |
2037
|
|
|
|
|
|
|
{ |
2038
|
|
|
|
|
|
|
$_[0]->[_Type] = $_[1]; |
2039
|
|
|
|
|
|
|
} |
2040
|
|
|
|
|
|
|
|
2041
|
|
|
|
|
|
|
sub getDefault |
2042
|
|
|
|
|
|
|
{ |
2043
|
|
|
|
|
|
|
$_[0]->[_Default]; |
2044
|
|
|
|
|
|
|
} |
2045
|
|
|
|
|
|
|
|
2046
|
|
|
|
|
|
|
sub setDefault |
2047
|
|
|
|
|
|
|
{ |
2048
|
|
|
|
|
|
|
my ($self, $value) = @_; |
2049
|
|
|
|
|
|
|
|
2050
|
|
|
|
|
|
|
# specified=0, it's the default ! |
2051
|
|
|
|
|
|
|
my $attr = $self->[_Doc]->createAttribute ($self->[_Name], undef, 0); |
2052
|
|
|
|
|
|
|
$attr->[_ReadOnly] = 1; |
2053
|
|
|
|
|
|
|
|
2054
|
|
|
|
|
|
|
#?? this should be split over Text and EntityReference nodes, just like other |
2055
|
|
|
|
|
|
|
# Attr nodes - just expand the text for now |
2056
|
|
|
|
|
|
|
$value = $self->expandEntityRefs ($value); |
2057
|
|
|
|
|
|
|
$attr->addText ($value); |
2058
|
|
|
|
|
|
|
#?? reimplement in NoExpand mode! |
2059
|
|
|
|
|
|
|
|
2060
|
|
|
|
|
|
|
$attr; |
2061
|
|
|
|
|
|
|
} |
2062
|
|
|
|
|
|
|
|
2063
|
|
|
|
|
|
|
sub isFixed |
2064
|
|
|
|
|
|
|
{ |
2065
|
|
|
|
|
|
|
$_[0]->[_Fixed] || 0; |
2066
|
|
|
|
|
|
|
} |
2067
|
|
|
|
|
|
|
|
2068
|
|
|
|
|
|
|
sub isRequired |
2069
|
|
|
|
|
|
|
{ |
2070
|
|
|
|
|
|
|
$_[0]->[_Required] || 0; |
2071
|
|
|
|
|
|
|
} |
2072
|
|
|
|
|
|
|
|
2073
|
|
|
|
|
|
|
sub isImplied |
2074
|
|
|
|
|
|
|
{ |
2075
|
|
|
|
|
|
|
$_[0]->[_Implied] || 0; |
2076
|
|
|
|
|
|
|
} |
2077
|
|
|
|
|
|
|
|
2078
|
|
|
|
|
|
|
sub print |
2079
|
|
|
|
|
|
|
{ |
2080
|
|
|
|
|
|
|
my ($self, $FILE) = @_; |
2081
|
|
|
|
|
|
|
|
2082
|
|
|
|
|
|
|
my $name = $self->[_Name]; |
2083
|
|
|
|
|
|
|
my $type = $self->[_Type]; |
2084
|
|
|
|
|
|
|
my $fixed = $self->[_Fixed]; |
2085
|
|
|
|
|
|
|
my $default = $self->[_Default]; |
2086
|
|
|
|
|
|
|
|
2087
|
|
|
|
|
|
|
# $FILE->print ("$name $type"); |
2088
|
|
|
|
|
|
|
# replaced line above with the two lines below |
2089
|
|
|
|
|
|
|
# seems to be a bug in perl 5.6.0 that causes |
2090
|
|
|
|
|
|
|
# test 3 of dom_jp_attr.t to fail? |
2091
|
|
|
|
|
|
|
$FILE->print ($name); |
2092
|
|
|
|
|
|
|
$FILE->print (" $type"); |
2093
|
|
|
|
|
|
|
|
2094
|
|
|
|
|
|
|
$FILE->print (" #FIXED") if defined $fixed; |
2095
|
|
|
|
|
|
|
|
2096
|
|
|
|
|
|
|
if ($self->[_Required]) |
2097
|
|
|
|
|
|
|
{ |
2098
|
|
|
|
|
|
|
$FILE->print (" #REQUIRED"); |
2099
|
|
|
|
|
|
|
} |
2100
|
|
|
|
|
|
|
elsif ($self->[_Implied]) |
2101
|
|
|
|
|
|
|
{ |
2102
|
|
|
|
|
|
|
$FILE->print (" #IMPLIED"); |
2103
|
|
|
|
|
|
|
} |
2104
|
|
|
|
|
|
|
elsif (defined ($default)) |
2105
|
|
|
|
|
|
|
{ |
2106
|
|
|
|
|
|
|
my $quote = $self->[_Quote]; |
2107
|
|
|
|
|
|
|
$FILE->print (" $quote"); |
2108
|
|
|
|
|
|
|
for my $kid (@{$default->[_C]}) |
2109
|
|
|
|
|
|
|
{ |
2110
|
|
|
|
|
|
|
$kid->print ($FILE); |
2111
|
|
|
|
|
|
|
} |
2112
|
|
|
|
|
|
|
$FILE->print ($quote); |
2113
|
|
|
|
|
|
|
} |
2114
|
|
|
|
|
|
|
} |
2115
|
|
|
|
|
|
|
|
2116
|
|
|
|
|
|
|
sub getDefaultString |
2117
|
|
|
|
|
|
|
{ |
2118
|
|
|
|
|
|
|
my $self = shift; |
2119
|
|
|
|
|
|
|
my $default; |
2120
|
|
|
|
|
|
|
|
2121
|
|
|
|
|
|
|
if ($self->[_Required]) |
2122
|
|
|
|
|
|
|
{ |
2123
|
|
|
|
|
|
|
return "#REQUIRED"; |
2124
|
|
|
|
|
|
|
} |
2125
|
|
|
|
|
|
|
elsif ($self->[_Implied]) |
2126
|
|
|
|
|
|
|
{ |
2127
|
|
|
|
|
|
|
return "#IMPLIED"; |
2128
|
|
|
|
|
|
|
} |
2129
|
|
|
|
|
|
|
elsif (defined ($default = $self->[_Default])) |
2130
|
|
|
|
|
|
|
{ |
2131
|
|
|
|
|
|
|
my $quote = $self->[_Quote]; |
2132
|
|
|
|
|
|
|
$default = $default->toString; |
2133
|
|
|
|
|
|
|
return "$quote$default$quote"; |
2134
|
|
|
|
|
|
|
} |
2135
|
|
|
|
|
|
|
undef; |
2136
|
|
|
|
|
|
|
} |
2137
|
|
|
|
|
|
|
|
2138
|
|
|
|
|
|
|
sub cloneNode |
2139
|
|
|
|
|
|
|
{ |
2140
|
|
|
|
|
|
|
my $self = shift; |
2141
|
|
|
|
|
|
|
my $node = new XML::DOM::AttDef ($self->[_Doc], $self->[_Name], $self->[_Type], |
2142
|
|
|
|
|
|
|
undef, $self->[_Fixed]); |
2143
|
|
|
|
|
|
|
|
2144
|
|
|
|
|
|
|
$node->[_Required] = 1 if $self->[_Required]; |
2145
|
|
|
|
|
|
|
$node->[_Implied] = 1 if $self->[_Implied]; |
2146
|
|
|
|
|
|
|
$node->[_Fixed] = $self->[_Fixed] if defined $self->[_Fixed]; |
2147
|
|
|
|
|
|
|
$node->[_Hidden] = $self->[_Hidden] if defined $self->[_Hidden]; |
2148
|
|
|
|
|
|
|
|
2149
|
|
|
|
|
|
|
if (defined $self->[_Default]) |
2150
|
|
|
|
|
|
|
{ |
2151
|
|
|
|
|
|
|
$node->[_Default] = $self->[_Default]->cloneNode(1); |
2152
|
|
|
|
|
|
|
} |
2153
|
|
|
|
|
|
|
$node->[_Quote] = $self->[_Quote]; |
2154
|
|
|
|
|
|
|
|
2155
|
|
|
|
|
|
|
$node; |
2156
|
|
|
|
|
|
|
} |
2157
|
|
|
|
|
|
|
|
2158
|
|
|
|
|
|
|
sub setOwnerDocument |
2159
|
|
|
|
|
|
|
{ |
2160
|
|
|
|
|
|
|
my ($self, $doc) = @_; |
2161
|
|
|
|
|
|
|
$self->SUPER::setOwnerDocument ($doc); |
2162
|
|
|
|
|
|
|
|
2163
|
|
|
|
|
|
|
if (defined $self->[_Default]) |
2164
|
|
|
|
|
|
|
{ |
2165
|
|
|
|
|
|
|
$self->[_Default]->setOwnerDocument ($doc); |
2166
|
|
|
|
|
|
|
} |
2167
|
|
|
|
|
|
|
} |
2168
|
|
|
|
|
|
|
|
2169
|
|
|
|
|
|
|
###################################################################### |
2170
|
|
|
|
|
|
|
package XML::DOM::AttlistDecl; |
2171
|
|
|
|
|
|
|
###################################################################### |
2172
|
|
|
|
|
|
|
use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; |
2173
|
|
|
|
|
|
|
|
2174
|
|
|
|
|
|
|
BEGIN |
2175
|
|
|
|
|
|
|
{ |
2176
|
|
|
|
|
|
|
import XML::DOM::Node qw( :DEFAULT :Fields ); |
2177
|
|
|
|
|
|
|
import XML::DOM::AttDef qw{ :Fields }; |
2178
|
|
|
|
|
|
|
|
2179
|
|
|
|
|
|
|
XML::DOM::def_fields ("ElementName", "XML::DOM::Node"); |
2180
|
|
|
|
|
|
|
} |
2181
|
|
|
|
|
|
|
|
2182
|
|
|
|
|
|
|
use XML::DOM::DOMException; |
2183
|
|
|
|
|
|
|
use Carp; |
2184
|
|
|
|
|
|
|
|
2185
|
|
|
|
|
|
|
#------------------------------------------------------------ |
2186
|
|
|
|
|
|
|
# Extra method implementations |
2187
|
|
|
|
|
|
|
|
2188
|
|
|
|
|
|
|
# AttlistDecl is not part of the DOM Spec |
2189
|
|
|
|
|
|
|
sub new |
2190
|
|
|
|
|
|
|
{ |
2191
|
|
|
|
|
|
|
my ($class, $doc, $name) = @_; |
2192
|
|
|
|
|
|
|
|
2193
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, |
2194
|
|
|
|
|
|
|
"bad Element TagName [$name] in AttlistDecl") |
2195
|
|
|
|
|
|
|
unless XML::DOM::isValidName ($name); |
2196
|
|
|
|
|
|
|
|
2197
|
|
|
|
|
|
|
my $self = bless [], $class; |
2198
|
|
|
|
|
|
|
|
2199
|
|
|
|
|
|
|
$self->[_Doc] = $doc; |
2200
|
|
|
|
|
|
|
$self->[_C] = new XML::DOM::NodeList; |
2201
|
|
|
|
|
|
|
$self->[_ReadOnly] = 1; |
2202
|
|
|
|
|
|
|
$self->[_ElementName] = $name; |
2203
|
|
|
|
|
|
|
|
2204
|
|
|
|
|
|
|
$self->[_A] = new XML::DOM::NamedNodeMap (Doc => $doc, |
2205
|
|
|
|
|
|
|
ReadOnly => 1, |
2206
|
|
|
|
|
|
|
Parent => $self); |
2207
|
|
|
|
|
|
|
|
2208
|
|
|
|
|
|
|
$self; |
2209
|
|
|
|
|
|
|
} |
2210
|
|
|
|
|
|
|
|
2211
|
|
|
|
|
|
|
sub getNodeType |
2212
|
|
|
|
|
|
|
{ |
2213
|
|
|
|
|
|
|
ATTLIST_DECL_NODE; |
2214
|
|
|
|
|
|
|
} |
2215
|
|
|
|
|
|
|
|
2216
|
|
|
|
|
|
|
sub getName |
2217
|
|
|
|
|
|
|
{ |
2218
|
|
|
|
|
|
|
$_[0]->[_ElementName]; |
2219
|
|
|
|
|
|
|
} |
2220
|
|
|
|
|
|
|
|
2221
|
|
|
|
|
|
|
sub getNodeName |
2222
|
|
|
|
|
|
|
{ |
2223
|
|
|
|
|
|
|
$_[0]->[_ElementName]; |
2224
|
|
|
|
|
|
|
} |
2225
|
|
|
|
|
|
|
|
2226
|
|
|
|
|
|
|
sub getAttDef |
2227
|
|
|
|
|
|
|
{ |
2228
|
|
|
|
|
|
|
my ($self, $attrName) = @_; |
2229
|
|
|
|
|
|
|
$self->[_A]->getNamedItem ($attrName); |
2230
|
|
|
|
|
|
|
} |
2231
|
|
|
|
|
|
|
|
2232
|
|
|
|
|
|
|
sub addAttDef |
2233
|
|
|
|
|
|
|
{ |
2234
|
|
|
|
|
|
|
my ($self, $attrName, $type, $default, $fixed, $hidden) = @_; |
2235
|
|
|
|
|
|
|
my $node = $self->getAttDef ($attrName); |
2236
|
|
|
|
|
|
|
|
2237
|
|
|
|
|
|
|
if (defined $node) |
2238
|
|
|
|
|
|
|
{ |
2239
|
|
|
|
|
|
|
# data will be ignored if already defined |
2240
|
|
|
|
|
|
|
my $elemName = $self->getName; |
2241
|
|
|
|
|
|
|
XML::DOM::warning ("multiple definitions of attribute $attrName for element $elemName, only first one is recognized"); |
2242
|
|
|
|
|
|
|
} |
2243
|
|
|
|
|
|
|
else |
2244
|
|
|
|
|
|
|
{ |
2245
|
|
|
|
|
|
|
$node = new XML::DOM::AttDef ($self->[_Doc], $attrName, $type, |
2246
|
|
|
|
|
|
|
$default, $fixed, $hidden); |
2247
|
|
|
|
|
|
|
$self->[_A]->setNamedItem ($node); |
2248
|
|
|
|
|
|
|
} |
2249
|
|
|
|
|
|
|
$node; |
2250
|
|
|
|
|
|
|
} |
2251
|
|
|
|
|
|
|
|
2252
|
|
|
|
|
|
|
sub getDefaultAttrValue |
2253
|
|
|
|
|
|
|
{ |
2254
|
|
|
|
|
|
|
my ($self, $attr) = @_; |
2255
|
|
|
|
|
|
|
my $attrNode = $self->getAttDef ($attr); |
2256
|
|
|
|
|
|
|
(defined $attrNode) ? $attrNode->getDefault : undef; |
2257
|
|
|
|
|
|
|
} |
2258
|
|
|
|
|
|
|
|
2259
|
|
|
|
|
|
|
sub cloneNode |
2260
|
|
|
|
|
|
|
{ |
2261
|
|
|
|
|
|
|
my ($self, $deep) = @_; |
2262
|
|
|
|
|
|
|
my $node = $self->[_Doc]->createAttlistDecl ($self->[_ElementName]); |
2263
|
|
|
|
|
|
|
|
2264
|
|
|
|
|
|
|
$node->[_A] = $self->[_A]->cloneNode ($deep); |
2265
|
|
|
|
|
|
|
$node; |
2266
|
|
|
|
|
|
|
} |
2267
|
|
|
|
|
|
|
|
2268
|
|
|
|
|
|
|
sub setOwnerDocument |
2269
|
|
|
|
|
|
|
{ |
2270
|
|
|
|
|
|
|
my ($self, $doc) = @_; |
2271
|
|
|
|
|
|
|
$self->SUPER::setOwnerDocument ($doc); |
2272
|
|
|
|
|
|
|
|
2273
|
|
|
|
|
|
|
$self->[_A]->setOwnerDocument ($doc); |
2274
|
|
|
|
|
|
|
} |
2275
|
|
|
|
|
|
|
|
2276
|
|
|
|
|
|
|
sub print |
2277
|
|
|
|
|
|
|
{ |
2278
|
|
|
|
|
|
|
my ($self, $FILE) = @_; |
2279
|
|
|
|
|
|
|
|
2280
|
|
|
|
|
|
|
my $name = $self->getName; |
2281
|
|
|
|
|
|
|
my @attlist = @{$self->[_A]->getValues}; |
2282
|
|
|
|
|
|
|
|
2283
|
|
|
|
|
|
|
my $hidden = 1; |
2284
|
|
|
|
|
|
|
for my $att (@attlist) |
2285
|
|
|
|
|
|
|
{ |
2286
|
|
|
|
|
|
|
unless ($att->[_Hidden]) |
2287
|
|
|
|
|
|
|
{ |
2288
|
|
|
|
|
|
|
$hidden = 0; |
2289
|
|
|
|
|
|
|
last; |
2290
|
|
|
|
|
|
|
} |
2291
|
|
|
|
|
|
|
} |
2292
|
|
|
|
|
|
|
|
2293
|
|
|
|
|
|
|
unless ($hidden) |
2294
|
|
|
|
|
|
|
{ |
2295
|
|
|
|
|
|
|
$FILE->print ("
|
2296
|
|
|
|
|
|
|
|
2297
|
|
|
|
|
|
|
if (@attlist == 1) |
2298
|
|
|
|
|
|
|
{ |
2299
|
|
|
|
|
|
|
$FILE->print (" "); |
2300
|
|
|
|
|
|
|
$attlist[0]->print ($FILE); |
2301
|
|
|
|
|
|
|
} |
2302
|
|
|
|
|
|
|
else |
2303
|
|
|
|
|
|
|
{ |
2304
|
|
|
|
|
|
|
for my $attr (@attlist) |
2305
|
|
|
|
|
|
|
{ |
2306
|
|
|
|
|
|
|
next if $attr->[_Hidden]; |
2307
|
|
|
|
|
|
|
|
2308
|
|
|
|
|
|
|
$FILE->print ("\x0A "); |
2309
|
|
|
|
|
|
|
$attr->print ($FILE); |
2310
|
|
|
|
|
|
|
} |
2311
|
|
|
|
|
|
|
} |
2312
|
|
|
|
|
|
|
$FILE->print (">"); |
2313
|
|
|
|
|
|
|
} |
2314
|
|
|
|
|
|
|
} |
2315
|
|
|
|
|
|
|
|
2316
|
|
|
|
|
|
|
sub to_expat |
2317
|
|
|
|
|
|
|
{ |
2318
|
|
|
|
|
|
|
my ($self, $iter) = @_; |
2319
|
|
|
|
|
|
|
my $tag = $self->getName; |
2320
|
|
|
|
|
|
|
for my $a ($self->[_A]->getValues) |
2321
|
|
|
|
|
|
|
{ |
2322
|
|
|
|
|
|
|
my $default = $a->isImplied ? '#IMPLIED' : |
2323
|
|
|
|
|
|
|
($a->isRequired ? '#REQUIRED' : |
2324
|
|
|
|
|
|
|
($a->[_Quote] . $a->getDefault->getValue . $a->[_Quote])); |
2325
|
|
|
|
|
|
|
|
2326
|
|
|
|
|
|
|
$iter->Attlist ($tag, $a->getName, $a->getType, $default, $a->isFixed); |
2327
|
|
|
|
|
|
|
} |
2328
|
|
|
|
|
|
|
} |
2329
|
|
|
|
|
|
|
|
2330
|
|
|
|
|
|
|
sub _to_sax |
2331
|
|
|
|
|
|
|
{ |
2332
|
|
|
|
|
|
|
my ($self, $doch, $dtdh, $enth) = @_; |
2333
|
|
|
|
|
|
|
my $tag = $self->getName; |
2334
|
|
|
|
|
|
|
for my $a ($self->[_A]->getValues) |
2335
|
|
|
|
|
|
|
{ |
2336
|
|
|
|
|
|
|
my $default = $a->isImplied ? '#IMPLIED' : |
2337
|
|
|
|
|
|
|
($a->isRequired ? '#REQUIRED' : |
2338
|
|
|
|
|
|
|
($a->[_Quote] . $a->getDefault->getValue . $a->[_Quote])); |
2339
|
|
|
|
|
|
|
|
2340
|
|
|
|
|
|
|
$dtdh->attlist_decl ({ ElementName => $tag, |
2341
|
|
|
|
|
|
|
AttributeName => $a->getName, |
2342
|
|
|
|
|
|
|
Type => $a->[_Type], |
2343
|
|
|
|
|
|
|
Default => $default, |
2344
|
|
|
|
|
|
|
Fixed => $a->isFixed }); |
2345
|
|
|
|
|
|
|
} |
2346
|
|
|
|
|
|
|
} |
2347
|
|
|
|
|
|
|
|
2348
|
|
|
|
|
|
|
###################################################################### |
2349
|
|
|
|
|
|
|
package XML::DOM::ElementDecl; |
2350
|
|
|
|
|
|
|
###################################################################### |
2351
|
|
|
|
|
|
|
use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; |
2352
|
|
|
|
|
|
|
|
2353
|
|
|
|
|
|
|
BEGIN |
2354
|
|
|
|
|
|
|
{ |
2355
|
|
|
|
|
|
|
import XML::DOM::Node qw( :DEFAULT :Fields ); |
2356
|
|
|
|
|
|
|
XML::DOM::def_fields ("Name Model", "XML::DOM::Node"); |
2357
|
|
|
|
|
|
|
} |
2358
|
|
|
|
|
|
|
|
2359
|
|
|
|
|
|
|
use XML::DOM::DOMException; |
2360
|
|
|
|
|
|
|
use Carp; |
2361
|
|
|
|
|
|
|
|
2362
|
|
|
|
|
|
|
|
2363
|
|
|
|
|
|
|
#------------------------------------------------------------ |
2364
|
|
|
|
|
|
|
# Extra method implementations |
2365
|
|
|
|
|
|
|
|
2366
|
|
|
|
|
|
|
# ElementDecl is not part of the DOM Spec |
2367
|
|
|
|
|
|
|
sub new |
2368
|
|
|
|
|
|
|
{ |
2369
|
|
|
|
|
|
|
my ($class, $doc, $name, $model, $hidden) = @_; |
2370
|
|
|
|
|
|
|
|
2371
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, |
2372
|
|
|
|
|
|
|
"bad Element TagName [$name] in ElementDecl") |
2373
|
|
|
|
|
|
|
unless XML::DOM::isValidName ($name); |
2374
|
|
|
|
|
|
|
|
2375
|
|
|
|
|
|
|
my $self = bless [], $class; |
2376
|
|
|
|
|
|
|
|
2377
|
|
|
|
|
|
|
$self->[_Doc] = $doc; |
2378
|
|
|
|
|
|
|
$self->[_Name] = $name; |
2379
|
|
|
|
|
|
|
$self->[_ReadOnly] = 1; |
2380
|
|
|
|
|
|
|
$self->[_Model] = $model; |
2381
|
|
|
|
|
|
|
$self->[_Hidden] = $hidden; |
2382
|
|
|
|
|
|
|
$self; |
2383
|
|
|
|
|
|
|
} |
2384
|
|
|
|
|
|
|
|
2385
|
|
|
|
|
|
|
sub getNodeType |
2386
|
|
|
|
|
|
|
{ |
2387
|
|
|
|
|
|
|
ELEMENT_DECL_NODE; |
2388
|
|
|
|
|
|
|
} |
2389
|
|
|
|
|
|
|
|
2390
|
|
|
|
|
|
|
sub getName |
2391
|
|
|
|
|
|
|
{ |
2392
|
|
|
|
|
|
|
$_[0]->[_Name]; |
2393
|
|
|
|
|
|
|
} |
2394
|
|
|
|
|
|
|
|
2395
|
|
|
|
|
|
|
sub getNodeName |
2396
|
|
|
|
|
|
|
{ |
2397
|
|
|
|
|
|
|
$_[0]->[_Name]; |
2398
|
|
|
|
|
|
|
} |
2399
|
|
|
|
|
|
|
|
2400
|
|
|
|
|
|
|
sub getModel |
2401
|
|
|
|
|
|
|
{ |
2402
|
|
|
|
|
|
|
$_[0]->[_Model]; |
2403
|
|
|
|
|
|
|
} |
2404
|
|
|
|
|
|
|
|
2405
|
|
|
|
|
|
|
sub setModel |
2406
|
|
|
|
|
|
|
{ |
2407
|
|
|
|
|
|
|
my ($self, $model) = @_; |
2408
|
|
|
|
|
|
|
|
2409
|
|
|
|
|
|
|
$self->[_Model] = $model; |
2410
|
|
|
|
|
|
|
} |
2411
|
|
|
|
|
|
|
|
2412
|
|
|
|
|
|
|
sub print |
2413
|
|
|
|
|
|
|
{ |
2414
|
|
|
|
|
|
|
my ($self, $FILE) = @_; |
2415
|
|
|
|
|
|
|
|
2416
|
|
|
|
|
|
|
my $name = $self->[_Name]; |
2417
|
|
|
|
|
|
|
my $model = $self->[_Model]; |
2418
|
|
|
|
|
|
|
|
2419
|
|
|
|
|
|
|
$FILE->print ("") |
2420
|
|
|
|
|
|
|
unless $self->[_Hidden]; |
2421
|
|
|
|
|
|
|
} |
2422
|
|
|
|
|
|
|
|
2423
|
|
|
|
|
|
|
sub cloneNode |
2424
|
|
|
|
|
|
|
{ |
2425
|
|
|
|
|
|
|
my $self = shift; |
2426
|
|
|
|
|
|
|
$self->[_Doc]->createElementDecl ($self->[_Name], $self->[_Model], |
2427
|
|
|
|
|
|
|
$self->[_Hidden]); |
2428
|
|
|
|
|
|
|
} |
2429
|
|
|
|
|
|
|
|
2430
|
|
|
|
|
|
|
sub to_expat |
2431
|
|
|
|
|
|
|
{ |
2432
|
|
|
|
|
|
|
#?? add support for Hidden?? (allover, also in _to_sax!!) |
2433
|
|
|
|
|
|
|
|
2434
|
|
|
|
|
|
|
my ($self, $iter) = @_; |
2435
|
|
|
|
|
|
|
$iter->Element ($self->getName, $self->getModel); |
2436
|
|
|
|
|
|
|
} |
2437
|
|
|
|
|
|
|
|
2438
|
|
|
|
|
|
|
sub _to_sax |
2439
|
|
|
|
|
|
|
{ |
2440
|
|
|
|
|
|
|
my ($self, $doch, $dtdh, $enth) = @_; |
2441
|
|
|
|
|
|
|
$dtdh->element_decl ( { Name => $self->getName, |
2442
|
|
|
|
|
|
|
Model => $self->getModel } ); |
2443
|
|
|
|
|
|
|
} |
2444
|
|
|
|
|
|
|
|
2445
|
|
|
|
|
|
|
###################################################################### |
2446
|
|
|
|
|
|
|
package XML::DOM::Element; |
2447
|
|
|
|
|
|
|
###################################################################### |
2448
|
|
|
|
|
|
|
use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; |
2449
|
|
|
|
|
|
|
|
2450
|
|
|
|
|
|
|
BEGIN |
2451
|
|
|
|
|
|
|
{ |
2452
|
|
|
|
|
|
|
import XML::DOM::Node qw( :DEFAULT :Fields ); |
2453
|
|
|
|
|
|
|
XML::DOM::def_fields ("TagName", "XML::DOM::Node"); |
2454
|
|
|
|
|
|
|
} |
2455
|
|
|
|
|
|
|
|
2456
|
|
|
|
|
|
|
use XML::DOM::DOMException; |
2457
|
|
|
|
|
|
|
use XML::DOM::NamedNodeMap; |
2458
|
|
|
|
|
|
|
use Carp; |
2459
|
|
|
|
|
|
|
|
2460
|
|
|
|
|
|
|
sub new |
2461
|
|
|
|
|
|
|
{ |
2462
|
|
|
|
|
|
|
my ($class, $doc, $tagName) = @_; |
2463
|
|
|
|
|
|
|
|
2464
|
|
|
|
|
|
|
if ($XML::DOM::SafeMode) |
2465
|
|
|
|
|
|
|
{ |
2466
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, |
2467
|
|
|
|
|
|
|
"bad Element TagName [$tagName]") |
2468
|
|
|
|
|
|
|
unless XML::DOM::isValidName ($tagName); |
2469
|
|
|
|
|
|
|
} |
2470
|
|
|
|
|
|
|
|
2471
|
|
|
|
|
|
|
my $self = bless [], $class; |
2472
|
|
|
|
|
|
|
|
2473
|
|
|
|
|
|
|
$self->[_Doc] = $doc; |
2474
|
|
|
|
|
|
|
$self->[_C] = new XML::DOM::NodeList; |
2475
|
|
|
|
|
|
|
$self->[_TagName] = $tagName; |
2476
|
|
|
|
|
|
|
|
2477
|
|
|
|
|
|
|
# Now we're creating the NamedNodeMap only when needed (REC 2313 => 1147) |
2478
|
|
|
|
|
|
|
# $self->[_A] = new XML::DOM::NamedNodeMap (Doc => $doc, |
2479
|
|
|
|
|
|
|
# Parent => $self); |
2480
|
|
|
|
|
|
|
|
2481
|
|
|
|
|
|
|
$self; |
2482
|
|
|
|
|
|
|
} |
2483
|
|
|
|
|
|
|
|
2484
|
|
|
|
|
|
|
sub getNodeType |
2485
|
|
|
|
|
|
|
{ |
2486
|
|
|
|
|
|
|
ELEMENT_NODE; |
2487
|
|
|
|
|
|
|
} |
2488
|
|
|
|
|
|
|
|
2489
|
|
|
|
|
|
|
sub getTagName |
2490
|
|
|
|
|
|
|
{ |
2491
|
|
|
|
|
|
|
$_[0]->[_TagName]; |
2492
|
|
|
|
|
|
|
} |
2493
|
|
|
|
|
|
|
|
2494
|
|
|
|
|
|
|
sub getNodeName |
2495
|
|
|
|
|
|
|
{ |
2496
|
|
|
|
|
|
|
$_[0]->[_TagName]; |
2497
|
|
|
|
|
|
|
} |
2498
|
|
|
|
|
|
|
|
2499
|
|
|
|
|
|
|
sub getAttributeNode |
2500
|
|
|
|
|
|
|
{ |
2501
|
|
|
|
|
|
|
my ($self, $name) = @_; |
2502
|
|
|
|
|
|
|
return undef unless defined $self->[_A]; |
2503
|
|
|
|
|
|
|
|
2504
|
|
|
|
|
|
|
$self->getAttributes->{$name}; |
2505
|
|
|
|
|
|
|
} |
2506
|
|
|
|
|
|
|
|
2507
|
|
|
|
|
|
|
sub getAttribute |
2508
|
|
|
|
|
|
|
{ |
2509
|
|
|
|
|
|
|
my ($self, $name) = @_; |
2510
|
|
|
|
|
|
|
my $attr = $self->getAttributeNode ($name); |
2511
|
|
|
|
|
|
|
(defined $attr) ? $attr->getValue : ""; |
2512
|
|
|
|
|
|
|
} |
2513
|
|
|
|
|
|
|
|
2514
|
|
|
|
|
|
|
sub setAttribute |
2515
|
|
|
|
|
|
|
{ |
2516
|
|
|
|
|
|
|
my ($self, $name, $val) = @_; |
2517
|
|
|
|
|
|
|
|
2518
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, |
2519
|
|
|
|
|
|
|
"bad Attr Name [$name]") |
2520
|
|
|
|
|
|
|
unless XML::DOM::isValidName ($name); |
2521
|
|
|
|
|
|
|
|
2522
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, |
2523
|
|
|
|
|
|
|
"node is ReadOnly") |
2524
|
|
|
|
|
|
|
if $self->isReadOnly; |
2525
|
|
|
|
|
|
|
|
2526
|
|
|
|
|
|
|
my $node = $self->getAttributes->{$name}; |
2527
|
|
|
|
|
|
|
if (defined $node) |
2528
|
|
|
|
|
|
|
{ |
2529
|
|
|
|
|
|
|
$node->setValue ($val); |
2530
|
|
|
|
|
|
|
} |
2531
|
|
|
|
|
|
|
else |
2532
|
|
|
|
|
|
|
{ |
2533
|
|
|
|
|
|
|
$node = $self->[_Doc]->createAttribute ($name, $val); |
2534
|
|
|
|
|
|
|
$self->[_A]->setNamedItem ($node); |
2535
|
|
|
|
|
|
|
} |
2536
|
|
|
|
|
|
|
} |
2537
|
|
|
|
|
|
|
|
2538
|
|
|
|
|
|
|
sub setAttributeNode |
2539
|
|
|
|
|
|
|
{ |
2540
|
|
|
|
|
|
|
my ($self, $node) = @_; |
2541
|
|
|
|
|
|
|
my $attr = $self->getAttributes; |
2542
|
|
|
|
|
|
|
my $name = $node->getNodeName; |
2543
|
|
|
|
|
|
|
|
2544
|
|
|
|
|
|
|
# REC 1147 |
2545
|
|
|
|
|
|
|
if ($XML::DOM::SafeMode) |
2546
|
|
|
|
|
|
|
{ |
2547
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR, |
2548
|
|
|
|
|
|
|
"nodes belong to different documents") |
2549
|
|
|
|
|
|
|
if $self->[_Doc] != $node->[_Doc]; |
2550
|
|
|
|
|
|
|
|
2551
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, |
2552
|
|
|
|
|
|
|
"node is ReadOnly") |
2553
|
|
|
|
|
|
|
if $self->isReadOnly; |
2554
|
|
|
|
|
|
|
|
2555
|
|
|
|
|
|
|
my $attrParent = $node->[_UsedIn]; |
2556
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (INUSE_ATTRIBUTE_ERR, |
2557
|
|
|
|
|
|
|
"Attr is already used by another Element") |
2558
|
|
|
|
|
|
|
if (defined ($attrParent) && $attrParent != $attr); |
2559
|
|
|
|
|
|
|
} |
2560
|
|
|
|
|
|
|
|
2561
|
|
|
|
|
|
|
my $other = $attr->{$name}; |
2562
|
|
|
|
|
|
|
$attr->removeNamedItem ($name) if defined $other; |
2563
|
|
|
|
|
|
|
|
2564
|
|
|
|
|
|
|
$attr->setNamedItem ($node); |
2565
|
|
|
|
|
|
|
|
2566
|
|
|
|
|
|
|
$other; |
2567
|
|
|
|
|
|
|
} |
2568
|
|
|
|
|
|
|
|
2569
|
|
|
|
|
|
|
sub removeAttributeNode |
2570
|
|
|
|
|
|
|
{ |
2571
|
|
|
|
|
|
|
my ($self, $node) = @_; |
2572
|
|
|
|
|
|
|
|
2573
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, |
2574
|
|
|
|
|
|
|
"node is ReadOnly") |
2575
|
|
|
|
|
|
|
if $self->isReadOnly; |
2576
|
|
|
|
|
|
|
|
2577
|
|
|
|
|
|
|
my $attr = $self->[_A]; |
2578
|
|
|
|
|
|
|
unless (defined $attr) |
2579
|
|
|
|
|
|
|
{ |
2580
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (NOT_FOUND_ERR); |
2581
|
|
|
|
|
|
|
return undef; |
2582
|
|
|
|
|
|
|
} |
2583
|
|
|
|
|
|
|
|
2584
|
|
|
|
|
|
|
my $name = $node->getNodeName; |
2585
|
|
|
|
|
|
|
my $attrNode = $attr->getNamedItem ($name); |
2586
|
|
|
|
|
|
|
|
2587
|
|
|
|
|
|
|
#?? should it croak if it's the default value? |
2588
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (NOT_FOUND_ERR) |
2589
|
|
|
|
|
|
|
unless $node == $attrNode; |
2590
|
|
|
|
|
|
|
|
2591
|
|
|
|
|
|
|
# Not removing anything if it's the default value already |
2592
|
|
|
|
|
|
|
return undef unless $node->isSpecified; |
2593
|
|
|
|
|
|
|
|
2594
|
|
|
|
|
|
|
$attr->removeNamedItem ($name); |
2595
|
|
|
|
|
|
|
|
2596
|
|
|
|
|
|
|
# Substitute with default value if it's defined |
2597
|
|
|
|
|
|
|
my $default = $self->getDefaultAttrValue ($name); |
2598
|
|
|
|
|
|
|
if (defined $default) |
2599
|
|
|
|
|
|
|
{ |
2600
|
|
|
|
|
|
|
local $XML::DOM::IgnoreReadOnly = 1; |
2601
|
|
|
|
|
|
|
|
2602
|
|
|
|
|
|
|
$default = $default->cloneNode (1); |
2603
|
|
|
|
|
|
|
$attr->setNamedItem ($default); |
2604
|
|
|
|
|
|
|
} |
2605
|
|
|
|
|
|
|
$node; |
2606
|
|
|
|
|
|
|
} |
2607
|
|
|
|
|
|
|
|
2608
|
|
|
|
|
|
|
sub removeAttribute |
2609
|
|
|
|
|
|
|
{ |
2610
|
|
|
|
|
|
|
my ($self, $name) = @_; |
2611
|
|
|
|
|
|
|
my $attr = $self->[_A]; |
2612
|
|
|
|
|
|
|
unless (defined $attr) |
2613
|
|
|
|
|
|
|
{ |
2614
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (NOT_FOUND_ERR); |
2615
|
|
|
|
|
|
|
return; |
2616
|
|
|
|
|
|
|
} |
2617
|
|
|
|
|
|
|
|
2618
|
|
|
|
|
|
|
my $node = $attr->getNamedItem ($name); |
2619
|
|
|
|
|
|
|
if (defined $node) |
2620
|
|
|
|
|
|
|
{ |
2621
|
|
|
|
|
|
|
#?? could use dispose() to remove circular references for gc, but what if |
2622
|
|
|
|
|
|
|
#?? somebody is referencing it? |
2623
|
|
|
|
|
|
|
$self->removeAttributeNode ($node); |
2624
|
|
|
|
|
|
|
} |
2625
|
|
|
|
|
|
|
} |
2626
|
|
|
|
|
|
|
|
2627
|
|
|
|
|
|
|
sub cloneNode |
2628
|
|
|
|
|
|
|
{ |
2629
|
|
|
|
|
|
|
my ($self, $deep) = @_; |
2630
|
|
|
|
|
|
|
my $node = $self->[_Doc]->createElement ($self->getTagName); |
2631
|
|
|
|
|
|
|
|
2632
|
|
|
|
|
|
|
# Always clone the Attr nodes, even if $deep == 0 |
2633
|
|
|
|
|
|
|
if (defined $self->[_A]) |
2634
|
|
|
|
|
|
|
{ |
2635
|
|
|
|
|
|
|
$node->[_A] = $self->[_A]->cloneNode (1); # deep=1 |
2636
|
|
|
|
|
|
|
$node->[_A]->setParentNode ($node); |
2637
|
|
|
|
|
|
|
} |
2638
|
|
|
|
|
|
|
|
2639
|
|
|
|
|
|
|
$node->cloneChildren ($self, $deep); |
2640
|
|
|
|
|
|
|
$node; |
2641
|
|
|
|
|
|
|
} |
2642
|
|
|
|
|
|
|
|
2643
|
|
|
|
|
|
|
sub getAttributes |
2644
|
|
|
|
|
|
|
{ |
2645
|
|
|
|
|
|
|
$_[0]->[_A] ||= XML::DOM::NamedNodeMap->new (Doc => $_[0]->[_Doc], |
2646
|
|
|
|
|
|
|
Parent => $_[0]); |
2647
|
|
|
|
|
|
|
} |
2648
|
|
|
|
|
|
|
|
2649
|
|
|
|
|
|
|
#------------------------------------------------------------ |
2650
|
|
|
|
|
|
|
# Extra method implementations |
2651
|
|
|
|
|
|
|
|
2652
|
|
|
|
|
|
|
# Added for convenience |
2653
|
|
|
|
|
|
|
sub setTagName |
2654
|
|
|
|
|
|
|
{ |
2655
|
|
|
|
|
|
|
my ($self, $tagName) = @_; |
2656
|
|
|
|
|
|
|
|
2657
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, |
2658
|
|
|
|
|
|
|
"bad Element TagName [$tagName]") |
2659
|
|
|
|
|
|
|
unless XML::DOM::isValidName ($tagName); |
2660
|
|
|
|
|
|
|
|
2661
|
|
|
|
|
|
|
$self->[_TagName] = $tagName; |
2662
|
|
|
|
|
|
|
} |
2663
|
|
|
|
|
|
|
|
2664
|
|
|
|
|
|
|
sub isReadOnly |
2665
|
|
|
|
|
|
|
{ |
2666
|
|
|
|
|
|
|
0; |
2667
|
|
|
|
|
|
|
} |
2668
|
|
|
|
|
|
|
|
2669
|
|
|
|
|
|
|
# Added for optimization. |
2670
|
|
|
|
|
|
|
sub isElementNode |
2671
|
|
|
|
|
|
|
{ |
2672
|
|
|
|
|
|
|
1; |
2673
|
|
|
|
|
|
|
} |
2674
|
|
|
|
|
|
|
|
2675
|
|
|
|
|
|
|
sub rejectChild |
2676
|
|
|
|
|
|
|
{ |
2677
|
|
|
|
|
|
|
my $t = $_[1]->getNodeType; |
2678
|
|
|
|
|
|
|
|
2679
|
|
|
|
|
|
|
$t != TEXT_NODE |
2680
|
|
|
|
|
|
|
&& $t != ENTITY_REFERENCE_NODE |
2681
|
|
|
|
|
|
|
&& $t != PROCESSING_INSTRUCTION_NODE |
2682
|
|
|
|
|
|
|
&& $t != COMMENT_NODE |
2683
|
|
|
|
|
|
|
&& $t != CDATA_SECTION_NODE |
2684
|
|
|
|
|
|
|
&& $t != ELEMENT_NODE; |
2685
|
|
|
|
|
|
|
} |
2686
|
|
|
|
|
|
|
|
2687
|
|
|
|
|
|
|
sub getDefaultAttrValue |
2688
|
|
|
|
|
|
|
{ |
2689
|
|
|
|
|
|
|
my ($self, $attr) = @_; |
2690
|
|
|
|
|
|
|
$self->[_Doc]->getDefaultAttrValue ($self->[_TagName], $attr); |
2691
|
|
|
|
|
|
|
} |
2692
|
|
|
|
|
|
|
|
2693
|
|
|
|
|
|
|
sub dispose |
2694
|
|
|
|
|
|
|
{ |
2695
|
|
|
|
|
|
|
my $self = shift; |
2696
|
|
|
|
|
|
|
|
2697
|
|
|
|
|
|
|
$self->[_A]->dispose if defined $self->[_A]; |
2698
|
|
|
|
|
|
|
$self->SUPER::dispose; |
2699
|
|
|
|
|
|
|
} |
2700
|
|
|
|
|
|
|
|
2701
|
|
|
|
|
|
|
sub setOwnerDocument |
2702
|
|
|
|
|
|
|
{ |
2703
|
|
|
|
|
|
|
my ($self, $doc) = @_; |
2704
|
|
|
|
|
|
|
$self->SUPER::setOwnerDocument ($doc); |
2705
|
|
|
|
|
|
|
|
2706
|
|
|
|
|
|
|
$self->[_A]->setOwnerDocument ($doc) if defined $self->[_A]; |
2707
|
|
|
|
|
|
|
} |
2708
|
|
|
|
|
|
|
|
2709
|
|
|
|
|
|
|
sub print |
2710
|
|
|
|
|
|
|
{ |
2711
|
|
|
|
|
|
|
my ($self, $FILE) = @_; |
2712
|
|
|
|
|
|
|
|
2713
|
|
|
|
|
|
|
my $name = $self->[_TagName]; |
2714
|
|
|
|
|
|
|
|
2715
|
|
|
|
|
|
|
$FILE->print ("<$name"); |
2716
|
|
|
|
|
|
|
|
2717
|
|
|
|
|
|
|
if (defined $self->[_A]) |
2718
|
|
|
|
|
|
|
{ |
2719
|
|
|
|
|
|
|
for my $att (@{$self->[_A]->getValues}) |
2720
|
|
|
|
|
|
|
{ |
2721
|
|
|
|
|
|
|
# skip un-specified (default) Attr nodes |
2722
|
|
|
|
|
|
|
if ($att->isSpecified) |
2723
|
|
|
|
|
|
|
{ |
2724
|
|
|
|
|
|
|
$FILE->print (" "); |
2725
|
|
|
|
|
|
|
$att->print ($FILE); |
2726
|
|
|
|
|
|
|
} |
2727
|
|
|
|
|
|
|
} |
2728
|
|
|
|
|
|
|
} |
2729
|
|
|
|
|
|
|
|
2730
|
|
|
|
|
|
|
my @kids = @{$self->[_C]}; |
2731
|
|
|
|
|
|
|
if (@kids > 0) |
2732
|
|
|
|
|
|
|
{ |
2733
|
|
|
|
|
|
|
$FILE->print (">"); |
2734
|
|
|
|
|
|
|
for my $kid (@kids) |
2735
|
|
|
|
|
|
|
{ |
2736
|
|
|
|
|
|
|
$kid->print ($FILE); |
2737
|
|
|
|
|
|
|
} |
2738
|
|
|
|
|
|
|
$FILE->print ("$name>"); |
2739
|
|
|
|
|
|
|
} |
2740
|
|
|
|
|
|
|
else |
2741
|
|
|
|
|
|
|
{ |
2742
|
|
|
|
|
|
|
my $style = &$XML::DOM::TagStyle ($name, $self); |
2743
|
|
|
|
|
|
|
if ($style == 0) |
2744
|
|
|
|
|
|
|
{ |
2745
|
|
|
|
|
|
|
$FILE->print ("/>"); |
2746
|
|
|
|
|
|
|
} |
2747
|
|
|
|
|
|
|
elsif ($style == 1) |
2748
|
|
|
|
|
|
|
{ |
2749
|
|
|
|
|
|
|
$FILE->print (">$name>"); |
2750
|
|
|
|
|
|
|
} |
2751
|
|
|
|
|
|
|
else |
2752
|
|
|
|
|
|
|
{ |
2753
|
|
|
|
|
|
|
$FILE->print (" />"); |
2754
|
|
|
|
|
|
|
} |
2755
|
|
|
|
|
|
|
} |
2756
|
|
|
|
|
|
|
} |
2757
|
|
|
|
|
|
|
|
2758
|
|
|
|
|
|
|
sub check |
2759
|
|
|
|
|
|
|
{ |
2760
|
|
|
|
|
|
|
my ($self, $checker) = @_; |
2761
|
|
|
|
|
|
|
die "Usage: \$xml_dom_elem->check (\$checker)" unless $checker; |
2762
|
|
|
|
|
|
|
|
2763
|
|
|
|
|
|
|
$checker->InitDomElem; |
2764
|
|
|
|
|
|
|
$self->to_expat ($checker); |
2765
|
|
|
|
|
|
|
$checker->FinalDomElem; |
2766
|
|
|
|
|
|
|
} |
2767
|
|
|
|
|
|
|
|
2768
|
|
|
|
|
|
|
sub to_expat |
2769
|
|
|
|
|
|
|
{ |
2770
|
|
|
|
|
|
|
my ($self, $iter) = @_; |
2771
|
|
|
|
|
|
|
|
2772
|
|
|
|
|
|
|
my $tag = $self->getTagName; |
2773
|
|
|
|
|
|
|
$iter->Start ($tag); |
2774
|
|
|
|
|
|
|
|
2775
|
|
|
|
|
|
|
if (defined $self->[_A]) |
2776
|
|
|
|
|
|
|
{ |
2777
|
|
|
|
|
|
|
for my $attr ($self->[_A]->getValues) |
2778
|
|
|
|
|
|
|
{ |
2779
|
|
|
|
|
|
|
$iter->Attr ($tag, $attr->getName, $attr->getValue, $attr->isSpecified); |
2780
|
|
|
|
|
|
|
} |
2781
|
|
|
|
|
|
|
} |
2782
|
|
|
|
|
|
|
|
2783
|
|
|
|
|
|
|
$iter->EndAttr; |
2784
|
|
|
|
|
|
|
|
2785
|
|
|
|
|
|
|
for my $kid ($self->getChildNodes) |
2786
|
|
|
|
|
|
|
{ |
2787
|
|
|
|
|
|
|
$kid->to_expat ($iter); |
2788
|
|
|
|
|
|
|
} |
2789
|
|
|
|
|
|
|
|
2790
|
|
|
|
|
|
|
$iter->End; |
2791
|
|
|
|
|
|
|
} |
2792
|
|
|
|
|
|
|
|
2793
|
|
|
|
|
|
|
sub _to_sax |
2794
|
|
|
|
|
|
|
{ |
2795
|
|
|
|
|
|
|
my ($self, $doch, $dtdh, $enth) = @_; |
2796
|
|
|
|
|
|
|
|
2797
|
|
|
|
|
|
|
my $tag = $self->getTagName; |
2798
|
|
|
|
|
|
|
|
2799
|
|
|
|
|
|
|
my @attr = (); |
2800
|
|
|
|
|
|
|
my $attrOrder; |
2801
|
|
|
|
|
|
|
my $attrDefaulted; |
2802
|
|
|
|
|
|
|
|
2803
|
|
|
|
|
|
|
if (defined $self->[_A]) |
2804
|
|
|
|
|
|
|
{ |
2805
|
|
|
|
|
|
|
my @spec = (); # names of specified attributes |
2806
|
|
|
|
|
|
|
my @unspec = (); # names of defaulted attributes |
2807
|
|
|
|
|
|
|
|
2808
|
|
|
|
|
|
|
for my $attr ($self->[_A]->getValues) |
2809
|
|
|
|
|
|
|
{ |
2810
|
|
|
|
|
|
|
my $attrName = $attr->getName; |
2811
|
|
|
|
|
|
|
push @attr, $attrName, $attr->getValue; |
2812
|
|
|
|
|
|
|
if ($attr->isSpecified) |
2813
|
|
|
|
|
|
|
{ |
2814
|
|
|
|
|
|
|
push @spec, $attrName; |
2815
|
|
|
|
|
|
|
} |
2816
|
|
|
|
|
|
|
else |
2817
|
|
|
|
|
|
|
{ |
2818
|
|
|
|
|
|
|
push @unspec, $attrName; |
2819
|
|
|
|
|
|
|
} |
2820
|
|
|
|
|
|
|
} |
2821
|
|
|
|
|
|
|
$attrOrder = [ @spec, @unspec ]; |
2822
|
|
|
|
|
|
|
$attrDefaulted = @spec; |
2823
|
|
|
|
|
|
|
} |
2824
|
|
|
|
|
|
|
$doch->start_element (defined $attrOrder ? |
2825
|
|
|
|
|
|
|
{ Name => $tag, |
2826
|
|
|
|
|
|
|
Attributes => { @attr }, |
2827
|
|
|
|
|
|
|
AttributeOrder => $attrOrder, |
2828
|
|
|
|
|
|
|
Defaulted => $attrDefaulted |
2829
|
|
|
|
|
|
|
} : |
2830
|
|
|
|
|
|
|
{ Name => $tag, |
2831
|
|
|
|
|
|
|
Attributes => { @attr } |
2832
|
|
|
|
|
|
|
} |
2833
|
|
|
|
|
|
|
); |
2834
|
|
|
|
|
|
|
|
2835
|
|
|
|
|
|
|
for my $kid ($self->getChildNodes) |
2836
|
|
|
|
|
|
|
{ |
2837
|
|
|
|
|
|
|
$kid->_to_sax ($doch, $dtdh, $enth); |
2838
|
|
|
|
|
|
|
} |
2839
|
|
|
|
|
|
|
|
2840
|
|
|
|
|
|
|
$doch->end_element ( { Name => $tag } ); |
2841
|
|
|
|
|
|
|
} |
2842
|
|
|
|
|
|
|
|
2843
|
|
|
|
|
|
|
###################################################################### |
2844
|
|
|
|
|
|
|
package XML::DOM::CharacterData; |
2845
|
|
|
|
|
|
|
###################################################################### |
2846
|
|
|
|
|
|
|
use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; |
2847
|
|
|
|
|
|
|
|
2848
|
|
|
|
|
|
|
BEGIN |
2849
|
|
|
|
|
|
|
{ |
2850
|
|
|
|
|
|
|
import XML::DOM::Node qw( :DEFAULT :Fields ); |
2851
|
|
|
|
|
|
|
XML::DOM::def_fields ("Data", "XML::DOM::Node"); |
2852
|
|
|
|
|
|
|
} |
2853
|
|
|
|
|
|
|
|
2854
|
|
|
|
|
|
|
use XML::DOM::DOMException; |
2855
|
|
|
|
|
|
|
use Carp; |
2856
|
|
|
|
|
|
|
|
2857
|
|
|
|
|
|
|
|
2858
|
|
|
|
|
|
|
# |
2859
|
|
|
|
|
|
|
# CharacterData nodes should never be created directly, only subclassed! |
2860
|
|
|
|
|
|
|
# |
2861
|
|
|
|
|
|
|
sub new |
2862
|
|
|
|
|
|
|
{ |
2863
|
|
|
|
|
|
|
my ($class, $doc, $data) = @_; |
2864
|
|
|
|
|
|
|
my $self = bless [], $class; |
2865
|
|
|
|
|
|
|
|
2866
|
|
|
|
|
|
|
$self->[_Doc] = $doc; |
2867
|
|
|
|
|
|
|
$self->[_Data] = $data; |
2868
|
|
|
|
|
|
|
$self; |
2869
|
|
|
|
|
|
|
} |
2870
|
|
|
|
|
|
|
|
2871
|
|
|
|
|
|
|
sub appendData |
2872
|
|
|
|
|
|
|
{ |
2873
|
|
|
|
|
|
|
my ($self, $data) = @_; |
2874
|
|
|
|
|
|
|
|
2875
|
|
|
|
|
|
|
if ($XML::DOM::SafeMode) |
2876
|
|
|
|
|
|
|
{ |
2877
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, |
2878
|
|
|
|
|
|
|
"node is ReadOnly") |
2879
|
|
|
|
|
|
|
if $self->isReadOnly; |
2880
|
|
|
|
|
|
|
} |
2881
|
|
|
|
|
|
|
$self->[_Data] .= $data; |
2882
|
|
|
|
|
|
|
} |
2883
|
|
|
|
|
|
|
|
2884
|
|
|
|
|
|
|
sub deleteData |
2885
|
|
|
|
|
|
|
{ |
2886
|
|
|
|
|
|
|
my ($self, $offset, $count) = @_; |
2887
|
|
|
|
|
|
|
|
2888
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (INDEX_SIZE_ERR, |
2889
|
|
|
|
|
|
|
"bad offset [$offset]") |
2890
|
|
|
|
|
|
|
if ($offset < 0 || $offset >= length ($self->[_Data])); |
2891
|
|
|
|
|
|
|
#?? DOM Spec says >, but >= makes more sense! |
2892
|
|
|
|
|
|
|
|
2893
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (INDEX_SIZE_ERR, |
2894
|
|
|
|
|
|
|
"negative count [$count]") |
2895
|
|
|
|
|
|
|
if $count < 0; |
2896
|
|
|
|
|
|
|
|
2897
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, |
2898
|
|
|
|
|
|
|
"node is ReadOnly") |
2899
|
|
|
|
|
|
|
if $self->isReadOnly; |
2900
|
|
|
|
|
|
|
|
2901
|
|
|
|
|
|
|
substr ($self->[_Data], $offset, $count) = ""; |
2902
|
|
|
|
|
|
|
} |
2903
|
|
|
|
|
|
|
|
2904
|
|
|
|
|
|
|
sub getData |
2905
|
|
|
|
|
|
|
{ |
2906
|
|
|
|
|
|
|
$_[0]->[_Data]; |
2907
|
|
|
|
|
|
|
} |
2908
|
|
|
|
|
|
|
|
2909
|
|
|
|
|
|
|
sub getLength |
2910
|
|
|
|
|
|
|
{ |
2911
|
|
|
|
|
|
|
length $_[0]->[_Data]; |
2912
|
|
|
|
|
|
|
} |
2913
|
|
|
|
|
|
|
|
2914
|
|
|
|
|
|
|
sub insertData |
2915
|
|
|
|
|
|
|
{ |
2916
|
|
|
|
|
|
|
my ($self, $offset, $data) = @_; |
2917
|
|
|
|
|
|
|
|
2918
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (INDEX_SIZE_ERR, |
2919
|
|
|
|
|
|
|
"bad offset [$offset]") |
2920
|
|
|
|
|
|
|
if ($offset < 0 || $offset >= length ($self->[_Data])); |
2921
|
|
|
|
|
|
|
#?? DOM Spec says >, but >= makes more sense! |
2922
|
|
|
|
|
|
|
|
2923
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, |
2924
|
|
|
|
|
|
|
"node is ReadOnly") |
2925
|
|
|
|
|
|
|
if $self->isReadOnly; |
2926
|
|
|
|
|
|
|
|
2927
|
|
|
|
|
|
|
substr ($self->[_Data], $offset, 0) = $data; |
2928
|
|
|
|
|
|
|
} |
2929
|
|
|
|
|
|
|
|
2930
|
|
|
|
|
|
|
sub replaceData |
2931
|
|
|
|
|
|
|
{ |
2932
|
|
|
|
|
|
|
my ($self, $offset, $count, $data) = @_; |
2933
|
|
|
|
|
|
|
|
2934
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (INDEX_SIZE_ERR, |
2935
|
|
|
|
|
|
|
"bad offset [$offset]") |
2936
|
|
|
|
|
|
|
if ($offset < 0 || $offset >= length ($self->[_Data])); |
2937
|
|
|
|
|
|
|
#?? DOM Spec says >, but >= makes more sense! |
2938
|
|
|
|
|
|
|
|
2939
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (INDEX_SIZE_ERR, |
2940
|
|
|
|
|
|
|
"negative count [$count]") |
2941
|
|
|
|
|
|
|
if $count < 0; |
2942
|
|
|
|
|
|
|
|
2943
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, |
2944
|
|
|
|
|
|
|
"node is ReadOnly") |
2945
|
|
|
|
|
|
|
if $self->isReadOnly; |
2946
|
|
|
|
|
|
|
|
2947
|
|
|
|
|
|
|
substr ($self->[_Data], $offset, $count) = $data; |
2948
|
|
|
|
|
|
|
} |
2949
|
|
|
|
|
|
|
|
2950
|
|
|
|
|
|
|
sub setData |
2951
|
|
|
|
|
|
|
{ |
2952
|
|
|
|
|
|
|
my ($self, $data) = @_; |
2953
|
|
|
|
|
|
|
|
2954
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, |
2955
|
|
|
|
|
|
|
"node is ReadOnly") |
2956
|
|
|
|
|
|
|
if $self->isReadOnly; |
2957
|
|
|
|
|
|
|
|
2958
|
|
|
|
|
|
|
$self->[_Data] = $data; |
2959
|
|
|
|
|
|
|
} |
2960
|
|
|
|
|
|
|
|
2961
|
|
|
|
|
|
|
sub substringData |
2962
|
|
|
|
|
|
|
{ |
2963
|
|
|
|
|
|
|
my ($self, $offset, $count) = @_; |
2964
|
|
|
|
|
|
|
my $data = $self->[_Data]; |
2965
|
|
|
|
|
|
|
|
2966
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (INDEX_SIZE_ERR, |
2967
|
|
|
|
|
|
|
"bad offset [$offset]") |
2968
|
|
|
|
|
|
|
if ($offset < 0 || $offset >= length ($data)); |
2969
|
|
|
|
|
|
|
#?? DOM Spec says >, but >= makes more sense! |
2970
|
|
|
|
|
|
|
|
2971
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (INDEX_SIZE_ERR, |
2972
|
|
|
|
|
|
|
"negative count [$count]") |
2973
|
|
|
|
|
|
|
if $count < 0; |
2974
|
|
|
|
|
|
|
|
2975
|
|
|
|
|
|
|
substr ($data, $offset, $count); |
2976
|
|
|
|
|
|
|
} |
2977
|
|
|
|
|
|
|
|
2978
|
|
|
|
|
|
|
sub getNodeValue |
2979
|
|
|
|
|
|
|
{ |
2980
|
|
|
|
|
|
|
$_[0]->getData; |
2981
|
|
|
|
|
|
|
} |
2982
|
|
|
|
|
|
|
|
2983
|
|
|
|
|
|
|
sub setNodeValue |
2984
|
|
|
|
|
|
|
{ |
2985
|
|
|
|
|
|
|
$_[0]->setData ($_[1]); |
2986
|
|
|
|
|
|
|
} |
2987
|
|
|
|
|
|
|
|
2988
|
|
|
|
|
|
|
###################################################################### |
2989
|
|
|
|
|
|
|
package XML::DOM::CDATASection; |
2990
|
|
|
|
|
|
|
###################################################################### |
2991
|
|
|
|
|
|
|
use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; |
2992
|
|
|
|
|
|
|
|
2993
|
|
|
|
|
|
|
BEGIN |
2994
|
|
|
|
|
|
|
{ |
2995
|
|
|
|
|
|
|
import XML::DOM::CharacterData qw( :DEFAULT :Fields ); |
2996
|
|
|
|
|
|
|
import XML::DOM::Node qw( :DEFAULT :Fields ); |
2997
|
|
|
|
|
|
|
XML::DOM::def_fields ("", "XML::DOM::CharacterData"); |
2998
|
|
|
|
|
|
|
} |
2999
|
|
|
|
|
|
|
|
3000
|
|
|
|
|
|
|
use XML::DOM::DOMException; |
3001
|
|
|
|
|
|
|
|
3002
|
|
|
|
|
|
|
sub getNodeName |
3003
|
|
|
|
|
|
|
{ |
3004
|
|
|
|
|
|
|
"#cdata-section"; |
3005
|
|
|
|
|
|
|
} |
3006
|
|
|
|
|
|
|
|
3007
|
|
|
|
|
|
|
sub getNodeType |
3008
|
|
|
|
|
|
|
{ |
3009
|
|
|
|
|
|
|
CDATA_SECTION_NODE; |
3010
|
|
|
|
|
|
|
} |
3011
|
|
|
|
|
|
|
|
3012
|
|
|
|
|
|
|
sub cloneNode |
3013
|
|
|
|
|
|
|
{ |
3014
|
|
|
|
|
|
|
my $self = shift; |
3015
|
|
|
|
|
|
|
$self->[_Doc]->createCDATASection ($self->getData); |
3016
|
|
|
|
|
|
|
} |
3017
|
|
|
|
|
|
|
|
3018
|
|
|
|
|
|
|
#------------------------------------------------------------ |
3019
|
|
|
|
|
|
|
# Extra method implementations |
3020
|
|
|
|
|
|
|
|
3021
|
|
|
|
|
|
|
sub isReadOnly |
3022
|
|
|
|
|
|
|
{ |
3023
|
|
|
|
|
|
|
0; |
3024
|
|
|
|
|
|
|
} |
3025
|
|
|
|
|
|
|
|
3026
|
|
|
|
|
|
|
sub print |
3027
|
|
|
|
|
|
|
{ |
3028
|
|
|
|
|
|
|
my ($self, $FILE) = @_; |
3029
|
|
|
|
|
|
|
$FILE->print ("
|
3030
|
|
|
|
|
|
|
$FILE->print (XML::DOM::encodeCDATA ($self->getData)); |
3031
|
|
|
|
|
|
|
$FILE->print ("]]>"); |
3032
|
|
|
|
|
|
|
} |
3033
|
|
|
|
|
|
|
|
3034
|
|
|
|
|
|
|
sub to_expat |
3035
|
|
|
|
|
|
|
{ |
3036
|
|
|
|
|
|
|
my ($self, $iter) = @_; |
3037
|
|
|
|
|
|
|
$iter->CData ($self->getData); |
3038
|
|
|
|
|
|
|
} |
3039
|
|
|
|
|
|
|
|
3040
|
|
|
|
|
|
|
sub _to_sax |
3041
|
|
|
|
|
|
|
{ |
3042
|
|
|
|
|
|
|
my ($self, $doch, $dtdh, $enth) = @_; |
3043
|
|
|
|
|
|
|
$doch->start_cdata; |
3044
|
|
|
|
|
|
|
$doch->characters ( { Data => $self->getData } ); |
3045
|
|
|
|
|
|
|
$doch->end_cdata; |
3046
|
|
|
|
|
|
|
} |
3047
|
|
|
|
|
|
|
|
3048
|
|
|
|
|
|
|
###################################################################### |
3049
|
|
|
|
|
|
|
package XML::DOM::Comment; |
3050
|
|
|
|
|
|
|
###################################################################### |
3051
|
|
|
|
|
|
|
use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; |
3052
|
|
|
|
|
|
|
|
3053
|
|
|
|
|
|
|
BEGIN |
3054
|
|
|
|
|
|
|
{ |
3055
|
|
|
|
|
|
|
import XML::DOM::CharacterData qw( :DEFAULT :Fields ); |
3056
|
|
|
|
|
|
|
import XML::DOM::Node qw( :DEFAULT :Fields ); |
3057
|
|
|
|
|
|
|
XML::DOM::def_fields ("", "XML::DOM::CharacterData"); |
3058
|
|
|
|
|
|
|
} |
3059
|
|
|
|
|
|
|
|
3060
|
|
|
|
|
|
|
use XML::DOM::DOMException; |
3061
|
|
|
|
|
|
|
use Carp; |
3062
|
|
|
|
|
|
|
|
3063
|
|
|
|
|
|
|
#?? setData - could check comment for double minus |
3064
|
|
|
|
|
|
|
|
3065
|
|
|
|
|
|
|
sub getNodeType |
3066
|
|
|
|
|
|
|
{ |
3067
|
|
|
|
|
|
|
COMMENT_NODE; |
3068
|
|
|
|
|
|
|
} |
3069
|
|
|
|
|
|
|
|
3070
|
|
|
|
|
|
|
sub getNodeName |
3071
|
|
|
|
|
|
|
{ |
3072
|
|
|
|
|
|
|
"#comment"; |
3073
|
|
|
|
|
|
|
} |
3074
|
|
|
|
|
|
|
|
3075
|
|
|
|
|
|
|
sub cloneNode |
3076
|
|
|
|
|
|
|
{ |
3077
|
|
|
|
|
|
|
my $self = shift; |
3078
|
|
|
|
|
|
|
$self->[_Doc]->createComment ($self->getData); |
3079
|
|
|
|
|
|
|
} |
3080
|
|
|
|
|
|
|
|
3081
|
|
|
|
|
|
|
#------------------------------------------------------------ |
3082
|
|
|
|
|
|
|
# Extra method implementations |
3083
|
|
|
|
|
|
|
|
3084
|
|
|
|
|
|
|
sub isReadOnly |
3085
|
|
|
|
|
|
|
{ |
3086
|
|
|
|
|
|
|
return 0 if $XML::DOM::IgnoreReadOnly; |
3087
|
|
|
|
|
|
|
|
3088
|
|
|
|
|
|
|
my $pa = $_[0]->[_Parent]; |
3089
|
|
|
|
|
|
|
defined ($pa) ? $pa->isReadOnly : 0; |
3090
|
|
|
|
|
|
|
} |
3091
|
|
|
|
|
|
|
|
3092
|
|
|
|
|
|
|
sub print |
3093
|
|
|
|
|
|
|
{ |
3094
|
|
|
|
|
|
|
my ($self, $FILE) = @_; |
3095
|
|
|
|
|
|
|
my $comment = XML::DOM::encodeComment ($self->[_Data]); |
3096
|
|
|
|
|
|
|
|
3097
|
|
|
|
|
|
|
$FILE->print (""); |
3098
|
|
|
|
|
|
|
} |
3099
|
|
|
|
|
|
|
|
3100
|
|
|
|
|
|
|
sub to_expat |
3101
|
|
|
|
|
|
|
{ |
3102
|
|
|
|
|
|
|
my ($self, $iter) = @_; |
3103
|
|
|
|
|
|
|
$iter->Comment ($self->getData); |
3104
|
|
|
|
|
|
|
} |
3105
|
|
|
|
|
|
|
|
3106
|
|
|
|
|
|
|
sub _to_sax |
3107
|
|
|
|
|
|
|
{ |
3108
|
|
|
|
|
|
|
my ($self, $doch, $dtdh, $enth) = @_; |
3109
|
|
|
|
|
|
|
$doch->comment ( { Data => $self->getData }); |
3110
|
|
|
|
|
|
|
} |
3111
|
|
|
|
|
|
|
|
3112
|
|
|
|
|
|
|
###################################################################### |
3113
|
|
|
|
|
|
|
package XML::DOM::Text; |
3114
|
|
|
|
|
|
|
###################################################################### |
3115
|
|
|
|
|
|
|
use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; |
3116
|
|
|
|
|
|
|
|
3117
|
|
|
|
|
|
|
BEGIN |
3118
|
|
|
|
|
|
|
{ |
3119
|
|
|
|
|
|
|
import XML::DOM::CharacterData qw( :DEFAULT :Fields ); |
3120
|
|
|
|
|
|
|
import XML::DOM::Node qw( :DEFAULT :Fields ); |
3121
|
|
|
|
|
|
|
XML::DOM::def_fields ("", "XML::DOM::CharacterData"); |
3122
|
|
|
|
|
|
|
} |
3123
|
|
|
|
|
|
|
|
3124
|
|
|
|
|
|
|
use XML::DOM::DOMException; |
3125
|
|
|
|
|
|
|
use Carp; |
3126
|
|
|
|
|
|
|
|
3127
|
|
|
|
|
|
|
sub getNodeType |
3128
|
|
|
|
|
|
|
{ |
3129
|
|
|
|
|
|
|
TEXT_NODE; |
3130
|
|
|
|
|
|
|
} |
3131
|
|
|
|
|
|
|
|
3132
|
|
|
|
|
|
|
sub getNodeName |
3133
|
|
|
|
|
|
|
{ |
3134
|
|
|
|
|
|
|
"#text"; |
3135
|
|
|
|
|
|
|
} |
3136
|
|
|
|
|
|
|
|
3137
|
|
|
|
|
|
|
sub splitText |
3138
|
|
|
|
|
|
|
{ |
3139
|
|
|
|
|
|
|
my ($self, $offset) = @_; |
3140
|
|
|
|
|
|
|
|
3141
|
|
|
|
|
|
|
my $data = $self->getData; |
3142
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (INDEX_SIZE_ERR, |
3143
|
|
|
|
|
|
|
"bad offset [$offset]") |
3144
|
|
|
|
|
|
|
if ($offset < 0 || $offset >= length ($data)); |
3145
|
|
|
|
|
|
|
#?? DOM Spec says >, but >= makes more sense! |
3146
|
|
|
|
|
|
|
|
3147
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, |
3148
|
|
|
|
|
|
|
"node is ReadOnly") |
3149
|
|
|
|
|
|
|
if $self->isReadOnly; |
3150
|
|
|
|
|
|
|
|
3151
|
|
|
|
|
|
|
my $rest = substr ($data, $offset); |
3152
|
|
|
|
|
|
|
|
3153
|
|
|
|
|
|
|
$self->setData (substr ($data, 0, $offset)); |
3154
|
|
|
|
|
|
|
my $node = $self->[_Doc]->createTextNode ($rest); |
3155
|
|
|
|
|
|
|
|
3156
|
|
|
|
|
|
|
# insert new node after this node |
3157
|
|
|
|
|
|
|
$self->[_Parent]->insertBefore ($node, $self->getNextSibling); |
3158
|
|
|
|
|
|
|
|
3159
|
|
|
|
|
|
|
$node; |
3160
|
|
|
|
|
|
|
} |
3161
|
|
|
|
|
|
|
|
3162
|
|
|
|
|
|
|
sub cloneNode |
3163
|
|
|
|
|
|
|
{ |
3164
|
|
|
|
|
|
|
my $self = shift; |
3165
|
|
|
|
|
|
|
$self->[_Doc]->createTextNode ($self->getData); |
3166
|
|
|
|
|
|
|
} |
3167
|
|
|
|
|
|
|
|
3168
|
|
|
|
|
|
|
#------------------------------------------------------------ |
3169
|
|
|
|
|
|
|
# Extra method implementations |
3170
|
|
|
|
|
|
|
|
3171
|
|
|
|
|
|
|
sub isReadOnly |
3172
|
|
|
|
|
|
|
{ |
3173
|
|
|
|
|
|
|
0; |
3174
|
|
|
|
|
|
|
} |
3175
|
|
|
|
|
|
|
|
3176
|
|
|
|
|
|
|
sub print |
3177
|
|
|
|
|
|
|
{ |
3178
|
|
|
|
|
|
|
my ($self, $FILE) = @_; |
3179
|
|
|
|
|
|
|
$FILE->print (XML::DOM::encodeText ($self->getData, '<&>"')); |
3180
|
|
|
|
|
|
|
} |
3181
|
|
|
|
|
|
|
|
3182
|
|
|
|
|
|
|
sub isTextNode |
3183
|
|
|
|
|
|
|
{ |
3184
|
|
|
|
|
|
|
1; |
3185
|
|
|
|
|
|
|
} |
3186
|
|
|
|
|
|
|
|
3187
|
|
|
|
|
|
|
sub to_expat |
3188
|
|
|
|
|
|
|
{ |
3189
|
|
|
|
|
|
|
my ($self, $iter) = @_; |
3190
|
|
|
|
|
|
|
$iter->Char ($self->getData); |
3191
|
|
|
|
|
|
|
} |
3192
|
|
|
|
|
|
|
|
3193
|
|
|
|
|
|
|
sub _to_sax |
3194
|
|
|
|
|
|
|
{ |
3195
|
|
|
|
|
|
|
my ($self, $doch, $dtdh, $enth) = @_; |
3196
|
|
|
|
|
|
|
$doch->characters ( { Data => $self->getData } ); |
3197
|
|
|
|
|
|
|
} |
3198
|
|
|
|
|
|
|
|
3199
|
|
|
|
|
|
|
###################################################################### |
3200
|
|
|
|
|
|
|
package XML::DOM::XMLDecl; |
3201
|
|
|
|
|
|
|
###################################################################### |
3202
|
|
|
|
|
|
|
use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; |
3203
|
|
|
|
|
|
|
|
3204
|
|
|
|
|
|
|
BEGIN |
3205
|
|
|
|
|
|
|
{ |
3206
|
|
|
|
|
|
|
import XML::DOM::Node qw( :DEFAULT :Fields ); |
3207
|
|
|
|
|
|
|
XML::DOM::def_fields ("Version Encoding Standalone", "XML::DOM::Node"); |
3208
|
|
|
|
|
|
|
} |
3209
|
|
|
|
|
|
|
|
3210
|
|
|
|
|
|
|
use XML::DOM::DOMException; |
3211
|
|
|
|
|
|
|
|
3212
|
|
|
|
|
|
|
|
3213
|
|
|
|
|
|
|
#------------------------------------------------------------ |
3214
|
|
|
|
|
|
|
# Extra method implementations |
3215
|
|
|
|
|
|
|
|
3216
|
|
|
|
|
|
|
# XMLDecl is not part of the DOM Spec |
3217
|
|
|
|
|
|
|
sub new |
3218
|
|
|
|
|
|
|
{ |
3219
|
|
|
|
|
|
|
my ($class, $doc, $version, $encoding, $standalone) = @_; |
3220
|
|
|
|
|
|
|
|
3221
|
|
|
|
|
|
|
my $self = bless [], $class; |
3222
|
|
|
|
|
|
|
|
3223
|
|
|
|
|
|
|
$self->[_Doc] = $doc; |
3224
|
|
|
|
|
|
|
$self->[_Version] = $version if defined $version; |
3225
|
|
|
|
|
|
|
$self->[_Encoding] = $encoding if defined $encoding; |
3226
|
|
|
|
|
|
|
$self->[_Standalone] = $standalone if defined $standalone; |
3227
|
|
|
|
|
|
|
|
3228
|
|
|
|
|
|
|
$self; |
3229
|
|
|
|
|
|
|
} |
3230
|
|
|
|
|
|
|
|
3231
|
|
|
|
|
|
|
sub setVersion |
3232
|
|
|
|
|
|
|
{ |
3233
|
|
|
|
|
|
|
if (defined $_[1]) |
3234
|
|
|
|
|
|
|
{ |
3235
|
|
|
|
|
|
|
$_[0]->[_Version] = $_[1]; |
3236
|
|
|
|
|
|
|
} |
3237
|
|
|
|
|
|
|
else |
3238
|
|
|
|
|
|
|
{ |
3239
|
|
|
|
|
|
|
undef $_[0]->[_Version]; # was delete |
3240
|
|
|
|
|
|
|
} |
3241
|
|
|
|
|
|
|
} |
3242
|
|
|
|
|
|
|
|
3243
|
|
|
|
|
|
|
sub getVersion |
3244
|
|
|
|
|
|
|
{ |
3245
|
|
|
|
|
|
|
$_[0]->[_Version]; |
3246
|
|
|
|
|
|
|
} |
3247
|
|
|
|
|
|
|
|
3248
|
|
|
|
|
|
|
sub setEncoding |
3249
|
|
|
|
|
|
|
{ |
3250
|
|
|
|
|
|
|
if (defined $_[1]) |
3251
|
|
|
|
|
|
|
{ |
3252
|
|
|
|
|
|
|
$_[0]->[_Encoding] = $_[1]; |
3253
|
|
|
|
|
|
|
} |
3254
|
|
|
|
|
|
|
else |
3255
|
|
|
|
|
|
|
{ |
3256
|
|
|
|
|
|
|
undef $_[0]->[_Encoding]; # was delete |
3257
|
|
|
|
|
|
|
} |
3258
|
|
|
|
|
|
|
} |
3259
|
|
|
|
|
|
|
|
3260
|
|
|
|
|
|
|
sub getEncoding |
3261
|
|
|
|
|
|
|
{ |
3262
|
|
|
|
|
|
|
$_[0]->[_Encoding]; |
3263
|
|
|
|
|
|
|
} |
3264
|
|
|
|
|
|
|
|
3265
|
|
|
|
|
|
|
sub setStandalone |
3266
|
|
|
|
|
|
|
{ |
3267
|
|
|
|
|
|
|
if (defined $_[1]) |
3268
|
|
|
|
|
|
|
{ |
3269
|
|
|
|
|
|
|
$_[0]->[_Standalone] = $_[1]; |
3270
|
|
|
|
|
|
|
} |
3271
|
|
|
|
|
|
|
else |
3272
|
|
|
|
|
|
|
{ |
3273
|
|
|
|
|
|
|
undef $_[0]->[_Standalone]; # was delete |
3274
|
|
|
|
|
|
|
} |
3275
|
|
|
|
|
|
|
} |
3276
|
|
|
|
|
|
|
|
3277
|
|
|
|
|
|
|
sub getStandalone |
3278
|
|
|
|
|
|
|
{ |
3279
|
|
|
|
|
|
|
$_[0]->[_Standalone]; |
3280
|
|
|
|
|
|
|
} |
3281
|
|
|
|
|
|
|
|
3282
|
|
|
|
|
|
|
sub getNodeType |
3283
|
|
|
|
|
|
|
{ |
3284
|
|
|
|
|
|
|
XML_DECL_NODE; |
3285
|
|
|
|
|
|
|
} |
3286
|
|
|
|
|
|
|
|
3287
|
|
|
|
|
|
|
sub cloneNode |
3288
|
|
|
|
|
|
|
{ |
3289
|
|
|
|
|
|
|
my $self = shift; |
3290
|
|
|
|
|
|
|
|
3291
|
|
|
|
|
|
|
new XML::DOM::XMLDecl ($self->[_Doc], $self->[_Version], |
3292
|
|
|
|
|
|
|
$self->[_Encoding], $self->[_Standalone]); |
3293
|
|
|
|
|
|
|
} |
3294
|
|
|
|
|
|
|
|
3295
|
|
|
|
|
|
|
sub print |
3296
|
|
|
|
|
|
|
{ |
3297
|
|
|
|
|
|
|
my ($self, $FILE) = @_; |
3298
|
|
|
|
|
|
|
|
3299
|
|
|
|
|
|
|
my $version = $self->[_Version]; |
3300
|
|
|
|
|
|
|
my $encoding = $self->[_Encoding]; |
3301
|
|
|
|
|
|
|
my $standalone = $self->[_Standalone]; |
3302
|
|
|
|
|
|
|
$standalone = ($standalone ? "yes" : "no") if defined $standalone; |
3303
|
|
|
|
|
|
|
|
3304
|
|
|
|
|
|
|
$FILE->print ("
|
3305
|
|
|
|
|
|
|
$FILE->print (" version=\"$version\"") if defined $version; |
3306
|
|
|
|
|
|
|
$FILE->print (" encoding=\"$encoding\"") if defined $encoding; |
3307
|
|
|
|
|
|
|
$FILE->print (" standalone=\"$standalone\"") if defined $standalone; |
3308
|
|
|
|
|
|
|
$FILE->print ("?>"); |
3309
|
|
|
|
|
|
|
} |
3310
|
|
|
|
|
|
|
|
3311
|
|
|
|
|
|
|
sub to_expat |
3312
|
|
|
|
|
|
|
{ |
3313
|
|
|
|
|
|
|
my ($self, $iter) = @_; |
3314
|
|
|
|
|
|
|
$iter->XMLDecl ($self->getVersion, $self->getEncoding, $self->getStandalone); |
3315
|
|
|
|
|
|
|
} |
3316
|
|
|
|
|
|
|
|
3317
|
|
|
|
|
|
|
sub _to_sax |
3318
|
|
|
|
|
|
|
{ |
3319
|
|
|
|
|
|
|
my ($self, $doch, $dtdh, $enth) = @_; |
3320
|
|
|
|
|
|
|
$dtdh->xml_decl ( { Version => $self->getVersion, |
3321
|
|
|
|
|
|
|
Encoding => $self->getEncoding, |
3322
|
|
|
|
|
|
|
Standalone => $self->getStandalone } ); |
3323
|
|
|
|
|
|
|
} |
3324
|
|
|
|
|
|
|
|
3325
|
|
|
|
|
|
|
###################################################################### |
3326
|
|
|
|
|
|
|
package XML::DOM::DocumentFragment; |
3327
|
|
|
|
|
|
|
###################################################################### |
3328
|
|
|
|
|
|
|
use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; |
3329
|
|
|
|
|
|
|
|
3330
|
|
|
|
|
|
|
BEGIN |
3331
|
|
|
|
|
|
|
{ |
3332
|
|
|
|
|
|
|
import XML::DOM::Node qw( :DEFAULT :Fields ); |
3333
|
|
|
|
|
|
|
XML::DOM::def_fields ("", "XML::DOM::Node"); |
3334
|
|
|
|
|
|
|
} |
3335
|
|
|
|
|
|
|
|
3336
|
|
|
|
|
|
|
use XML::DOM::DOMException; |
3337
|
|
|
|
|
|
|
|
3338
|
|
|
|
|
|
|
sub new |
3339
|
|
|
|
|
|
|
{ |
3340
|
|
|
|
|
|
|
my ($class, $doc) = @_; |
3341
|
|
|
|
|
|
|
my $self = bless [], $class; |
3342
|
|
|
|
|
|
|
|
3343
|
|
|
|
|
|
|
$self->[_Doc] = $doc; |
3344
|
|
|
|
|
|
|
$self->[_C] = new XML::DOM::NodeList; |
3345
|
|
|
|
|
|
|
$self; |
3346
|
|
|
|
|
|
|
} |
3347
|
|
|
|
|
|
|
|
3348
|
|
|
|
|
|
|
sub getNodeType |
3349
|
|
|
|
|
|
|
{ |
3350
|
|
|
|
|
|
|
DOCUMENT_FRAGMENT_NODE; |
3351
|
|
|
|
|
|
|
} |
3352
|
|
|
|
|
|
|
|
3353
|
|
|
|
|
|
|
sub getNodeName |
3354
|
|
|
|
|
|
|
{ |
3355
|
|
|
|
|
|
|
"#document-fragment"; |
3356
|
|
|
|
|
|
|
} |
3357
|
|
|
|
|
|
|
|
3358
|
|
|
|
|
|
|
sub cloneNode |
3359
|
|
|
|
|
|
|
{ |
3360
|
|
|
|
|
|
|
my ($self, $deep) = @_; |
3361
|
|
|
|
|
|
|
my $node = $self->[_Doc]->createDocumentFragment; |
3362
|
|
|
|
|
|
|
|
3363
|
|
|
|
|
|
|
$node->cloneChildren ($self, $deep); |
3364
|
|
|
|
|
|
|
$node; |
3365
|
|
|
|
|
|
|
} |
3366
|
|
|
|
|
|
|
|
3367
|
|
|
|
|
|
|
#------------------------------------------------------------ |
3368
|
|
|
|
|
|
|
# Extra method implementations |
3369
|
|
|
|
|
|
|
|
3370
|
|
|
|
|
|
|
sub isReadOnly |
3371
|
|
|
|
|
|
|
{ |
3372
|
|
|
|
|
|
|
0; |
3373
|
|
|
|
|
|
|
} |
3374
|
|
|
|
|
|
|
|
3375
|
|
|
|
|
|
|
sub print |
3376
|
|
|
|
|
|
|
{ |
3377
|
|
|
|
|
|
|
my ($self, $FILE) = @_; |
3378
|
|
|
|
|
|
|
|
3379
|
|
|
|
|
|
|
for my $node (@{$self->[_C]}) |
3380
|
|
|
|
|
|
|
{ |
3381
|
|
|
|
|
|
|
$node->print ($FILE); |
3382
|
|
|
|
|
|
|
} |
3383
|
|
|
|
|
|
|
} |
3384
|
|
|
|
|
|
|
|
3385
|
|
|
|
|
|
|
sub rejectChild |
3386
|
|
|
|
|
|
|
{ |
3387
|
|
|
|
|
|
|
my $t = $_[1]->getNodeType; |
3388
|
|
|
|
|
|
|
|
3389
|
|
|
|
|
|
|
$t != TEXT_NODE |
3390
|
|
|
|
|
|
|
&& $t != ENTITY_REFERENCE_NODE |
3391
|
|
|
|
|
|
|
&& $t != PROCESSING_INSTRUCTION_NODE |
3392
|
|
|
|
|
|
|
&& $t != COMMENT_NODE |
3393
|
|
|
|
|
|
|
&& $t != CDATA_SECTION_NODE |
3394
|
|
|
|
|
|
|
&& $t != ELEMENT_NODE; |
3395
|
|
|
|
|
|
|
} |
3396
|
|
|
|
|
|
|
|
3397
|
|
|
|
|
|
|
sub isDocumentFragmentNode |
3398
|
|
|
|
|
|
|
{ |
3399
|
|
|
|
|
|
|
1; |
3400
|
|
|
|
|
|
|
} |
3401
|
|
|
|
|
|
|
|
3402
|
|
|
|
|
|
|
###################################################################### |
3403
|
|
|
|
|
|
|
package XML::DOM::DocumentType; # forward declaration |
3404
|
|
|
|
|
|
|
###################################################################### |
3405
|
|
|
|
|
|
|
|
3406
|
|
|
|
|
|
|
###################################################################### |
3407
|
|
|
|
|
|
|
package XML::DOM::Document; |
3408
|
|
|
|
|
|
|
###################################################################### |
3409
|
|
|
|
|
|
|
use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; |
3410
|
|
|
|
|
|
|
|
3411
|
|
|
|
|
|
|
BEGIN |
3412
|
|
|
|
|
|
|
{ |
3413
|
|
|
|
|
|
|
import XML::DOM::Node qw( :DEFAULT :Fields ); |
3414
|
|
|
|
|
|
|
XML::DOM::def_fields ("Doctype XmlDecl", "XML::DOM::Node"); |
3415
|
|
|
|
|
|
|
} |
3416
|
|
|
|
|
|
|
|
3417
|
|
|
|
|
|
|
use Carp; |
3418
|
|
|
|
|
|
|
use XML::DOM::NodeList; |
3419
|
|
|
|
|
|
|
use XML::DOM::DOMException; |
3420
|
|
|
|
|
|
|
|
3421
|
|
|
|
|
|
|
sub new |
3422
|
|
|
|
|
|
|
{ |
3423
|
|
|
|
|
|
|
my ($class) = @_; |
3424
|
|
|
|
|
|
|
my $self = bless [], $class; |
3425
|
|
|
|
|
|
|
|
3426
|
|
|
|
|
|
|
# keep Doc pointer, even though getOwnerDocument returns undef |
3427
|
|
|
|
|
|
|
$self->[_Doc] = $self; |
3428
|
|
|
|
|
|
|
$self->[_C] = new XML::DOM::NodeList; |
3429
|
|
|
|
|
|
|
$self; |
3430
|
|
|
|
|
|
|
} |
3431
|
|
|
|
|
|
|
|
3432
|
|
|
|
|
|
|
sub getNodeType |
3433
|
|
|
|
|
|
|
{ |
3434
|
|
|
|
|
|
|
DOCUMENT_NODE; |
3435
|
|
|
|
|
|
|
} |
3436
|
|
|
|
|
|
|
|
3437
|
|
|
|
|
|
|
sub getNodeName |
3438
|
|
|
|
|
|
|
{ |
3439
|
|
|
|
|
|
|
"#document"; |
3440
|
|
|
|
|
|
|
} |
3441
|
|
|
|
|
|
|
|
3442
|
|
|
|
|
|
|
#?? not sure about keeping a fixed order of these nodes.... |
3443
|
|
|
|
|
|
|
sub getDoctype |
3444
|
|
|
|
|
|
|
{ |
3445
|
|
|
|
|
|
|
$_[0]->[_Doctype]; |
3446
|
|
|
|
|
|
|
} |
3447
|
|
|
|
|
|
|
|
3448
|
|
|
|
|
|
|
sub getDocumentElement |
3449
|
|
|
|
|
|
|
{ |
3450
|
|
|
|
|
|
|
my ($self) = @_; |
3451
|
|
|
|
|
|
|
for my $kid (@{$self->[_C]}) |
3452
|
|
|
|
|
|
|
{ |
3453
|
|
|
|
|
|
|
return $kid if $kid->isElementNode; |
3454
|
|
|
|
|
|
|
} |
3455
|
|
|
|
|
|
|
undef; |
3456
|
|
|
|
|
|
|
} |
3457
|
|
|
|
|
|
|
|
3458
|
|
|
|
|
|
|
sub getOwnerDocument |
3459
|
|
|
|
|
|
|
{ |
3460
|
|
|
|
|
|
|
undef; |
3461
|
|
|
|
|
|
|
} |
3462
|
|
|
|
|
|
|
|
3463
|
|
|
|
|
|
|
sub getImplementation |
3464
|
|
|
|
|
|
|
{ |
3465
|
|
|
|
|
|
|
$XML::DOM::DOMImplementation::Singleton; |
3466
|
|
|
|
|
|
|
} |
3467
|
|
|
|
|
|
|
|
3468
|
|
|
|
|
|
|
# |
3469
|
|
|
|
|
|
|
# Added extra parameters ($val, $specified) that are passed straight to the |
3470
|
|
|
|
|
|
|
# Attr constructor |
3471
|
|
|
|
|
|
|
# |
3472
|
|
|
|
|
|
|
sub createAttribute |
3473
|
|
|
|
|
|
|
{ |
3474
|
|
|
|
|
|
|
new XML::DOM::Attr (@_); |
3475
|
|
|
|
|
|
|
} |
3476
|
|
|
|
|
|
|
|
3477
|
|
|
|
|
|
|
sub createCDATASection |
3478
|
|
|
|
|
|
|
{ |
3479
|
|
|
|
|
|
|
new XML::DOM::CDATASection (@_); |
3480
|
|
|
|
|
|
|
} |
3481
|
|
|
|
|
|
|
|
3482
|
|
|
|
|
|
|
sub createComment |
3483
|
|
|
|
|
|
|
{ |
3484
|
|
|
|
|
|
|
new XML::DOM::Comment (@_); |
3485
|
|
|
|
|
|
|
|
3486
|
|
|
|
|
|
|
} |
3487
|
|
|
|
|
|
|
|
3488
|
|
|
|
|
|
|
sub createElement |
3489
|
|
|
|
|
|
|
{ |
3490
|
|
|
|
|
|
|
new XML::DOM::Element (@_); |
3491
|
|
|
|
|
|
|
} |
3492
|
|
|
|
|
|
|
|
3493
|
|
|
|
|
|
|
sub createTextNode |
3494
|
|
|
|
|
|
|
{ |
3495
|
|
|
|
|
|
|
new XML::DOM::Text (@_); |
3496
|
|
|
|
|
|
|
} |
3497
|
|
|
|
|
|
|
|
3498
|
|
|
|
|
|
|
sub createProcessingInstruction |
3499
|
|
|
|
|
|
|
{ |
3500
|
|
|
|
|
|
|
new XML::DOM::ProcessingInstruction (@_); |
3501
|
|
|
|
|
|
|
} |
3502
|
|
|
|
|
|
|
|
3503
|
|
|
|
|
|
|
sub createEntityReference |
3504
|
|
|
|
|
|
|
{ |
3505
|
|
|
|
|
|
|
new XML::DOM::EntityReference (@_); |
3506
|
|
|
|
|
|
|
} |
3507
|
|
|
|
|
|
|
|
3508
|
|
|
|
|
|
|
sub createDocumentFragment |
3509
|
|
|
|
|
|
|
{ |
3510
|
|
|
|
|
|
|
new XML::DOM::DocumentFragment (@_); |
3511
|
|
|
|
|
|
|
} |
3512
|
|
|
|
|
|
|
|
3513
|
|
|
|
|
|
|
sub createDocumentType |
3514
|
|
|
|
|
|
|
{ |
3515
|
|
|
|
|
|
|
new XML::DOM::DocumentType (@_); |
3516
|
|
|
|
|
|
|
} |
3517
|
|
|
|
|
|
|
|
3518
|
|
|
|
|
|
|
sub cloneNode |
3519
|
|
|
|
|
|
|
{ |
3520
|
|
|
|
|
|
|
my ($self, $deep) = @_; |
3521
|
|
|
|
|
|
|
my $node = new XML::DOM::Document; |
3522
|
|
|
|
|
|
|
|
3523
|
|
|
|
|
|
|
$node->cloneChildren ($self, $deep); |
3524
|
|
|
|
|
|
|
|
3525
|
|
|
|
|
|
|
my $xmlDecl = $self->[_XmlDecl]; |
3526
|
|
|
|
|
|
|
$node->[_XmlDecl] = $xmlDecl->cloneNode ($deep) if defined $xmlDecl; |
3527
|
|
|
|
|
|
|
|
3528
|
|
|
|
|
|
|
$node; |
3529
|
|
|
|
|
|
|
} |
3530
|
|
|
|
|
|
|
|
3531
|
|
|
|
|
|
|
sub appendChild |
3532
|
|
|
|
|
|
|
{ |
3533
|
|
|
|
|
|
|
my ($self, $node) = @_; |
3534
|
|
|
|
|
|
|
|
3535
|
|
|
|
|
|
|
# Extra check: make sure we don't end up with more than one Element. |
3536
|
|
|
|
|
|
|
# Don't worry about multiple DocType nodes, because DocumentFragment |
3537
|
|
|
|
|
|
|
# can't contain DocType nodes. |
3538
|
|
|
|
|
|
|
|
3539
|
|
|
|
|
|
|
my @nodes = ($node); |
3540
|
|
|
|
|
|
|
@nodes = @{$node->[_C]} |
3541
|
|
|
|
|
|
|
if $node->getNodeType == DOCUMENT_FRAGMENT_NODE; |
3542
|
|
|
|
|
|
|
|
3543
|
|
|
|
|
|
|
my $elem = 0; |
3544
|
|
|
|
|
|
|
for my $n (@nodes) |
3545
|
|
|
|
|
|
|
{ |
3546
|
|
|
|
|
|
|
$elem++ if $n->isElementNode; |
3547
|
|
|
|
|
|
|
} |
3548
|
|
|
|
|
|
|
|
3549
|
|
|
|
|
|
|
if ($elem > 0 && defined ($self->getDocumentElement)) |
3550
|
|
|
|
|
|
|
{ |
3551
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, |
3552
|
|
|
|
|
|
|
"document can have only one Element"); |
3553
|
|
|
|
|
|
|
} |
3554
|
|
|
|
|
|
|
$self->SUPER::appendChild ($node); |
3555
|
|
|
|
|
|
|
} |
3556
|
|
|
|
|
|
|
|
3557
|
|
|
|
|
|
|
sub insertBefore |
3558
|
|
|
|
|
|
|
{ |
3559
|
|
|
|
|
|
|
my ($self, $node, $refNode) = @_; |
3560
|
|
|
|
|
|
|
|
3561
|
|
|
|
|
|
|
# Extra check: make sure sure we don't end up with more than 1 Elements. |
3562
|
|
|
|
|
|
|
# Don't worry about multiple DocType nodes, because DocumentFragment |
3563
|
|
|
|
|
|
|
# can't contain DocType nodes. |
3564
|
|
|
|
|
|
|
|
3565
|
|
|
|
|
|
|
my @nodes = ($node); |
3566
|
|
|
|
|
|
|
@nodes = @{$node->[_C]} |
3567
|
|
|
|
|
|
|
if $node->getNodeType == DOCUMENT_FRAGMENT_NODE; |
3568
|
|
|
|
|
|
|
|
3569
|
|
|
|
|
|
|
my $elem = 0; |
3570
|
|
|
|
|
|
|
for my $n (@nodes) |
3571
|
|
|
|
|
|
|
{ |
3572
|
|
|
|
|
|
|
$elem++ if $n->isElementNode; |
3573
|
|
|
|
|
|
|
} |
3574
|
|
|
|
|
|
|
|
3575
|
|
|
|
|
|
|
if ($elem > 0 && defined ($self->getDocumentElement)) |
3576
|
|
|
|
|
|
|
{ |
3577
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, |
3578
|
|
|
|
|
|
|
"document can have only one Element"); |
3579
|
|
|
|
|
|
|
} |
3580
|
|
|
|
|
|
|
$self->SUPER::insertBefore ($node, $refNode); |
3581
|
|
|
|
|
|
|
} |
3582
|
|
|
|
|
|
|
|
3583
|
|
|
|
|
|
|
sub replaceChild |
3584
|
|
|
|
|
|
|
{ |
3585
|
|
|
|
|
|
|
my ($self, $node, $refNode) = @_; |
3586
|
|
|
|
|
|
|
|
3587
|
|
|
|
|
|
|
# Extra check: make sure sure we don't end up with more than 1 Elements. |
3588
|
|
|
|
|
|
|
# Don't worry about multiple DocType nodes, because DocumentFragment |
3589
|
|
|
|
|
|
|
# can't contain DocType nodes. |
3590
|
|
|
|
|
|
|
|
3591
|
|
|
|
|
|
|
my @nodes = ($node); |
3592
|
|
|
|
|
|
|
@nodes = @{$node->[_C]} |
3593
|
|
|
|
|
|
|
if $node->getNodeType == DOCUMENT_FRAGMENT_NODE; |
3594
|
|
|
|
|
|
|
|
3595
|
|
|
|
|
|
|
my $elem = 0; |
3596
|
|
|
|
|
|
|
$elem-- if $refNode->isElementNode; |
3597
|
|
|
|
|
|
|
|
3598
|
|
|
|
|
|
|
for my $n (@nodes) |
3599
|
|
|
|
|
|
|
{ |
3600
|
|
|
|
|
|
|
$elem++ if $n->isElementNode; |
3601
|
|
|
|
|
|
|
} |
3602
|
|
|
|
|
|
|
|
3603
|
|
|
|
|
|
|
if ($elem > 0 && defined ($self->getDocumentElement)) |
3604
|
|
|
|
|
|
|
{ |
3605
|
|
|
|
|
|
|
croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, |
3606
|
|
|
|
|
|
|
"document can have only one Element"); |
3607
|
|
|
|
|
|
|
} |
3608
|
|
|
|
|
|
|
$self->SUPER::replaceChild ($node, $refNode); |
3609
|
|
|
|
|
|
|
} |
3610
|
|
|
|
|
|
|
|
3611
|
|
|
|
|
|
|
#------------------------------------------------------------ |
3612
|
|
|
|
|
|
|
# Extra method implementations |
3613
|
|
|
|
|
|
|
|
3614
|
|
|
|
|
|
|
sub isReadOnly |
3615
|
|
|
|
|
|
|
{ |
3616
|
|
|
|
|
|
|
0; |
3617
|
|
|
|
|
|
|
} |
3618
|
|
|
|
|
|
|
|
3619
|
|
|
|
|
|
|
sub print |
3620
|
|
|
|
|
|
|
{ |
3621
|
|
|
|
|
|
|
my ($self, $FILE) = @_; |
3622
|
|
|
|
|
|
|
|
3623
|
|
|
|
|
|
|
my $xmlDecl = $self->getXMLDecl; |
3624
|
|
|
|
|
|
|
if (defined $xmlDecl) |
3625
|
|
|
|
|
|
|
{ |
3626
|
|
|
|
|
|
|
$xmlDecl->print ($FILE); |
3627
|
|
|
|
|
|
|
$FILE->print ("\x0A"); |
3628
|
|
|
|
|
|
|
} |
3629
|
|
|
|
|
|
|
|
3630
|
|
|
|
|
|
|
for my $node (@{$self->[_C]}) |
3631
|
|
|
|
|
|
|
{ |
3632
|
|
|
|
|
|
|
$node->print ($FILE); |
3633
|
|
|
|
|
|
|
$FILE->print ("\x0A"); |
3634
|
|
|
|
|
|
|
} |
3635
|
|
|
|
|
|
|
} |
3636
|
|
|
|
|
|
|
|
3637
|
|
|
|
|
|
|
sub setDoctype |
3638
|
|
|
|
|
|
|
{ |
3639
|
|
|
|
|
|
|
my ($self, $doctype) = @_; |
3640
|
|
|
|
|
|
|
my $oldDoctype = $self->[_Doctype]; |
3641
|
|
|
|
|
|
|
if (defined $oldDoctype) |
3642
|
|
|
|
|
|
|
{ |
3643
|
|
|
|
|
|
|
$self->replaceChild ($doctype, $oldDoctype); |
3644
|
|
|
|
|
|
|
} |
3645
|
|
|
|
|
|
|
else |
3646
|
|
|
|
|
|
|
{ |
3647
|
|
|
|
|
|
|
#?? before root element, but after XmlDecl ! |
3648
|
|
|
|
|
|
|
$self->appendChild ($doctype); |
3649
|
|
|
|
|
|
|
} |
3650
|
|
|
|
|
|
|
$_[0]->[_Doctype] = $_[1]; |
3651
|
|
|
|
|
|
|
} |
3652
|
|
|
|
|
|
|
|
3653
|
|
|
|
|
|
|
sub removeDoctype |
3654
|
|
|
|
|
|
|
{ |
3655
|
|
|
|
|
|
|
my $self = shift; |
3656
|
|
|
|
|
|
|
my $doctype = $self->removeChild ($self->[_Doctype]); |
3657
|
|
|
|
|
|
|
|
3658
|
|
|
|
|
|
|
undef $self->[_Doctype]; # was delete |
3659
|
|
|
|
|
|
|
$doctype; |
3660
|
|
|
|
|
|
|
} |
3661
|
|
|
|
|
|
|
|
3662
|
|
|
|
|
|
|
sub rejectChild |
3663
|
|
|
|
|
|
|
{ |
3664
|
|
|
|
|
|
|
my $t = $_[1]->getNodeType; |
3665
|
|
|
|
|
|
|
$t != ELEMENT_NODE |
3666
|
|
|
|
|
|
|
&& $t != PROCESSING_INSTRUCTION_NODE |
3667
|
|
|
|
|
|
|
&& $t != COMMENT_NODE |
3668
|
|
|
|
|
|
|
&& $t != DOCUMENT_TYPE_NODE; |
3669
|
|
|
|
|
|
|
} |
3670
|
|
|
|
|
|
|
|
3671
|
|
|
|
|
|
|
sub expandEntity |
3672
|
|
|
|
|
|
|
{ |
3673
|
|
|
|
|
|
|
my ($self, $ent, $param) = @_; |
3674
|
|
|
|
|
|
|
my $doctype = $self->getDoctype; |
3675
|
|
|
|
|
|
|
|
3676
|
|
|
|
|
|
|
(defined $doctype) ? $doctype->expandEntity ($ent, $param) : undef; |
3677
|
|
|
|
|
|
|
} |
3678
|
|
|
|
|
|
|
|
3679
|
|
|
|
|
|
|
sub getDefaultAttrValue |
3680
|
|
|
|
|
|
|
{ |
3681
|
|
|
|
|
|
|
my ($self, $elem, $attr) = @_; |
3682
|
|
|
|
|
|
|
|
3683
|
|
|
|
|
|
|
my $doctype = $self->getDoctype; |
3684
|
|
|
|
|
|
|
|
3685
|
|
|
|
|
|
|
(defined $doctype) ? $doctype->getDefaultAttrValue ($elem, $attr) : undef; |
3686
|
|
|
|
|
|
|
} |
3687
|
|
|
|
|
|
|
|
3688
|
|
|
|
|
|
|
sub getEntity |
3689
|
|
|
|
|
|
|
{ |
3690
|
|
|
|
|
|
|
my ($self, $entity) = @_; |
3691
|
|
|
|
|
|
|
|
3692
|
|
|
|
|
|
|
my $doctype = $self->getDoctype; |
3693
|
|
|
|
|
|
|
|
3694
|
|
|
|
|
|
|
(defined $doctype) ? $doctype->getEntity ($entity) : undef; |
3695
|
|
|
|
|
|
|
} |
3696
|
|
|
|
|
|
|
|
3697
|
|
|
|
|
|
|
sub dispose |
3698
|
|
|
|
|
|
|
{ |
3699
|
|
|
|
|
|
|
my $self = shift; |
3700
|
|
|
|
|
|
|
|
3701
|
|
|
|
|
|
|
$self->[_XmlDecl]->dispose if defined $self->[_XmlDecl]; |
3702
|
|
|
|
|
|
|
undef $self->[_XmlDecl]; # was delete |
3703
|
|
|
|
|
|
|
undef $self->[_Doctype]; # was delete |
3704
|
|
|
|
|
|
|
$self->SUPER::dispose; |
3705
|
|
|
|
|
|
|
} |
3706
|
|
|
|
|
|
|
|
3707
|
|
|
|
|
|
|
sub setOwnerDocument |
3708
|
|
|
|
|
|
|
{ |
3709
|
|
|
|
|
|
|
# Do nothing, you can't change the owner document! |
3710
|
|
|
|
|
|
|
#?? could throw exception... |
3711
|
|
|
|
|
|
|
} |
3712
|
|
|
|
|
|
|
|
3713
|
|
|
|
|
|
|
sub getXMLDecl |
3714
|
|
|
|
|
|
|
{ |
3715
|
|
|
|
|
|
|
$_[0]->[_XmlDecl]; |
3716
|
|
|
|
|
|
|
} |
3717
|
|
|
|
|
|
|
|
3718
|
|
|
|
|
|
|
sub setXMLDecl |
3719
|
|
|
|
|
|
|
{ |
3720
|
|
|
|
|
|
|
$_[0]->[_XmlDecl] = $_[1]; |
3721
|
|
|
|
|
|
|
} |
3722
|
|
|
|
|
|
|
|
3723
|
|
|
|
|
|
|
sub createXMLDecl |
3724
|
|
|
|
|
|
|
{ |
3725
|
|
|
|
|
|
|
new XML::DOM::XMLDecl (@_); |
3726
|
|
|
|
|
|
|
} |
3727
|
|
|
|
|
|
|
|
3728
|
|
|
|
|
|
|
sub createNotation |
3729
|
|
|
|
|
|
|
{ |
3730
|
|
|
|
|
|
|
new XML::DOM::Notation (@_); |
3731
|
|
|
|
|
|
|
} |
3732
|
|
|
|
|
|
|
|
3733
|
|
|
|
|
|
|
sub createElementDecl |
3734
|
|
|
|
|
|
|
{ |
3735
|
|
|
|
|
|
|
new XML::DOM::ElementDecl (@_); |
3736
|
|
|
|
|
|
|
} |
3737
|
|
|
|
|
|
|
|
3738
|
|
|
|
|
|
|
sub createAttlistDecl |
3739
|
|
|
|
|
|
|
{ |
3740
|
|
|
|
|
|
|
new XML::DOM::AttlistDecl (@_); |
3741
|
|
|
|
|
|
|
} |
3742
|
|
|
|
|
|
|
|
3743
|
|
|
|
|
|
|
sub createEntity |
3744
|
|
|
|
|
|
|
{ |
3745
|
|
|
|
|
|
|
new XML::DOM::Entity (@_); |
3746
|
|
|
|
|
|
|
} |
3747
|
|
|
|
|
|
|
|
3748
|
|
|
|
|
|
|
sub createChecker |
3749
|
|
|
|
|
|
|
{ |
3750
|
|
|
|
|
|
|
my $self = shift; |
3751
|
|
|
|
|
|
|
my $checker = XML::Checker->new; |
3752
|
|
|
|
|
|
|
|
3753
|
|
|
|
|
|
|
$checker->Init; |
3754
|
|
|
|
|
|
|
my $doctype = $self->getDoctype; |
3755
|
|
|
|
|
|
|
$doctype->to_expat ($checker) if $doctype; |
3756
|
|
|
|
|
|
|
$checker->Final; |
3757
|
|
|
|
|
|
|
|
3758
|
|
|
|
|
|
|
$checker; |
3759
|
|
|
|
|
|
|
} |
3760
|
|
|
|
|
|
|
|
3761
|
|
|
|
|
|
|
sub check |
3762
|
|
|
|
|
|
|
{ |
3763
|
|
|
|
|
|
|
my ($self, $checker) = @_; |
3764
|
|
|
|
|
|
|
$checker ||= XML::Checker->new; |
3765
|
|
|
|
|
|
|
|
3766
|
|
|
|
|
|
|
$self->to_expat ($checker); |
3767
|
|
|
|
|
|
|
} |
3768
|
|
|
|
|
|
|
|
3769
|
|
|
|
|
|
|
sub to_expat |
3770
|
|
|
|
|
|
|
{ |
3771
|
|
|
|
|
|
|
my ($self, $iter) = @_; |
3772
|
|
|
|
|
|
|
|
3773
|
|
|
|
|
|
|
$iter->Init; |
3774
|
|
|
|
|
|
|
|
3775
|
|
|
|
|
|
|
for my $kid ($self->getChildNodes) |
3776
|
|
|
|
|
|
|
{ |
3777
|
|
|
|
|
|
|
$kid->to_expat ($iter); |
3778
|
|
|
|
|
|
|
} |
3779
|
|
|
|
|
|
|
$iter->Final; |
3780
|
|
|
|
|
|
|
} |
3781
|
|
|
|
|
|
|
|
3782
|
|
|
|
|
|
|
sub check_sax |
3783
|
|
|
|
|
|
|
{ |
3784
|
|
|
|
|
|
|
my ($self, $checker) = @_; |
3785
|
|
|
|
|
|
|
$checker ||= XML::Checker->new; |
3786
|
|
|
|
|
|
|
|
3787
|
|
|
|
|
|
|
$self->to_sax (Handler => $checker); |
3788
|
|
|
|
|
|
|
} |
3789
|
|
|
|
|
|
|
|
3790
|
|
|
|
|
|
|
sub _to_sax |
3791
|
|
|
|
|
|
|
{ |
3792
|
|
|
|
|
|
|
my ($self, $doch, $dtdh, $enth) = @_; |
3793
|
|
|
|
|
|
|
|
3794
|
|
|
|
|
|
|
$doch->start_document; |
3795
|
|
|
|
|
|
|
|
3796
|
|
|
|
|
|
|
for my $kid ($self->getChildNodes) |
3797
|
|
|
|
|
|
|
{ |
3798
|
|
|
|
|
|
|
$kid->_to_sax ($doch, $dtdh, $enth); |
3799
|
|
|
|
|
|
|
} |
3800
|
|
|
|
|
|
|
$doch->end_document; |
3801
|
|
|
|
|
|
|
} |
3802
|
|
|
|
|
|
|
|
3803
|
|
|
|
|
|
|
###################################################################### |
3804
|
|
|
|
|
|
|
package XML::DOM::DocumentType; |
3805
|
|
|
|
|
|
|
###################################################################### |
3806
|
|
|
|
|
|
|
use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; |
3807
|
|
|
|
|
|
|
|
3808
|
|
|
|
|
|
|
BEGIN |
3809
|
|
|
|
|
|
|
{ |
3810
|
|
|
|
|
|
|
import XML::DOM::Node qw( :DEFAULT :Fields ); |
3811
|
|
|
|
|
|
|
import XML::DOM::Document qw( :Fields ); |
3812
|
|
|
|
|
|
|
XML::DOM::def_fields ("Entities Notations Name SysId PubId Internal", "XML::DOM::Node"); |
3813
|
|
|
|
|
|
|
} |
3814
|
|
|
|
|
|
|
|
3815
|
|
|
|
|
|
|
use XML::DOM::DOMException; |
3816
|
|
|
|
|
|
|
use XML::DOM::NamedNodeMap; |
3817
|
|
|
|
|
|
|
|
3818
|
|
|
|
|
|
|
sub new |
3819
|
|
|
|
|
|
|
{ |
3820
|
|
|
|
|
|
|
my $class = shift; |
3821
|
|
|
|
|
|
|
my $doc = shift; |
3822
|
|
|
|
|
|
|
|
3823
|
|
|
|
|
|
|
my $self = bless [], $class; |
3824
|
|
|
|
|
|
|
|
3825
|
|
|
|
|
|
|
$self->[_Doc] = $doc; |
3826
|
|
|
|
|
|
|
$self->[_ReadOnly] = 1; |
3827
|
|
|
|
|
|
|
$self->[_C] = new XML::DOM::NodeList; |
3828
|
|
|
|
|
|
|
|
3829
|
|
|
|
|
|
|
$self->[_Entities] = new XML::DOM::NamedNodeMap (Doc => $doc, |
3830
|
|
|
|
|
|
|
Parent => $self, |
3831
|
|
|
|
|
|
|
ReadOnly => 1); |
3832
|
|
|
|
|
|
|
$self->[_Notations] = new XML::DOM::NamedNodeMap (Doc => $doc, |
3833
|
|
|
|
|
|
|
Parent => $self, |
3834
|
|
|
|
|
|
|
ReadOnly => 1); |
3835
|
|
|
|
|
|
|
$self->setParams (@_); |
3836
|
|
|
|
|
|
|
$self; |
3837
|
|
|
|
|
|
|
} |
3838
|
|
|
|
|
|
|
|
3839
|
|
|
|
|
|
|
sub getNodeType |
3840
|
|
|
|
|
|
|
{ |
3841
|
|
|
|
|
|
|
DOCUMENT_TYPE_NODE; |
3842
|
|
|
|
|
|
|
} |
3843
|
|
|
|
|
|
|
|
3844
|
|
|
|
|
|
|
sub getNodeName |
3845
|
|
|
|
|
|
|
{ |
3846
|
|
|
|
|
|
|
$_[0]->[_Name]; |
3847
|
|
|
|
|
|
|
} |
3848
|
|
|
|
|
|
|
|
3849
|
|
|
|
|
|
|
sub getName |
3850
|
|
|
|
|
|
|
{ |
3851
|
|
|
|
|
|
|
$_[0]->[_Name]; |
3852
|
|
|
|
|
|
|
} |
3853
|
|
|
|
|
|
|
|
3854
|
|
|
|
|
|
|
sub getEntities |
3855
|
|
|
|
|
|
|
{ |
3856
|
|
|
|
|
|
|
$_[0]->[_Entities]; |
3857
|
|
|
|
|
|
|
} |
3858
|
|
|
|
|
|
|
|
3859
|
|
|
|
|
|
|
sub getNotations |
3860
|
|
|
|
|
|
|
{ |
3861
|
|
|
|
|
|
|
$_[0]->[_Notations]; |
3862
|
|
|
|
|
|
|
} |
3863
|
|
|
|
|
|
|
|
3864
|
|
|
|
|
|
|
sub setParentNode |
3865
|
|
|
|
|
|
|
{ |
3866
|
|
|
|
|
|
|
my ($self, $parent) = @_; |
3867
|
|
|
|
|
|
|
$self->SUPER::setParentNode ($parent); |
3868
|
|
|
|
|
|
|
|
3869
|
|
|
|
|
|
|
$parent->[_Doctype] = $self |
3870
|
|
|
|
|
|
|
if $parent->getNodeType == DOCUMENT_NODE; |
3871
|
|
|
|
|
|
|
} |
3872
|
|
|
|
|
|
|
|
3873
|
|
|
|
|
|
|
sub cloneNode |
3874
|
|
|
|
|
|
|
{ |
3875
|
|
|
|
|
|
|
my ($self, $deep) = @_; |
3876
|
|
|
|
|
|
|
|
3877
|
|
|
|
|
|
|
my $node = new XML::DOM::DocumentType ($self->[_Doc], $self->[_Name], |
3878
|
|
|
|
|
|
|
$self->[_SysId], $self->[_PubId], |
3879
|
|
|
|
|
|
|
$self->[_Internal]); |
3880
|
|
|
|
|
|
|
|
3881
|
|
|
|
|
|
|
#?? does it make sense to make a shallow copy? |
3882
|
|
|
|
|
|
|
|
3883
|
|
|
|
|
|
|
# clone the NamedNodeMaps |
3884
|
|
|
|
|
|
|
$node->[_Entities] = $self->[_Entities]->cloneNode ($deep); |
3885
|
|
|
|
|
|
|
|
3886
|
|
|
|
|
|
|
$node->[_Notations] = $self->[_Notations]->cloneNode ($deep); |
3887
|
|
|
|
|
|
|
|
3888
|
|
|
|
|
|
|
$node->cloneChildren ($self, $deep); |
3889
|
|
|
|
|
|
|
|
3890
|
|
|
|
|
|
|
$node; |
3891
|
|
|
|
|
|
|
} |
3892
|
|
|
|
|
|
|
|
3893
|
|
|
|
|
|
|
#------------------------------------------------------------ |
3894
|
|
|
|
|
|
|
# Extra method implementations |
3895
|
|
|
|
|
|
|
|
3896
|
|
|
|
|
|
|
sub getSysId |
3897
|
|
|
|
|
|
|
{ |
3898
|
|
|
|
|
|
|
$_[0]->[_SysId]; |
3899
|
|
|
|
|
|
|
} |
3900
|
|
|
|
|
|
|
|
3901
|
|
|
|
|
|
|
sub getPubId |
3902
|
|
|
|
|
|
|
{ |
3903
|
|
|
|
|
|
|
$_[0]->[_PubId]; |
3904
|
|
|
|
|
|
|
} |
3905
|
|
|
|
|
|
|
|
3906
|
|
|
|
|
|
|
sub getInternal |
3907
|
|
|
|
|
|
|
{ |
3908
|
|
|
|
|
|
|
$_[0]->[_Internal]; |
3909
|
|
|
|
|
|
|
} |
3910
|
|
|
|
|
|
|
|
3911
|
|
|
|
|
|
|
sub setSysId |
3912
|
|
|
|
|
|
|
{ |
3913
|
|
|
|
|
|
|
$_[0]->[_SysId] = $_[1]; |
3914
|
|
|
|
|
|
|
} |
3915
|
|
|
|
|
|
|
|
3916
|
|
|
|
|
|
|
sub setPubId |
3917
|
|
|
|
|
|
|
{ |
3918
|
|
|
|
|
|
|
$_[0]->[_PubId] = $_[1]; |
3919
|
|
|
|
|
|
|
} |
3920
|
|
|
|
|
|
|
|
3921
|
|
|
|
|
|
|
sub setInternal |
3922
|
|
|
|
|
|
|
{ |
3923
|
|
|
|
|
|
|
$_[0]->[_Internal] = $_[1]; |
3924
|
|
|
|
|
|
|
} |
3925
|
|
|
|
|
|
|
|
3926
|
|
|
|
|
|
|
sub setName |
3927
|
|
|
|
|
|
|
{ |
3928
|
|
|
|
|
|
|
$_[0]->[_Name] = $_[1]; |
3929
|
|
|
|
|
|
|
} |
3930
|
|
|
|
|
|
|
|
3931
|
|
|
|
|
|
|
sub removeChildHoodMemories |
3932
|
|
|
|
|
|
|
{ |
3933
|
|
|
|
|
|
|
my ($self, $dontWipeReadOnly) = @_; |
3934
|
|
|
|
|
|
|
|
3935
|
|
|
|
|
|
|
my $parent = $self->[_Parent]; |
3936
|
|
|
|
|
|
|
if (defined $parent && $parent->getNodeType == DOCUMENT_NODE) |
3937
|
|
|
|
|
|
|
{ |
3938
|
|
|
|
|
|
|
undef $parent->[_Doctype]; # was delete |
3939
|
|
|
|
|
|
|
} |
3940
|
|
|
|
|
|
|
$self->SUPER::removeChildHoodMemories; |
3941
|
|
|
|
|
|
|
} |
3942
|
|
|
|
|
|
|
|
3943
|
|
|
|
|
|
|
sub dispose |
3944
|
|
|
|
|
|
|
{ |
3945
|
|
|
|
|
|
|
my $self = shift; |
3946
|
|
|
|
|
|
|
|
3947
|
|
|
|
|
|
|
$self->[_Entities]->dispose; |
3948
|
|
|
|
|
|
|
$self->[_Notations]->dispose; |
3949
|
|
|
|
|
|
|
$self->SUPER::dispose; |
3950
|
|
|
|
|
|
|
} |
3951
|
|
|
|
|
|
|
|
3952
|
|
|
|
|
|
|
sub setOwnerDocument |
3953
|
|
|
|
|
|
|
{ |
3954
|
|
|
|
|
|
|
my ($self, $doc) = @_; |
3955
|
|
|
|
|
|
|
$self->SUPER::setOwnerDocument ($doc); |
3956
|
|
|
|
|
|
|
|
3957
|
|
|
|
|
|
|
$self->[_Entities]->setOwnerDocument ($doc); |
3958
|
|
|
|
|
|
|
$self->[_Notations]->setOwnerDocument ($doc); |
3959
|
|
|
|
|
|
|
} |
3960
|
|
|
|
|
|
|
|
3961
|
|
|
|
|
|
|
sub expandEntity |
3962
|
|
|
|
|
|
|
{ |
3963
|
|
|
|
|
|
|
my ($self, $ent, $param) = @_; |
3964
|
|
|
|
|
|
|
|
3965
|
|
|
|
|
|
|
my $kid = $self->[_Entities]->getNamedItem ($ent); |
3966
|
|
|
|
|
|
|
return $kid->getValue |
3967
|
|
|
|
|
|
|
if (defined ($kid) && $param == $kid->isParameterEntity); |
3968
|
|
|
|
|
|
|
|
3969
|
|
|
|
|
|
|
undef; # entity not found |
3970
|
|
|
|
|
|
|
} |
3971
|
|
|
|
|
|
|
|
3972
|
|
|
|
|
|
|
sub getAttlistDecl |
3973
|
|
|
|
|
|
|
{ |
3974
|
|
|
|
|
|
|
my ($self, $elemName) = @_; |
3975
|
|
|
|
|
|
|
for my $kid (@{$_[0]->[_C]}) |
3976
|
|
|
|
|
|
|
{ |
3977
|
|
|
|
|
|
|
return $kid if ($kid->getNodeType == ATTLIST_DECL_NODE && |
3978
|
|
|
|
|
|
|
$kid->getName eq $elemName); |
3979
|
|
|
|
|
|
|
} |
3980
|
|
|
|
|
|
|
undef; # not found |
3981
|
|
|
|
|
|
|
} |
3982
|
|
|
|
|
|
|
|
3983
|
|
|
|
|
|
|
sub getElementDecl |
3984
|
|
|
|
|
|
|
{ |
3985
|
|
|
|
|
|
|
my ($self, $elemName) = @_; |
3986
|
|
|
|
|
|
|
for my $kid (@{$_[0]->[_C]}) |
3987
|
|
|
|
|
|
|
{ |
3988
|
|
|
|
|
|
|
return $kid if ($kid->getNodeType == ELEMENT_DECL_NODE && |
3989
|
|
|
|
|
|
|
$kid->getName eq $elemName); |
3990
|
|
|
|
|
|
|
} |
3991
|
|
|
|
|
|
|
undef; # not found |
3992
|
|
|
|
|
|
|
} |
3993
|
|
|
|
|
|
|
|
3994
|
|
|
|
|
|
|
sub addElementDecl |
3995
|
|
|
|
|
|
|
{ |
3996
|
|
|
|
|
|
|
my ($self, $name, $model, $hidden) = @_; |
3997
|
|
|
|
|
|
|
my $node = $self->getElementDecl ($name); |
3998
|
|
|
|
|
|
|
|
3999
|
|
|
|
|
|
|
#?? could warn |
4000
|
|
|
|
|
|
|
unless (defined $node) |
4001
|
|
|
|
|
|
|
{ |
4002
|
|
|
|
|
|
|
$node = $self->[_Doc]->createElementDecl ($name, $model, $hidden); |
4003
|
|
|
|
|
|
|
$self->appendChild ($node); |
4004
|
|
|
|
|
|
|
} |
4005
|
|
|
|
|
|
|
$node; |
4006
|
|
|
|
|
|
|
} |
4007
|
|
|
|
|
|
|
|
4008
|
|
|
|
|
|
|
sub addAttlistDecl |
4009
|
|
|
|
|
|
|
{ |
4010
|
|
|
|
|
|
|
my ($self, $name) = @_; |
4011
|
|
|
|
|
|
|
my $node = $self->getAttlistDecl ($name); |
4012
|
|
|
|
|
|
|
|
4013
|
|
|
|
|
|
|
unless (defined $node) |
4014
|
|
|
|
|
|
|
{ |
4015
|
|
|
|
|
|
|
$node = $self->[_Doc]->createAttlistDecl ($name); |
4016
|
|
|
|
|
|
|
$self->appendChild ($node); |
4017
|
|
|
|
|
|
|
} |
4018
|
|
|
|
|
|
|
$node; |
4019
|
|
|
|
|
|
|
} |
4020
|
|
|
|
|
|
|
|
4021
|
|
|
|
|
|
|
sub addNotation |
4022
|
|
|
|
|
|
|
{ |
4023
|
|
|
|
|
|
|
my $self = shift; |
4024
|
|
|
|
|
|
|
my $node = $self->[_Doc]->createNotation (@_); |
4025
|
|
|
|
|
|
|
$self->[_Notations]->setNamedItem ($node); |
4026
|
|
|
|
|
|
|
$node; |
4027
|
|
|
|
|
|
|
} |
4028
|
|
|
|
|
|
|
|
4029
|
|
|
|
|
|
|
sub addEntity |
4030
|
|
|
|
|
|
|
{ |
4031
|
|
|
|
|
|
|
my $self = shift; |
4032
|
|
|
|
|
|
|
my $node = $self->[_Doc]->createEntity (@_); |
4033
|
|
|
|
|
|
|
|
4034
|
|
|
|
|
|
|
$self->[_Entities]->setNamedItem ($node); |
4035
|
|
|
|
|
|
|
$node; |
4036
|
|
|
|
|
|
|
} |
4037
|
|
|
|
|
|
|
|
4038
|
|
|
|
|
|
|
# All AttDefs for a certain Element are merged into a single ATTLIST |
4039
|
|
|
|
|
|
|
sub addAttDef |
4040
|
|
|
|
|
|
|
{ |
4041
|
|
|
|
|
|
|
my $self = shift; |
4042
|
|
|
|
|
|
|
my $elemName = shift; |
4043
|
|
|
|
|
|
|
|
4044
|
|
|
|
|
|
|
# create the AttlistDecl if it doesn't exist yet |
4045
|
|
|
|
|
|
|
my $attListDecl = $self->addAttlistDecl ($elemName); |
4046
|
|
|
|
|
|
|
$attListDecl->addAttDef (@_); |
4047
|
|
|
|
|
|
|
} |
4048
|
|
|
|
|
|
|
|
4049
|
|
|
|
|
|
|
sub getDefaultAttrValue |
4050
|
|
|
|
|
|
|
{ |
4051
|
|
|
|
|
|
|
my ($self, $elem, $attr) = @_; |
4052
|
|
|
|
|
|
|
my $elemNode = $self->getAttlistDecl ($elem); |
4053
|
|
|
|
|
|
|
(defined $elemNode) ? $elemNode->getDefaultAttrValue ($attr) : undef; |
4054
|
|
|
|
|
|
|
} |
4055
|
|
|
|
|
|
|
|
4056
|
|
|
|
|
|
|
sub getEntity |
4057
|
|
|
|
|
|
|
{ |
4058
|
|
|
|
|
|
|
my ($self, $entity) = @_; |
4059
|
|
|
|
|
|
|
$self->[_Entities]->getNamedItem ($entity); |
4060
|
|
|
|
|
|
|
} |
4061
|
|
|
|
|
|
|
|
4062
|
|
|
|
|
|
|
sub setParams |
4063
|
|
|
|
|
|
|
{ |
4064
|
|
|
|
|
|
|
my ($self, $name, $sysid, $pubid, $internal) = @_; |
4065
|
|
|
|
|
|
|
|
4066
|
|
|
|
|
|
|
$self->[_Name] = $name; |
4067
|
|
|
|
|
|
|
|
4068
|
|
|
|
|
|
|
#?? not sure if we need to hold on to these... |
4069
|
|
|
|
|
|
|
$self->[_SysId] = $sysid if defined $sysid; |
4070
|
|
|
|
|
|
|
$self->[_PubId] = $pubid if defined $pubid; |
4071
|
|
|
|
|
|
|
$self->[_Internal] = $internal if defined $internal; |
4072
|
|
|
|
|
|
|
|
4073
|
|
|
|
|
|
|
$self; |
4074
|
|
|
|
|
|
|
} |
4075
|
|
|
|
|
|
|
|
4076
|
|
|
|
|
|
|
sub rejectChild |
4077
|
|
|
|
|
|
|
{ |
4078
|
|
|
|
|
|
|
# DOM Spec says: DocumentType -- no children |
4079
|
|
|
|
|
|
|
not $XML::DOM::IgnoreReadOnly; |
4080
|
|
|
|
|
|
|
} |
4081
|
|
|
|
|
|
|
|
4082
|
|
|
|
|
|
|
sub print |
4083
|
|
|
|
|
|
|
{ |
4084
|
|
|
|
|
|
|
my ($self, $FILE) = @_; |
4085
|
|
|
|
|
|
|
|
4086
|
|
|
|
|
|
|
my $name = $self->[_Name]; |
4087
|
|
|
|
|
|
|
|
4088
|
|
|
|
|
|
|
my $sysId = $self->[_SysId]; |
4089
|
|
|
|
|
|
|
my $pubId = $self->[_PubId]; |
4090
|
|
|
|
|
|
|
|
4091
|
|
|
|
|
|
|
$FILE->print ("
|
4092
|
|
|
|
|
|
|
if (defined $pubId) |
4093
|
|
|
|
|
|
|
{ |
4094
|
|
|
|
|
|
|
$FILE->print (" PUBLIC \"$pubId\" \"$sysId\""); |
4095
|
|
|
|
|
|
|
} |
4096
|
|
|
|
|
|
|
elsif (defined $sysId) |
4097
|
|
|
|
|
|
|
{ |
4098
|
|
|
|
|
|
|
$FILE->print (" SYSTEM \"$sysId\""); |
4099
|
|
|
|
|
|
|
} |
4100
|
|
|
|
|
|
|
|
4101
|
|
|
|
|
|
|
my @entities = @{$self->[_Entities]->getValues}; |
4102
|
|
|
|
|
|
|
my @notations = @{$self->[_Notations]->getValues}; |
4103
|
|
|
|
|
|
|
my @kids = @{$self->[_C]}; |
4104
|
|
|
|
|
|
|
|
4105
|
|
|
|
|
|
|
if (@entities || @notations || @kids) |
4106
|
|
|
|
|
|
|
{ |
4107
|
|
|
|
|
|
|
$FILE->print (" [\x0A"); |
4108
|
|
|
|
|
|
|
|
4109
|
|
|
|
|
|
|
for my $kid (@entities) |
4110
|
|
|
|
|
|
|
{ |
4111
|
|
|
|
|
|
|
next if $kid->[_Hidden]; |
4112
|
|
|
|
|
|
|
|
4113
|
|
|
|
|
|
|
$FILE->print (" "); |
4114
|
|
|
|
|
|
|
$kid->print ($FILE); |
4115
|
|
|
|
|
|
|
$FILE->print ("\x0A"); |
4116
|
|
|
|
|
|
|
} |
4117
|
|
|
|
|
|
|
|
4118
|
|
|
|
|
|
|
for my $kid (@notations) |
4119
|
|
|
|
|
|
|
{ |
4120
|
|
|
|
|
|
|
next if $kid->[_Hidden]; |
4121
|
|
|
|
|
|
|
|
4122
|
|
|
|
|
|
|
$FILE->print (" "); |
4123
|
|
|
|
|
|
|
$kid->print ($FILE); |
4124
|
|
|
|
|
|
|
$FILE->print ("\x0A"); |
4125
|
|
|
|
|
|
|
} |
4126
|
|
|
|
|
|
|
|
4127
|
|
|
|
|
|
|
for my $kid (@kids) |
4128
|
|
|
|
|
|
|
{ |
4129
|
|
|
|
|
|
|
next if $kid->[_Hidden]; |
4130
|
|
|
|
|
|
|
|
4131
|
|
|
|
|
|
|
$FILE->print (" "); |
4132
|
|
|
|
|
|
|
$kid->print ($FILE); |
4133
|
|
|
|
|
|
|
$FILE->print ("\x0A"); |
4134
|
|
|
|
|
|
|
} |
4135
|
|
|
|
|
|
|
$FILE->print ("]"); |
4136
|
|
|
|
|
|
|
} |
4137
|
|
|
|
|
|
|
$FILE->print (">"); |
4138
|
|
|
|
|
|
|
} |
4139
|
|
|
|
|
|
|
|
4140
|
|
|
|
|
|
|
sub to_expat |
4141
|
|
|
|
|
|
|
{ |
4142
|
|
|
|
|
|
|
my ($self, $iter) = @_; |
4143
|
|
|
|
|
|
|
|
4144
|
|
|
|
|
|
|
$iter->Doctype ($self->getName, $self->getSysId, $self->getPubId, $self->getInternal); |
4145
|
|
|
|
|
|
|
|
4146
|
|
|
|
|
|
|
for my $ent ($self->getEntities->getValues) |
4147
|
|
|
|
|
|
|
{ |
4148
|
|
|
|
|
|
|
next if $ent->[_Hidden]; |
4149
|
|
|
|
|
|
|
$ent->to_expat ($iter); |
4150
|
|
|
|
|
|
|
} |
4151
|
|
|
|
|
|
|
|
4152
|
|
|
|
|
|
|
for my $nota ($self->getNotations->getValues) |
4153
|
|
|
|
|
|
|
{ |
4154
|
|
|
|
|
|
|
next if $nota->[_Hidden]; |
4155
|
|
|
|
|
|
|
$nota->to_expat ($iter); |
4156
|
|
|
|
|
|
|
} |
4157
|
|
|
|
|
|
|
|
4158
|
|
|
|
|
|
|
for my $kid ($self->getChildNodes) |
4159
|
|
|
|
|
|
|
{ |
4160
|
|
|
|
|
|
|
next if $kid->[_Hidden]; |
4161
|
|
|
|
|
|
|
$kid->to_expat ($iter); |
4162
|
|
|
|
|
|
|
} |
4163
|
|
|
|
|
|
|
} |
4164
|
|
|
|
|
|
|
|
4165
|
|
|
|
|
|
|
sub _to_sax |
4166
|
|
|
|
|
|
|
{ |
4167
|
|
|
|
|
|
|
my ($self, $doch, $dtdh, $enth) = @_; |
4168
|
|
|
|
|
|
|
|
4169
|
|
|
|
|
|
|
$dtdh->doctype_decl ( { Name => $self->getName, |
4170
|
|
|
|
|
|
|
SystemId => $self->getSysId, |
4171
|
|
|
|
|
|
|
PublicId => $self->getPubId, |
4172
|
|
|
|
|
|
|
Internal => $self->getInternal }); |
4173
|
|
|
|
|
|
|
|
4174
|
|
|
|
|
|
|
for my $ent ($self->getEntities->getValues) |
4175
|
|
|
|
|
|
|
{ |
4176
|
|
|
|
|
|
|
next if $ent->[_Hidden]; |
4177
|
|
|
|
|
|
|
$ent->_to_sax ($doch, $dtdh, $enth); |
4178
|
|
|
|
|
|
|
} |
4179
|
|
|
|
|
|
|
|
4180
|
|
|
|
|
|
|
for my $nota ($self->getNotations->getValues) |
4181
|
|
|
|
|
|
|
{ |
4182
|
|
|
|
|
|
|
next if $nota->[_Hidden]; |
4183
|
|
|
|
|
|
|
$nota->_to_sax ($doch, $dtdh, $enth); |
4184
|
|
|
|
|
|
|
} |
4185
|
|
|
|
|
|
|
|
4186
|
|
|
|
|
|
|
for my $kid ($self->getChildNodes) |
4187
|
|
|
|
|
|
|
{ |
4188
|
|
|
|
|
|
|
next if $kid->[_Hidden]; |
4189
|
|
|
|
|
|
|
$kid->_to_sax ($doch, $dtdh, $enth); |
4190
|
|
|
|
|
|
|
} |
4191
|
|
|
|
|
|
|
} |
4192
|
|
|
|
|
|
|
|
4193
|
|
|
|
|
|
|
###################################################################### |
4194
|
|
|
|
|
|
|
package XML::DOM::Parser; |
4195
|
|
|
|
|
|
|
###################################################################### |
4196
|
|
|
|
|
|
|
use vars qw ( @ISA ); |
4197
|
|
|
|
|
|
|
@ISA = qw( XML::Parser ); |
4198
|
|
|
|
|
|
|
|
4199
|
|
|
|
|
|
|
sub new |
4200
|
|
|
|
|
|
|
{ |
4201
|
|
|
|
|
|
|
my ($class, %args) = @_; |
4202
|
|
|
|
|
|
|
|
4203
|
|
|
|
|
|
|
$args{Style} = 'XML::Parser::Dom'; |
4204
|
|
|
|
|
|
|
$class->SUPER::new (%args); |
4205
|
|
|
|
|
|
|
} |
4206
|
|
|
|
|
|
|
|
4207
|
|
|
|
|
|
|
# This method needed to be overriden so we can restore some global |
4208
|
|
|
|
|
|
|
# variables when an exception is thrown |
4209
|
|
|
|
|
|
|
sub parse |
4210
|
|
|
|
|
|
|
{ |
4211
|
|
|
|
|
|
|
my $self = shift; |
4212
|
|
|
|
|
|
|
|
4213
|
|
|
|
|
|
|
local $XML::Parser::Dom::_DP_doc; |
4214
|
|
|
|
|
|
|
local $XML::Parser::Dom::_DP_elem; |
4215
|
|
|
|
|
|
|
local $XML::Parser::Dom::_DP_doctype; |
4216
|
|
|
|
|
|
|
local $XML::Parser::Dom::_DP_in_prolog; |
4217
|
|
|
|
|
|
|
local $XML::Parser::Dom::_DP_end_doc; |
4218
|
|
|
|
|
|
|
local $XML::Parser::Dom::_DP_saw_doctype; |
4219
|
|
|
|
|
|
|
local $XML::Parser::Dom::_DP_in_CDATA; |
4220
|
|
|
|
|
|
|
local $XML::Parser::Dom::_DP_keep_CDATA; |
4221
|
|
|
|
|
|
|
local $XML::Parser::Dom::_DP_last_text; |
4222
|
|
|
|
|
|
|
|
4223
|
|
|
|
|
|
|
|
4224
|
|
|
|
|
|
|
# Temporarily disable checks that Expat already does (for performance) |
4225
|
|
|
|
|
|
|
local $XML::DOM::SafeMode = 0; |
4226
|
|
|
|
|
|
|
# Temporarily disable ReadOnly checks |
4227
|
|
|
|
|
|
|
local $XML::DOM::IgnoreReadOnly = 1; |
4228
|
|
|
|
|
|
|
|
4229
|
|
|
|
|
|
|
my $ret; |
4230
|
|
|
|
|
|
|
eval { |
4231
|
|
|
|
|
|
|
$ret = $self->SUPER::parse (@_); |
4232
|
|
|
|
|
|
|
}; |
4233
|
|
|
|
|
|
|
my $err = $@; |
4234
|
|
|
|
|
|
|
|
4235
|
|
|
|
|
|
|
if ($err) |
4236
|
|
|
|
|
|
|
{ |
4237
|
|
|
|
|
|
|
my $doc = $XML::Parser::Dom::_DP_doc; |
4238
|
|
|
|
|
|
|
if ($doc) |
4239
|
|
|
|
|
|
|
{ |
4240
|
|
|
|
|
|
|
$doc->dispose; |
4241
|
|
|
|
|
|
|
} |
4242
|
|
|
|
|
|
|
die $err; |
4243
|
|
|
|
|
|
|
} |
4244
|
|
|
|
|
|
|
|
4245
|
|
|
|
|
|
|
$ret; |
4246
|
|
|
|
|
|
|
} |
4247
|
|
|
|
|
|
|
|
4248
|
|
|
|
|
|
|
my $LWP_USER_AGENT; |
4249
|
|
|
|
|
|
|
sub set_LWP_UserAgent |
4250
|
|
|
|
|
|
|
{ |
4251
|
|
|
|
|
|
|
$LWP_USER_AGENT = shift; |
4252
|
|
|
|
|
|
|
} |
4253
|
|
|
|
|
|
|
|
4254
|
|
|
|
|
|
|
sub parsefile |
4255
|
|
|
|
|
|
|
{ |
4256
|
|
|
|
|
|
|
my $self = shift; |
4257
|
|
|
|
|
|
|
my $url = shift; |
4258
|
|
|
|
|
|
|
|
4259
|
|
|
|
|
|
|
# Any other URL schemes? |
4260
|
|
|
|
|
|
|
if ($url =~ /^(https?|ftp|wais|gopher|file):/) |
4261
|
|
|
|
|
|
|
{ |
4262
|
|
|
|
|
|
|
# Read the file from the web with LWP. |
4263
|
|
|
|
|
|
|
# |
4264
|
|
|
|
|
|
|
# Note that we read in the entire file, which may not be ideal |
4265
|
|
|
|
|
|
|
# for large files. LWP::UserAgent also provides a callback style |
4266
|
|
|
|
|
|
|
# request, which we could convert to a stream with a fork()... |
4267
|
|
|
|
|
|
|
|
4268
|
|
|
|
|
|
|
my $result; |
4269
|
|
|
|
|
|
|
eval |
4270
|
|
|
|
|
|
|
{ |
4271
|
|
|
|
|
|
|
use LWP::UserAgent; |
4272
|
|
|
|
|
|
|
|
4273
|
|
|
|
|
|
|
my $ua = $self->{LWP_UserAgent}; |
4274
|
|
|
|
|
|
|
unless (defined $ua) |
4275
|
|
|
|
|
|
|
{ |
4276
|
|
|
|
|
|
|
unless (defined $LWP_USER_AGENT) |
4277
|
|
|
|
|
|
|
{ |
4278
|
|
|
|
|
|
|
$LWP_USER_AGENT = LWP::UserAgent->new; |
4279
|
|
|
|
|
|
|
|
4280
|
|
|
|
|
|
|
# Load proxy settings from environment variables, i.e.: |
4281
|
|
|
|
|
|
|
# http_proxy, ftp_proxy, no_proxy etc. (see LWP::UserAgent(3)) |
4282
|
|
|
|
|
|
|
# You need these to go thru firewalls. |
4283
|
|
|
|
|
|
|
$LWP_USER_AGENT->env_proxy; |
4284
|
|
|
|
|
|
|
} |
4285
|
|
|
|
|
|
|
$ua = $LWP_USER_AGENT; |
4286
|
|
|
|
|
|
|
} |
4287
|
|
|
|
|
|
|
my $req = new HTTP::Request 'GET', $url; |
4288
|
|
|
|
|
|
|
my $response = $ua->request ($req); |
4289
|
|
|
|
|
|
|
|
4290
|
|
|
|
|
|
|
# Parse the result of the HTTP request |
4291
|
|
|
|
|
|
|
$result = $self->parse ($response->content, @_); |
4292
|
|
|
|
|
|
|
}; |
4293
|
|
|
|
|
|
|
if ($@) |
4294
|
|
|
|
|
|
|
{ |
4295
|
|
|
|
|
|
|
die "Couldn't parsefile [$url] with LWP: $@"; |
4296
|
|
|
|
|
|
|
} |
4297
|
|
|
|
|
|
|
return $result; |
4298
|
|
|
|
|
|
|
} |
4299
|
|
|
|
|
|
|
else |
4300
|
|
|
|
|
|
|
{ |
4301
|
|
|
|
|
|
|
return $self->SUPER::parsefile ($url, @_); |
4302
|
|
|
|
|
|
|
} |
4303
|
|
|
|
|
|
|
} |
4304
|
|
|
|
|
|
|
|
4305
|
|
|
|
|
|
|
###################################################################### |
4306
|
|
|
|
|
|
|
package XML::Parser::Dom; |
4307
|
|
|
|
|
|
|
###################################################################### |
4308
|
|
|
|
|
|
|
|
4309
|
|
|
|
|
|
|
BEGIN |
4310
|
|
|
|
|
|
|
{ |
4311
|
|
|
|
|
|
|
import XML::DOM::Node qw( :Fields ); |
4312
|
|
|
|
|
|
|
import XML::DOM::CharacterData qw( :Fields ); |
4313
|
|
|
|
|
|
|
} |
4314
|
|
|
|
|
|
|
|
4315
|
|
|
|
|
|
|
use vars qw( $_DP_doc |
4316
|
|
|
|
|
|
|
$_DP_elem |
4317
|
|
|
|
|
|
|
$_DP_doctype |
4318
|
|
|
|
|
|
|
$_DP_in_prolog |
4319
|
|
|
|
|
|
|
$_DP_end_doc |
4320
|
|
|
|
|
|
|
$_DP_saw_doctype |
4321
|
|
|
|
|
|
|
$_DP_in_CDATA |
4322
|
|
|
|
|
|
|
$_DP_keep_CDATA |
4323
|
|
|
|
|
|
|
$_DP_last_text |
4324
|
|
|
|
|
|
|
$_DP_level |
4325
|
|
|
|
|
|
|
$_DP_expand_pent |
4326
|
|
|
|
|
|
|
); |
4327
|
|
|
|
|
|
|
|
4328
|
|
|
|
|
|
|
# This adds a new Style to the XML::Parser class. |
4329
|
|
|
|
|
|
|
# From now on you can say: $parser = new XML::Parser ('Style' => 'Dom' ); |
4330
|
|
|
|
|
|
|
# but that is *NOT* how a regular user should use it! |
4331
|
|
|
|
|
|
|
$XML::Parser::Built_In_Styles{Dom} = 1; |
4332
|
|
|
|
|
|
|
|
4333
|
|
|
|
|
|
|
sub Init |
4334
|
|
|
|
|
|
|
{ |
4335
|
|
|
|
|
|
|
$_DP_elem = $_DP_doc = new XML::DOM::Document(); |
4336
|
|
|
|
|
|
|
$_DP_doctype = new XML::DOM::DocumentType ($_DP_doc); |
4337
|
|
|
|
|
|
|
$_DP_doc->setDoctype ($_DP_doctype); |
4338
|
|
|
|
|
|
|
$_DP_keep_CDATA = $_[0]->{KeepCDATA}; |
4339
|
|
|
|
|
|
|
|
4340
|
|
|
|
|
|
|
# Prepare for document prolog |
4341
|
|
|
|
|
|
|
$_DP_in_prolog = 1; |
4342
|
|
|
|
|
|
|
|
4343
|
|
|
|
|
|
|
# We haven't passed the root element yet |
4344
|
|
|
|
|
|
|
$_DP_end_doc = 0; |
4345
|
|
|
|
|
|
|
|
4346
|
|
|
|
|
|
|
# Expand parameter entities in the DTD by default |
4347
|
|
|
|
|
|
|
|
4348
|
|
|
|
|
|
|
$_DP_expand_pent = defined $_[0]->{ExpandParamEnt} ? |
4349
|
|
|
|
|
|
|
$_[0]->{ExpandParamEnt} : 1; |
4350
|
|
|
|
|
|
|
if ($_DP_expand_pent) |
4351
|
|
|
|
|
|
|
{ |
4352
|
|
|
|
|
|
|
$_[0]->{DOM_Entity} = {}; |
4353
|
|
|
|
|
|
|
} |
4354
|
|
|
|
|
|
|
|
4355
|
|
|
|
|
|
|
$_DP_level = 0; |
4356
|
|
|
|
|
|
|
|
4357
|
|
|
|
|
|
|
undef $_DP_last_text; |
4358
|
|
|
|
|
|
|
} |
4359
|
|
|
|
|
|
|
|
4360
|
|
|
|
|
|
|
sub Final |
4361
|
|
|
|
|
|
|
{ |
4362
|
|
|
|
|
|
|
unless ($_DP_saw_doctype) |
4363
|
|
|
|
|
|
|
{ |
4364
|
|
|
|
|
|
|
my $doctype = $_DP_doc->removeDoctype; |
4365
|
|
|
|
|
|
|
$doctype->dispose; |
4366
|
|
|
|
|
|
|
} |
4367
|
|
|
|
|
|
|
$_DP_doc; |
4368
|
|
|
|
|
|
|
} |
4369
|
|
|
|
|
|
|
|
4370
|
|
|
|
|
|
|
sub Char |
4371
|
|
|
|
|
|
|
{ |
4372
|
|
|
|
|
|
|
my $str = $_[1]; |
4373
|
|
|
|
|
|
|
|
4374
|
|
|
|
|
|
|
if ($_DP_in_CDATA && $_DP_keep_CDATA) |
4375
|
|
|
|
|
|
|
{ |
4376
|
|
|
|
|
|
|
undef $_DP_last_text; |
4377
|
|
|
|
|
|
|
# Merge text with previous node if possible |
4378
|
|
|
|
|
|
|
$_DP_elem->addCDATA ($str); |
4379
|
|
|
|
|
|
|
} |
4380
|
|
|
|
|
|
|
else |
4381
|
|
|
|
|
|
|
{ |
4382
|
|
|
|
|
|
|
# Merge text with previous node if possible |
4383
|
|
|
|
|
|
|
# Used to be: $expat->{DOM_Element}->addText ($str); |
4384
|
|
|
|
|
|
|
if ($_DP_last_text) |
4385
|
|
|
|
|
|
|
{ |
4386
|
|
|
|
|
|
|
$_DP_last_text->[_Data] .= $str; |
4387
|
|
|
|
|
|
|
} |
4388
|
|
|
|
|
|
|
else |
4389
|
|
|
|
|
|
|
{ |
4390
|
|
|
|
|
|
|
$_DP_last_text = $_DP_doc->createTextNode ($str); |
4391
|
|
|
|
|
|
|
$_DP_last_text->[_Parent] = $_DP_elem; |
4392
|
|
|
|
|
|
|
push @{$_DP_elem->[_C]}, $_DP_last_text; |
4393
|
|
|
|
|
|
|
} |
4394
|
|
|
|
|
|
|
} |
4395
|
|
|
|
|
|
|
} |
4396
|
|
|
|
|
|
|
|
4397
|
|
|
|
|
|
|
sub Start |
4398
|
|
|
|
|
|
|
{ |
4399
|
|
|
|
|
|
|
my ($expat, $elem, @attr) = @_; |
4400
|
|
|
|
|
|
|
my $parent = $_DP_elem; |
4401
|
|
|
|
|
|
|
my $doc = $_DP_doc; |
4402
|
|
|
|
|
|
|
|
4403
|
|
|
|
|
|
|
if ($parent == $doc) |
4404
|
|
|
|
|
|
|
{ |
4405
|
|
|
|
|
|
|
# End of document prolog, i.e. start of first Element |
4406
|
|
|
|
|
|
|
$_DP_in_prolog = 0; |
4407
|
|
|
|
|
|
|
} |
4408
|
|
|
|
|
|
|
|
4409
|
|
|
|
|
|
|
undef $_DP_last_text; |
4410
|
|
|
|
|
|
|
my $node = $doc->createElement ($elem); |
4411
|
|
|
|
|
|
|
$_DP_elem = $node; |
4412
|
|
|
|
|
|
|
$parent->appendChild ($node); |
4413
|
|
|
|
|
|
|
|
4414
|
|
|
|
|
|
|
my $n = @attr; |
4415
|
|
|
|
|
|
|
return unless $n; |
4416
|
|
|
|
|
|
|
|
4417
|
|
|
|
|
|
|
# Add attributes |
4418
|
|
|
|
|
|
|
my $first_default = $expat->specified_attr; |
4419
|
|
|
|
|
|
|
my $i = 0; |
4420
|
|
|
|
|
|
|
while ($i < $n) |
4421
|
|
|
|
|
|
|
{ |
4422
|
|
|
|
|
|
|
my $specified = $i < $first_default; |
4423
|
|
|
|
|
|
|
my $name = $attr[$i++]; |
4424
|
|
|
|
|
|
|
undef $_DP_last_text; |
4425
|
|
|
|
|
|
|
my $attr = $doc->createAttribute ($name, $attr[$i++], $specified); |
4426
|
|
|
|
|
|
|
$node->setAttributeNode ($attr); |
4427
|
|
|
|
|
|
|
} |
4428
|
|
|
|
|
|
|
} |
4429
|
|
|
|
|
|
|
|
4430
|
|
|
|
|
|
|
sub End |
4431
|
|
|
|
|
|
|
{ |
4432
|
|
|
|
|
|
|
$_DP_elem = $_DP_elem->[_Parent]; |
4433
|
|
|
|
|
|
|
undef $_DP_last_text; |
4434
|
|
|
|
|
|
|
|
4435
|
|
|
|
|
|
|
# Check for end of root element |
4436
|
|
|
|
|
|
|
$_DP_end_doc = 1 if ($_DP_elem == $_DP_doc); |
4437
|
|
|
|
|
|
|
} |
4438
|
|
|
|
|
|
|
|
4439
|
|
|
|
|
|
|
# Called at end of file, i.e. whitespace following last closing tag |
4440
|
|
|
|
|
|
|
# Also for Entity references |
4441
|
|
|
|
|
|
|
# May also be called at other times... |
4442
|
|
|
|
|
|
|
sub Default |
4443
|
|
|
|
|
|
|
{ |
4444
|
|
|
|
|
|
|
my ($expat, $str) = @_; |
4445
|
|
|
|
|
|
|
|
4446
|
|
|
|
|
|
|
# shift; deb ("Default", @_); |
4447
|
|
|
|
|
|
|
|
4448
|
|
|
|
|
|
|
if ($_DP_in_prolog) # still processing Document prolog... |
4449
|
|
|
|
|
|
|
{ |
4450
|
|
|
|
|
|
|
#?? could try to store this text later |
4451
|
|
|
|
|
|
|
#?? I've only seen whitespace here so far |
4452
|
|
|
|
|
|
|
} |
4453
|
|
|
|
|
|
|
elsif (!$_DP_end_doc) # ignore whitespace at end of Document |
4454
|
|
|
|
|
|
|
{ |
4455
|
|
|
|
|
|
|
# if ($expat->{NoExpand}) |
4456
|
|
|
|
|
|
|
# { |
4457
|
|
|
|
|
|
|
# Got a TextDecl () from an external entity here once |
4458
|
|
|
|
|
|
|
|
4459
|
|
|
|
|
|
|
# create non-parameter entity reference, correct? |
4460
|
|
|
|
|
|
|
return unless $str =~ s!^&!!; |
4461
|
|
|
|
|
|
|
return unless $str =~ s!;$!!; |
4462
|
|
|
|
|
|
|
$_DP_elem->appendChild ( |
4463
|
|
|
|
|
|
|
$_DP_doc->createEntityReference ($str,0,$expat->{NoExpand})); |
4464
|
|
|
|
|
|
|
undef $_DP_last_text; |
4465
|
|
|
|
|
|
|
# } |
4466
|
|
|
|
|
|
|
# else |
4467
|
|
|
|
|
|
|
# { |
4468
|
|
|
|
|
|
|
# $expat->{DOM_Element}->addText ($str); |
4469
|
|
|
|
|
|
|
# } |
4470
|
|
|
|
|
|
|
} |
4471
|
|
|
|
|
|
|
} |
4472
|
|
|
|
|
|
|
|
4473
|
|
|
|
|
|
|
# XML::Parser 2.19 added support for CdataStart and CdataEnd handlers |
4474
|
|
|
|
|
|
|
# If they are not defined, the Default handler is called instead |
4475
|
|
|
|
|
|
|
# with the text "
|
4476
|
|
|
|
|
|
|
sub CdataStart |
4477
|
|
|
|
|
|
|
{ |
4478
|
|
|
|
|
|
|
$_DP_in_CDATA = 1; |
4479
|
|
|
|
|
|
|
} |
4480
|
|
|
|
|
|
|
|
4481
|
|
|
|
|
|
|
sub CdataEnd |
4482
|
|
|
|
|
|
|
{ |
4483
|
|
|
|
|
|
|
$_DP_in_CDATA = 0; |
4484
|
|
|
|
|
|
|
} |
4485
|
|
|
|
|
|
|
|
4486
|
|
|
|
|
|
|
my $START_MARKER = "__DOM__START__ENTITY__"; |
4487
|
|
|
|
|
|
|
my $END_MARKER = "__DOM__END__ENTITY__"; |
4488
|
|
|
|
|
|
|
|
4489
|
|
|
|
|
|
|
sub Comment |
4490
|
|
|
|
|
|
|
{ |
4491
|
|
|
|
|
|
|
undef $_DP_last_text; |
4492
|
|
|
|
|
|
|
|
4493
|
|
|
|
|
|
|
# These comments were inserted by ExternEnt handler |
4494
|
|
|
|
|
|
|
if ($_[1] =~ /(?:($START_MARKER)|($END_MARKER))/) |
4495
|
|
|
|
|
|
|
{ |
4496
|
|
|
|
|
|
|
if ($1) # START |
4497
|
|
|
|
|
|
|
{ |
4498
|
|
|
|
|
|
|
$_DP_level++; |
4499
|
|
|
|
|
|
|
} |
4500
|
|
|
|
|
|
|
else |
4501
|
|
|
|
|
|
|
{ |
4502
|
|
|
|
|
|
|
$_DP_level--; |
4503
|
|
|
|
|
|
|
} |
4504
|
|
|
|
|
|
|
} |
4505
|
|
|
|
|
|
|
else |
4506
|
|
|
|
|
|
|
{ |
4507
|
|
|
|
|
|
|
my $comment = $_DP_doc->createComment ($_[1]); |
4508
|
|
|
|
|
|
|
$_DP_elem->appendChild ($comment); |
4509
|
|
|
|
|
|
|
} |
4510
|
|
|
|
|
|
|
} |
4511
|
|
|
|
|
|
|
|
4512
|
|
|
|
|
|
|
sub deb |
4513
|
|
|
|
|
|
|
{ |
4514
|
|
|
|
|
|
|
# return; |
4515
|
|
|
|
|
|
|
|
4516
|
|
|
|
|
|
|
my $name = shift; |
4517
|
|
|
|
|
|
|
print "$name (" . join(",", map {defined($_)?$_ : "(undef)"} @_) . ")\n"; |
4518
|
|
|
|
|
|
|
} |
4519
|
|
|
|
|
|
|
|
4520
|
|
|
|
|
|
|
sub Doctype |
4521
|
|
|
|
|
|
|
{ |
4522
|
|
|
|
|
|
|
my $expat = shift; |
4523
|
|
|
|
|
|
|
# deb ("Doctype", @_); |
4524
|
|
|
|
|
|
|
|
4525
|
|
|
|
|
|
|
$_DP_doctype->setParams (@_); |
4526
|
|
|
|
|
|
|
$_DP_saw_doctype = 1; |
4527
|
|
|
|
|
|
|
} |
4528
|
|
|
|
|
|
|
|
4529
|
|
|
|
|
|
|
sub Attlist |
4530
|
|
|
|
|
|
|
{ |
4531
|
|
|
|
|
|
|
my $expat = shift; |
4532
|
|
|
|
|
|
|
# deb ("Attlist", @_); |
4533
|
|
|
|
|
|
|
|
4534
|
|
|
|
|
|
|
$_[5] = "Hidden" unless $_DP_expand_pent || $_DP_level == 0; |
4535
|
|
|
|
|
|
|
$_DP_doctype->addAttDef (@_); |
4536
|
|
|
|
|
|
|
} |
4537
|
|
|
|
|
|
|
|
4538
|
|
|
|
|
|
|
sub XMLDecl |
4539
|
|
|
|
|
|
|
{ |
4540
|
|
|
|
|
|
|
my $expat = shift; |
4541
|
|
|
|
|
|
|
# deb ("XMLDecl", @_); |
4542
|
|
|
|
|
|
|
|
4543
|
|
|
|
|
|
|
undef $_DP_last_text; |
4544
|
|
|
|
|
|
|
$_DP_doc->setXMLDecl (new XML::DOM::XMLDecl ($_DP_doc, @_)); |
4545
|
|
|
|
|
|
|
} |
4546
|
|
|
|
|
|
|
|
4547
|
|
|
|
|
|
|
sub Entity |
4548
|
|
|
|
|
|
|
{ |
4549
|
|
|
|
|
|
|
my $expat = shift; |
4550
|
|
|
|
|
|
|
# deb ("Entity", @_); |
4551
|
|
|
|
|
|
|
|
4552
|
|
|
|
|
|
|
# check to see if Parameter Entity |
4553
|
|
|
|
|
|
|
if ($_[5]) |
4554
|
|
|
|
|
|
|
{ |
4555
|
|
|
|
|
|
|
|
4556
|
|
|
|
|
|
|
if (defined $_[2]) # was sysid specified? |
4557
|
|
|
|
|
|
|
{ |
4558
|
|
|
|
|
|
|
# Store the Entity mapping for use in ExternEnt |
4559
|
|
|
|
|
|
|
if (exists $expat->{DOM_Entity}->{$_[2]}) |
4560
|
|
|
|
|
|
|
{ |
4561
|
|
|
|
|
|
|
# If this ever happens, the name of entity may be the wrong one |
4562
|
|
|
|
|
|
|
# when writing out the Document. |
4563
|
|
|
|
|
|
|
XML::DOM::warning ("Entity $_[2] is known as %$_[0] and %" . |
4564
|
|
|
|
|
|
|
$expat->{DOM_Entity}->{$_[2]}); |
4565
|
|
|
|
|
|
|
} |
4566
|
|
|
|
|
|
|
else |
4567
|
|
|
|
|
|
|
{ |
4568
|
|
|
|
|
|
|
$expat->{DOM_Entity}->{$_[2]} = $_[0]; |
4569
|
|
|
|
|
|
|
} |
4570
|
|
|
|
|
|
|
#?? remove this block when XML::Parser has better support |
4571
|
|
|
|
|
|
|
} |
4572
|
|
|
|
|
|
|
} |
4573
|
|
|
|
|
|
|
|
4574
|
|
|
|
|
|
|
# no value on things with sysId |
4575
|
|
|
|
|
|
|
if (defined $_[2] && defined $_[1]) |
4576
|
|
|
|
|
|
|
{ |
4577
|
|
|
|
|
|
|
# print STDERR "XML::DOM Warning $_[0] had both value($_[1]) And SYSId ($_[2]), removing value.\n"; |
4578
|
|
|
|
|
|
|
$_[1] = undef; |
4579
|
|
|
|
|
|
|
} |
4580
|
|
|
|
|
|
|
|
4581
|
|
|
|
|
|
|
undef $_DP_last_text; |
4582
|
|
|
|
|
|
|
|
4583
|
|
|
|
|
|
|
$_[6] = "Hidden" unless $_DP_expand_pent || $_DP_level == 0; |
4584
|
|
|
|
|
|
|
$_DP_doctype->addEntity (@_); |
4585
|
|
|
|
|
|
|
} |
4586
|
|
|
|
|
|
|
|
4587
|
|
|
|
|
|
|
# |
4588
|
|
|
|
|
|
|
# Unparsed is called when it encounters e.g: |
4589
|
|
|
|
|
|
|
# |
4590
|
|
|
|
|
|
|
# |
4591
|
|
|
|
|
|
|
# |
4592
|
|
|
|
|
|
|
sub Unparsed |
4593
|
|
|
|
|
|
|
{ |
4594
|
|
|
|
|
|
|
Entity (@_); # same as regular ENTITY, as far as DOM is concerned |
4595
|
|
|
|
|
|
|
} |
4596
|
|
|
|
|
|
|
|
4597
|
|
|
|
|
|
|
sub Element |
4598
|
|
|
|
|
|
|
{ |
4599
|
|
|
|
|
|
|
shift; |
4600
|
|
|
|
|
|
|
# deb ("Element", @_); |
4601
|
|
|
|
|
|
|
|
4602
|
|
|
|
|
|
|
# put in to convert XML::Parser::ContentModel object to string |
4603
|
|
|
|
|
|
|
# ($_[1] used to be a string in XML::Parser 2.27 and |
4604
|
|
|
|
|
|
|
# dom_attr.t fails if we don't stringify here) |
4605
|
|
|
|
|
|
|
$_[1] = "$_[1]"; |
4606
|
|
|
|
|
|
|
|
4607
|
|
|
|
|
|
|
undef $_DP_last_text; |
4608
|
|
|
|
|
|
|
push @_, "Hidden" unless $_DP_expand_pent || $_DP_level == 0; |
4609
|
|
|
|
|
|
|
$_DP_doctype->addElementDecl (@_); |
4610
|
|
|
|
|
|
|
} |
4611
|
|
|
|
|
|
|
|
4612
|
|
|
|
|
|
|
sub Notation |
4613
|
|
|
|
|
|
|
{ |
4614
|
|
|
|
|
|
|
shift; |
4615
|
|
|
|
|
|
|
# deb ("Notation", @_); |
4616
|
|
|
|
|
|
|
|
4617
|
|
|
|
|
|
|
undef $_DP_last_text; |
4618
|
|
|
|
|
|
|
$_[4] = "Hidden" unless $_DP_expand_pent || $_DP_level == 0; |
4619
|
|
|
|
|
|
|
$_DP_doctype->addNotation (@_); |
4620
|
|
|
|
|
|
|
} |
4621
|
|
|
|
|
|
|
|
4622
|
|
|
|
|
|
|
sub Proc |
4623
|
|
|
|
|
|
|
{ |
4624
|
|
|
|
|
|
|
shift; |
4625
|
|
|
|
|
|
|
# deb ("Proc", @_); |
4626
|
|
|
|
|
|
|
|
4627
|
|
|
|
|
|
|
undef $_DP_last_text; |
4628
|
|
|
|
|
|
|
push @_, "Hidden" unless $_DP_expand_pent || $_DP_level == 0; |
4629
|
|
|
|
|
|
|
$_DP_elem->appendChild ($_DP_doc->createProcessingInstruction (@_)); |
4630
|
|
|
|
|
|
|
} |
4631
|
|
|
|
|
|
|
|
4632
|
|
|
|
|
|
|
# |
4633
|
|
|
|
|
|
|
# ExternEnt is called when an external entity, such as: |
4634
|
|
|
|
|
|
|
# |
4635
|
|
|
|
|
|
|
#
|
4636
|
|
|
|
|
|
|
# "http://server/descr.txt"> |
4637
|
|
|
|
|
|
|
# |
4638
|
|
|
|
|
|
|
# is referenced in the document, e.g. with: &externalEntity; |
4639
|
|
|
|
|
|
|
# If ExternEnt is not specified, the entity reference is passed to the Default |
4640
|
|
|
|
|
|
|
# handler as e.g. "&externalEntity;", where an EntityReference object is added. |
4641
|
|
|
|
|
|
|
# |
4642
|
|
|
|
|
|
|
# Also for %externalEntity; references in the DTD itself. |
4643
|
|
|
|
|
|
|
# |
4644
|
|
|
|
|
|
|
# It can also be called when XML::Parser parses the DOCTYPE header |
4645
|
|
|
|
|
|
|
# (just before calling the DocType handler), when it contains a |
4646
|
|
|
|
|
|
|
# reference like "docbook.dtd" below: |
4647
|
|
|
|
|
|
|
# |
4648
|
|
|
|
|
|
|
#
|
4649
|
|
|
|
|
|
|
# "docbook.dtd" [ |
4650
|
|
|
|
|
|
|
# ... rest of DTD ... |
4651
|
|
|
|
|
|
|
# |
4652
|
|
|
|
|
|
|
sub ExternEnt |
4653
|
|
|
|
|
|
|
{ |
4654
|
|
|
|
|
|
|
my ($expat, $base, $sysid, $pubid) = @_; |
4655
|
|
|
|
|
|
|
# deb ("ExternEnt", @_); |
4656
|
|
|
|
|
|
|
|
4657
|
|
|
|
|
|
|
# ?? (tjmather) i think there is a problem here |
4658
|
|
|
|
|
|
|
# with XML::Parser > 2.27 since file_ext_ent_handler |
4659
|
|
|
|
|
|
|
# now returns a IO::File object instead of a content string |
4660
|
|
|
|
|
|
|
|
4661
|
|
|
|
|
|
|
# Invoke XML::Parser's default ExternEnt handler |
4662
|
|
|
|
|
|
|
my $content; |
4663
|
|
|
|
|
|
|
if ($XML::Parser::have_LWP) |
4664
|
|
|
|
|
|
|
{ |
4665
|
|
|
|
|
|
|
$content = XML::Parser::lwp_ext_ent_handler (@_); |
4666
|
|
|
|
|
|
|
} |
4667
|
|
|
|
|
|
|
else |
4668
|
|
|
|
|
|
|
{ |
4669
|
|
|
|
|
|
|
$content = XML::Parser::file_ext_ent_handler (@_); |
4670
|
|
|
|
|
|
|
} |
4671
|
|
|
|
|
|
|
|
4672
|
|
|
|
|
|
|
if ($_DP_expand_pent) |
4673
|
|
|
|
|
|
|
{ |
4674
|
|
|
|
|
|
|
return $content; |
4675
|
|
|
|
|
|
|
} |
4676
|
|
|
|
|
|
|
else |
4677
|
|
|
|
|
|
|
{ |
4678
|
|
|
|
|
|
|
my $entname = $expat->{DOM_Entity}->{$sysid}; |
4679
|
|
|
|
|
|
|
if (defined $entname) |
4680
|
|
|
|
|
|
|
{ |
4681
|
|
|
|
|
|
|
$_DP_doctype->appendChild ($_DP_doc->createEntityReference ($entname, 1, $expat->{NoExpand})); |
4682
|
|
|
|
|
|
|
# Wrap the contents in special comments, so we know when we reach the |
4683
|
|
|
|
|
|
|
# end of parsing the entity. This way we can omit the contents from |
4684
|
|
|
|
|
|
|
# the DTD, when ExpandParamEnt is set to 0. |
4685
|
|
|
|
|
|
|
|
4686
|
|
|
|
|
|
|
return "" . |
4687
|
|
|
|
|
|
|
$content . ""; |
4688
|
|
|
|
|
|
|
} |
4689
|
|
|
|
|
|
|
else |
4690
|
|
|
|
|
|
|
{ |
4691
|
|
|
|
|
|
|
# We either read the entity ref'd by the system id in the |
4692
|
|
|
|
|
|
|
# header, or the entity was undefined. |
4693
|
|
|
|
|
|
|
# In either case, don't bother with maintaining the entity |
4694
|
|
|
|
|
|
|
# reference, just expand the contents. |
4695
|
|
|
|
|
|
|
return "" . |
4696
|
|
|
|
|
|
|
$content . ""; |
4697
|
|
|
|
|
|
|
} |
4698
|
|
|
|
|
|
|
} |
4699
|
|
|
|
|
|
|
} |
4700
|
|
|
|
|
|
|
|
4701
|
|
|
|
|
|
|
1; # module return code |
4702
|
|
|
|
|
|
|
|
4703
|
|
|
|
|
|
|
__END__ |