line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
############################################################################## |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# This library is free software; you can redistribute it and/or |
4
|
|
|
|
|
|
|
# modify it under the terms of the GNU Library General Public |
5
|
|
|
|
|
|
|
# License as published by the Free Software Foundation; either |
6
|
|
|
|
|
|
|
# version 2 of the License, or (at your option) any later version. |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
# This library is distributed in the hope that it will be useful, |
9
|
|
|
|
|
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
10
|
|
|
|
|
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
11
|
|
|
|
|
|
|
# Library General Public License for more details. |
12
|
|
|
|
|
|
|
# |
13
|
|
|
|
|
|
|
# You should have received a copy of the GNU Library General Public |
14
|
|
|
|
|
|
|
# License along with this library; if not, write to the |
15
|
|
|
|
|
|
|
# Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
16
|
|
|
|
|
|
|
# Boston, MA 02111-1307, USA. |
17
|
|
|
|
|
|
|
# |
18
|
|
|
|
|
|
|
# Jabber |
19
|
|
|
|
|
|
|
# Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/ |
20
|
|
|
|
|
|
|
# |
21
|
|
|
|
|
|
|
############################################################################## |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
package XML::Stream::Node; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head1 NAME |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
XML::Stream::Node - Functions to make building and parsing the tree easier |
28
|
|
|
|
|
|
|
to work with. |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head1 SYNOPSIS |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
Just a collection of functions that do not need to be in memory if you |
33
|
|
|
|
|
|
|
choose one of the other methods of data storage. |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
This creates a hierarchy of Perl objects and provides various methods |
36
|
|
|
|
|
|
|
to manipulate the structure of the tree. It is much like the C library |
37
|
|
|
|
|
|
|
libxml. |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=head1 FORMAT |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
The result of parsing: |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
Hello thereHowdydo |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
would be: |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
[ tag: foo |
48
|
|
|
|
|
|
|
att: {} |
49
|
|
|
|
|
|
|
children: [ tag: head |
50
|
|
|
|
|
|
|
att: {id=>"a"} |
51
|
|
|
|
|
|
|
children: [ tag: "__xmlstream__:node:cdata" |
52
|
|
|
|
|
|
|
children: "Hello " |
53
|
|
|
|
|
|
|
] |
54
|
|
|
|
|
|
|
[ tag: em |
55
|
|
|
|
|
|
|
children: [ tag: "__xmlstream__:node:cdata" |
56
|
|
|
|
|
|
|
children: "there" |
57
|
|
|
|
|
|
|
] |
58
|
|
|
|
|
|
|
] |
59
|
|
|
|
|
|
|
] |
60
|
|
|
|
|
|
|
[ tag: bar |
61
|
|
|
|
|
|
|
children: [ tag: "__xmlstream__:node:cdata" |
62
|
|
|
|
|
|
|
children: "Howdy " |
63
|
|
|
|
|
|
|
] |
64
|
|
|
|
|
|
|
[ tag: ref |
65
|
|
|
|
|
|
|
] |
66
|
|
|
|
|
|
|
] |
67
|
|
|
|
|
|
|
[ tag: "__xmlstream__:node:cdata" |
68
|
|
|
|
|
|
|
children: "do" |
69
|
|
|
|
|
|
|
] |
70
|
|
|
|
|
|
|
] |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=head1 METHODS |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
new() - creates a new node. If you specify tag, then the root |
75
|
|
|
|
|
|
|
new(tag) tag is set. If you specify data, then cdata is added |
76
|
|
|
|
|
|
|
new(tag,cdata) to the node as well. Returns the created node. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
get_tag() - returns the root tag of the node. |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
set_tag(tag) - set the root tag of the node to tag. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
add_child(node) - adds the specified node as a child to the current |
83
|
|
|
|
|
|
|
add_child(tag) node, or creates a new node with the specified tag |
84
|
|
|
|
|
|
|
add_child(tag,cdata) as the root node. Returns the node added. |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
remove_child(node) - removes the child node from the current node. |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
remove_cdata() - removes all of the cdata children from the current node. |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
add_cdata(string) - adds the string as cdata onto the current nodes |
91
|
|
|
|
|
|
|
child list. |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
get_cdata() - returns all of the cdata children concatenated together |
94
|
|
|
|
|
|
|
into one string. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
get_attrib(attrib) - returns the value of the attrib if it is valid, |
97
|
|
|
|
|
|
|
or returns undef is attrib is not a real |
98
|
|
|
|
|
|
|
attribute. |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
put_attrib(hash) - for each key/value pair specified, create an |
101
|
|
|
|
|
|
|
attribute in the node. |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
remove_attrib(attrib) - remove the specified attribute from the node. |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
add_raw_xml(string,[string,...]) - directly add a string into the XML |
106
|
|
|
|
|
|
|
packet as the last child, with no |
107
|
|
|
|
|
|
|
translation. |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
get_raw_xml() - return all of the XML in a single string, undef if there |
110
|
|
|
|
|
|
|
is no raw XML to include. |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
remove_raw_xml() - remove all raw XML strings. |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
children() - return all of the children of the node in a list. |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
attrib() - returns a hash containing all of the attributes on this |
117
|
|
|
|
|
|
|
node. |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
copy() - return a recursive copy of the node. |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
XPath(path) - run XML::Stream::XPath on this node. |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
XPathCheck(path) - run XML::Stream::XPath on this node and return 1 or 0 |
124
|
|
|
|
|
|
|
to see if it matches or not. |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
GetXML() - return the node in XML string form. |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=head1 AUTHOR |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
By Ryan Eatmon in June 2002 for http://jabber.org/ |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
Currently maintained by Darian Anthony Patrick. |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=head1 COPYRIGHT |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/ |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
This module licensed under the LGPL, version 2.1. |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=cut |
141
|
|
|
|
|
|
|
|
142
|
12
|
|
|
12
|
|
61
|
use strict; |
|
12
|
|
|
|
|
19
|
|
|
12
|
|
|
|
|
571
|
|
143
|
12
|
|
|
12
|
|
59
|
use warnings; |
|
12
|
|
|
|
|
18
|
|
|
12
|
|
|
|
|
401
|
|
144
|
12
|
|
|
12
|
|
56
|
use vars qw( $VERSION $LOADED ); |
|
12
|
|
|
|
|
14
|
|
|
12
|
|
|
|
|
41060
|
|
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
$VERSION = "1.24"; |
147
|
|
|
|
|
|
|
$LOADED = 1; |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
sub new |
150
|
|
|
|
|
|
|
{ |
151
|
796
|
|
|
796
|
0
|
3588
|
my $proto = shift; |
152
|
796
|
|
33
|
|
|
2284
|
my $class = ref($proto) || $proto; |
153
|
|
|
|
|
|
|
|
154
|
796
|
100
|
|
|
|
1379
|
if (ref($_[0]) eq "XML::Stream::Node") |
155
|
|
|
|
|
|
|
{ |
156
|
214
|
|
|
|
|
341
|
return $_[0]; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
582
|
|
|
|
|
643
|
my $self = {}; |
160
|
582
|
|
|
|
|
1089
|
bless($self, $proto); |
161
|
|
|
|
|
|
|
|
162
|
582
|
|
|
|
|
657
|
my ($tag,$data) = @_; |
163
|
|
|
|
|
|
|
|
164
|
582
|
100
|
|
|
|
1420
|
$self->set_tag($tag) if defined($tag); |
165
|
582
|
100
|
|
|
|
934
|
$self->add_cdata($data) if defined($data); |
166
|
582
|
|
|
|
|
881
|
$self->remove_raw_xml(); |
167
|
|
|
|
|
|
|
|
168
|
582
|
|
|
|
|
768
|
return $self; |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
sub debug |
173
|
|
|
|
|
|
|
{ |
174
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
175
|
0
|
|
|
|
|
0
|
my ($indent) = @_; |
176
|
|
|
|
|
|
|
|
177
|
0
|
0
|
|
|
|
0
|
$indent = "" unless defined($indent); |
178
|
|
|
|
|
|
|
|
179
|
0
|
0
|
|
|
|
0
|
if ($self->{TAG} eq "__xmlstream__:node:cdata") |
180
|
|
|
|
|
|
|
{ |
181
|
0
|
|
|
|
|
0
|
print $indent,"cdata(",join("",@{$self->{CHILDREN}}),")\n"; |
|
0
|
|
|
|
|
0
|
|
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
else |
184
|
|
|
|
|
|
|
{ |
185
|
0
|
|
|
|
|
0
|
print $indent,"packet($self):\n"; |
186
|
0
|
|
|
|
|
0
|
print $indent,"tag: <$self->{TAG}\n"; |
187
|
0
|
0
|
|
|
|
0
|
if (scalar(keys(%{$self->{ATTRIBS}})) > 0) |
|
0
|
|
|
|
|
0
|
|
188
|
|
|
|
|
|
|
{ |
189
|
0
|
|
|
|
|
0
|
print $indent,"attribs:\n"; |
190
|
0
|
|
|
|
|
0
|
foreach my $key (sort {$a cmp $b} keys(%{$self->{ATTRIBS}})) |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
191
|
|
|
|
|
|
|
{ |
192
|
0
|
|
|
|
|
0
|
print $indent," $key = '$self->{ATTRIBS}->{$key}'\n"; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
} |
195
|
0
|
0
|
|
|
|
0
|
if ($#{$self->{CHILDREN}} == -1) |
|
0
|
|
|
|
|
0
|
|
196
|
|
|
|
|
|
|
{ |
197
|
0
|
|
|
|
|
0
|
print $indent," />\n"; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
else |
200
|
|
|
|
|
|
|
{ |
201
|
0
|
|
|
|
|
0
|
print $indent," >\n"; |
202
|
0
|
|
|
|
|
0
|
print $indent,"children:\n"; |
203
|
0
|
|
|
|
|
0
|
foreach my $child (@{$self->{CHILDREN}}) |
|
0
|
|
|
|
|
0
|
|
204
|
|
|
|
|
|
|
{ |
205
|
0
|
|
|
|
|
0
|
$child->debug($indent." "); |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
} |
208
|
0
|
|
|
|
|
0
|
print $indent," $self->{TAG}>\n"; |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
sub children |
214
|
|
|
|
|
|
|
{ |
215
|
735
|
|
|
735
|
0
|
763
|
my $self = shift; |
216
|
|
|
|
|
|
|
|
217
|
735
|
100
|
|
|
|
1473
|
return () unless exists($self->{CHILDREN}); |
218
|
710
|
|
|
|
|
592
|
return @{$self->{CHILDREN}}; |
|
710
|
|
|
|
|
2195
|
|
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
sub add_child |
223
|
|
|
|
|
|
|
{ |
224
|
215
|
|
|
215
|
0
|
201
|
my $self = shift; |
225
|
|
|
|
|
|
|
|
226
|
215
|
|
|
|
|
343
|
my $child = XML::Stream::Node->new(@_); |
227
|
215
|
|
|
|
|
268
|
push(@{$self->{CHILDREN}},$child); |
|
215
|
|
|
|
|
375
|
|
228
|
215
|
|
|
|
|
254
|
return $child; |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
sub remove_child |
233
|
|
|
|
|
|
|
{ |
234
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
235
|
0
|
|
|
|
|
0
|
my $child = shift; |
236
|
|
|
|
|
|
|
|
237
|
0
|
|
|
|
|
0
|
foreach my $index (0..$#{$self->{CHILDREN}}) |
|
0
|
|
|
|
|
0
|
|
238
|
|
|
|
|
|
|
{ |
239
|
0
|
0
|
|
|
|
0
|
if ($child == $self->{CHILDREN}->[$index]) |
240
|
|
|
|
|
|
|
{ |
241
|
0
|
|
|
|
|
0
|
splice(@{$self->{CHILDREN}},$index,1); |
|
0
|
|
|
|
|
0
|
|
242
|
0
|
|
|
|
|
0
|
last; |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
sub add_cdata |
249
|
|
|
|
|
|
|
{ |
250
|
324
|
|
|
324
|
0
|
336
|
my $self = shift; |
251
|
324
|
|
|
|
|
590
|
my $child = XML::Stream::Node->new("__xmlstream__:node:cdata"); |
252
|
324
|
|
|
|
|
500
|
foreach my $cdata (@_) |
253
|
|
|
|
|
|
|
{ |
254
|
324
|
|
|
|
|
280
|
push(@{$child->{CHILDREN}},$cdata); |
|
324
|
|
|
|
|
997
|
|
255
|
|
|
|
|
|
|
} |
256
|
324
|
|
|
|
|
373
|
push(@{$self->{CHILDREN}},$child); |
|
324
|
|
|
|
|
564
|
|
257
|
324
|
|
|
|
|
739
|
return $child; |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
sub get_cdata |
262
|
|
|
|
|
|
|
{ |
263
|
31
|
|
|
31
|
0
|
41
|
my $self = shift; |
264
|
|
|
|
|
|
|
|
265
|
31
|
|
|
|
|
40
|
my $cdata = ""; |
266
|
31
|
|
|
|
|
26
|
foreach my $child (@{$self->{CHILDREN}}) |
|
31
|
|
|
|
|
69
|
|
267
|
|
|
|
|
|
|
{ |
268
|
33
|
100
|
|
|
|
52
|
$cdata .= join("",$child->children()) |
269
|
|
|
|
|
|
|
if ($child->get_tag() eq "__xmlstream__:node:cdata"); |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
31
|
|
|
|
|
49
|
return $cdata; |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
sub remove_cdata |
277
|
|
|
|
|
|
|
{ |
278
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
279
|
|
|
|
|
|
|
|
280
|
0
|
|
|
|
|
0
|
my @remove = (); |
281
|
0
|
|
|
|
|
0
|
foreach my $index (0..$#{$self->{CHILDREN}}) |
|
0
|
|
|
|
|
0
|
|
282
|
|
|
|
|
|
|
{ |
283
|
0
|
0
|
|
|
|
0
|
if ($self->{CHILDREN}->[$index]->get_tag() eq "__xmlstream__:node:cdata") |
284
|
|
|
|
|
|
|
{ |
285
|
|
|
|
|
|
|
|
286
|
0
|
|
|
|
|
0
|
unshift(@remove,$index); |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
} |
289
|
0
|
|
|
|
|
0
|
foreach my $index (@remove) |
290
|
|
|
|
|
|
|
{ |
291
|
0
|
|
|
|
|
0
|
splice(@{$self->{CHILDREN}},$index,1); |
|
0
|
|
|
|
|
0
|
|
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
sub attrib |
297
|
|
|
|
|
|
|
{ |
298
|
127
|
|
|
127
|
0
|
160
|
my $self = shift; |
299
|
127
|
100
|
|
|
|
430
|
return () unless exists($self->{ATTRIBS}); |
300
|
46
|
|
|
|
|
47
|
return %{$self->{ATTRIBS}}; |
|
46
|
|
|
|
|
232
|
|
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
sub get_attrib |
305
|
|
|
|
|
|
|
{ |
306
|
295
|
|
|
295
|
0
|
414
|
my $self = shift; |
307
|
295
|
|
|
|
|
284
|
my ($key) = @_; |
308
|
|
|
|
|
|
|
|
309
|
295
|
100
|
|
|
|
699
|
return unless exists($self->{ATTRIBS}->{$key}); |
310
|
204
|
|
|
|
|
564
|
return $self->{ATTRIBS}->{$key}; |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
sub put_attrib |
315
|
|
|
|
|
|
|
{ |
316
|
256
|
|
|
256
|
0
|
231
|
my $self = shift; |
317
|
256
|
|
|
|
|
351
|
my (%att) = @_; |
318
|
|
|
|
|
|
|
|
319
|
256
|
|
|
|
|
571
|
foreach my $key (keys(%att)) |
320
|
|
|
|
|
|
|
{ |
321
|
79
|
|
|
|
|
339
|
$self->{ATTRIBS}->{$key} = $att{$key}; |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
sub remove_attrib |
327
|
|
|
|
|
|
|
{ |
328
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
329
|
0
|
|
|
|
|
0
|
my ($key) = @_; |
330
|
|
|
|
|
|
|
|
331
|
0
|
0
|
|
|
|
0
|
return unless exists($self->{ATTRIBS}->{$key}); |
332
|
0
|
|
|
|
|
0
|
delete($self->{ATTRIBS}->{$key}); |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
sub add_raw_xml |
337
|
|
|
|
|
|
|
{ |
338
|
17
|
|
|
17
|
0
|
15103
|
my $self = shift; |
339
|
17
|
|
|
|
|
50
|
my (@raw) = @_; |
340
|
|
|
|
|
|
|
|
341
|
17
|
|
|
|
|
28
|
push(@{$self->{RAWXML}},@raw); |
|
17
|
|
|
|
|
78
|
|
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
sub get_raw_xml |
345
|
|
|
|
|
|
|
{ |
346
|
159
|
|
|
159
|
0
|
179
|
my $self = shift; |
347
|
|
|
|
|
|
|
|
348
|
159
|
100
|
|
|
|
142
|
return if ($#{$self->{RAWXML}} == -1); |
|
159
|
|
|
|
|
635
|
|
349
|
53
|
|
|
|
|
65
|
return join("",@{$self->{RAWXML}}); |
|
53
|
|
|
|
|
272
|
|
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
sub remove_raw_xml |
354
|
|
|
|
|
|
|
{ |
355
|
582
|
|
|
582
|
0
|
485
|
my $self = shift; |
356
|
582
|
|
|
|
|
976
|
$self->{RAWXML} = []; |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
sub get_tag |
361
|
|
|
|
|
|
|
{ |
362
|
4039
|
|
|
4039
|
0
|
3307
|
my $self = shift; |
363
|
|
|
|
|
|
|
|
364
|
4039
|
|
|
|
|
12276
|
return $self->{TAG}; |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
sub set_tag |
369
|
|
|
|
|
|
|
{ |
370
|
582
|
|
|
582
|
0
|
1493
|
my $self = shift; |
371
|
582
|
|
|
|
|
571
|
my ($tag) = @_; |
372
|
|
|
|
|
|
|
|
373
|
582
|
|
|
|
|
1287
|
$self->{TAG} = $tag; |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
sub XPath |
378
|
|
|
|
|
|
|
{ |
379
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
380
|
0
|
|
|
|
|
0
|
my @results = &XML::Stream::XPath($self,@_); |
381
|
0
|
0
|
|
|
|
0
|
return unless ($#results > -1); |
382
|
0
|
0
|
|
|
|
0
|
return $results[0] unless wantarray; |
383
|
0
|
|
|
|
|
0
|
return @results; |
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
sub XPathCheck |
388
|
|
|
|
|
|
|
{ |
389
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
390
|
0
|
|
|
|
|
0
|
return &XML::Stream::XPathCheck($self,@_); |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
sub GetXML |
395
|
|
|
|
|
|
|
{ |
396
|
5
|
|
|
5
|
0
|
2689
|
my $self = shift; |
397
|
|
|
|
|
|
|
|
398
|
5
|
|
|
|
|
20
|
return &BuildXML($self,@_); |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
sub copy |
403
|
|
|
|
|
|
|
{ |
404
|
3
|
|
|
3
|
0
|
9
|
my $self = shift; |
405
|
|
|
|
|
|
|
|
406
|
3
|
|
|
|
|
9
|
my $new_node = XML::Stream::Node->new(); |
407
|
3
|
|
|
|
|
7
|
$new_node->set_tag($self->get_tag()); |
408
|
3
|
|
|
|
|
7
|
$new_node->put_attrib($self->attrib()); |
409
|
|
|
|
|
|
|
|
410
|
3
|
|
|
|
|
8
|
foreach my $child ($self->children()) |
411
|
|
|
|
|
|
|
{ |
412
|
5
|
100
|
|
|
|
8
|
if ($child->get_tag() eq "__xmlstream__:node:cdata") |
413
|
|
|
|
|
|
|
{ |
414
|
4
|
|
|
|
|
8
|
$new_node->add_cdata($child->children()); |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
else |
417
|
|
|
|
|
|
|
{ |
418
|
1
|
|
|
|
|
6
|
$new_node->add_child($child->copy()); |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
|
422
|
3
|
|
|
|
|
11
|
return $new_node; |
423
|
|
|
|
|
|
|
} |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
############################################################################## |
430
|
|
|
|
|
|
|
# |
431
|
|
|
|
|
|
|
# _handle_element - handles the main tag elements sent from the server. |
432
|
|
|
|
|
|
|
# On an open tag it creates a new XML::Parser::Node so |
433
|
|
|
|
|
|
|
# that _handle_cdata and _handle_element can add data |
434
|
|
|
|
|
|
|
# and tags to it later. |
435
|
|
|
|
|
|
|
# |
436
|
|
|
|
|
|
|
############################################################################## |
437
|
|
|
|
|
|
|
sub _handle_element |
438
|
|
|
|
|
|
|
{ |
439
|
252
|
|
|
252
|
|
236
|
my $self; |
440
|
252
|
100
|
|
|
|
572
|
$self = $_[0] if (ref($_[0]) eq "XML::Stream::Parser"); |
441
|
252
|
100
|
|
|
|
466
|
$self = shift unless (ref($_[0]) eq "XML::Stream::Parser"); |
442
|
252
|
|
|
|
|
405
|
my ($sax, $tag, %att) = @_; |
443
|
252
|
|
|
|
|
504
|
my $sid = $sax->getSID(); |
444
|
|
|
|
|
|
|
|
445
|
252
|
|
|
|
|
1101
|
$self->debug(2,"Node: _handle_element: sid($sid) sax($sax) tag($tag) att(",%att,")"); |
446
|
|
|
|
|
|
|
|
447
|
252
|
|
|
|
|
577
|
my $node = XML::Stream::Node->new($tag); |
448
|
252
|
|
|
|
|
467
|
$node->put_attrib(%att); |
449
|
|
|
|
|
|
|
|
450
|
252
|
|
|
|
|
308
|
$self->debug(2,"Node: _handle_element: check(",$#{$self->{SIDS}->{$sid}->{node}},")"); |
|
252
|
|
|
|
|
975
|
|
451
|
|
|
|
|
|
|
|
452
|
252
|
100
|
|
|
|
229
|
if ($#{$self->{SIDS}->{$sid}->{node}} >= 0) |
|
252
|
|
|
|
|
653
|
|
453
|
|
|
|
|
|
|
{ |
454
|
213
|
|
|
|
|
309
|
$self->{SIDS}->{$sid}->{node}->[$#{$self->{SIDS}->{$sid}->{node}}]-> |
|
213
|
|
|
|
|
486
|
|
455
|
|
|
|
|
|
|
add_child($node); |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
|
458
|
252
|
|
|
|
|
283
|
push(@{$self->{SIDS}->{$sid}->{node}},$node); |
|
252
|
|
|
|
|
825
|
|
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
############################################################################## |
463
|
|
|
|
|
|
|
# |
464
|
|
|
|
|
|
|
# _handle_cdata - handles the CDATA that is encountered. Also, in the |
465
|
|
|
|
|
|
|
# spirit of XML::Parser::Node it combines any sequential |
466
|
|
|
|
|
|
|
# CDATA into one tag. |
467
|
|
|
|
|
|
|
# |
468
|
|
|
|
|
|
|
############################################################################## |
469
|
|
|
|
|
|
|
sub _handle_cdata |
470
|
|
|
|
|
|
|
{ |
471
|
352
|
|
|
352
|
|
316
|
my $self; |
472
|
352
|
100
|
|
|
|
743
|
$self = $_[0] if (ref($_[0]) eq "XML::Stream::Parser"); |
473
|
352
|
100
|
|
|
|
709
|
$self = shift unless (ref($_[0]) eq "XML::Stream::Parser"); |
474
|
352
|
|
|
|
|
434
|
my ($sax, $cdata) = @_; |
475
|
352
|
|
|
|
|
745
|
my $sid = $sax->getSID(); |
476
|
|
|
|
|
|
|
|
477
|
352
|
|
|
|
|
1420
|
$self->debug(2,"Node: _handle_cdata: sid($sid) sax($sax) cdata($cdata)"); |
478
|
|
|
|
|
|
|
|
479
|
352
|
100
|
|
|
|
314
|
return if ($#{$self->{SIDS}->{$sid}->{node}} == -1); |
|
352
|
|
|
|
|
1070
|
|
480
|
|
|
|
|
|
|
|
481
|
316
|
|
|
|
|
930
|
$self->debug(2,"Node: _handle_cdata: sax($sax) cdata($cdata)"); |
482
|
|
|
|
|
|
|
|
483
|
316
|
|
|
|
|
451
|
$self->{SIDS}->{$sid}->{node}->[$#{$self->{SIDS}->{$sid}->{node}}]-> |
|
316
|
|
|
|
|
770
|
|
484
|
|
|
|
|
|
|
add_cdata($cdata); |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
############################################################################## |
489
|
|
|
|
|
|
|
# |
490
|
|
|
|
|
|
|
# _handle_close - when we see a close tag we need to pop the last element |
491
|
|
|
|
|
|
|
# from the list and push it onto the end of the previous |
492
|
|
|
|
|
|
|
# element. This is how we build our hierarchy. |
493
|
|
|
|
|
|
|
# |
494
|
|
|
|
|
|
|
############################################################################## |
495
|
|
|
|
|
|
|
sub _handle_close |
496
|
|
|
|
|
|
|
{ |
497
|
254
|
|
|
254
|
|
239
|
my $self; |
498
|
254
|
100
|
|
|
|
558
|
$self = $_[0] if (ref($_[0]) eq "XML::Stream::Parser"); |
499
|
254
|
100
|
|
|
|
482
|
$self = shift unless (ref($_[0]) eq "XML::Stream::Parser"); |
500
|
254
|
|
|
|
|
306
|
my ($sax, $tag) = @_; |
501
|
254
|
|
|
|
|
525
|
my $sid = $sax->getSID(); |
502
|
|
|
|
|
|
|
|
503
|
254
|
|
|
|
|
938
|
$self->debug(2,"Node: _handle_close: sid($sid) sax($sax) tag($tag)"); |
504
|
|
|
|
|
|
|
|
505
|
254
|
|
|
|
|
258
|
$self->debug(2,"Node: _handle_close: check(",$#{$self->{SIDS}->{$sid}->{node}},")"); |
|
254
|
|
|
|
|
711
|
|
506
|
|
|
|
|
|
|
|
507
|
254
|
100
|
|
|
|
225
|
if ($#{$self->{SIDS}->{$sid}->{node}} == -1) |
|
254
|
|
|
|
|
677
|
|
508
|
|
|
|
|
|
|
{ |
509
|
2
|
|
|
|
|
17
|
$self->debug(2,"Node: _handle_close: rootTag($self->{SIDS}->{$sid}->{rootTag}) tag($tag)"); |
510
|
2
|
50
|
|
|
|
11
|
if ($self->{SIDS}->{$sid}->{rootTag} ne $tag) |
511
|
|
|
|
|
|
|
{ |
512
|
0
|
|
|
|
|
0
|
$self->{SIDS}->{$sid}->{streamerror} = "Root tag mis-match: <$self->{SIDS}->{$sid}->{rootTag}> ... $tag>\n"; |
513
|
|
|
|
|
|
|
} |
514
|
2
|
|
|
|
|
6
|
return; |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
|
517
|
252
|
|
|
|
|
247
|
my $CLOSED = pop @{$self->{SIDS}->{$sid}->{node}}; |
|
252
|
|
|
|
|
454
|
|
518
|
|
|
|
|
|
|
|
519
|
252
|
|
|
|
|
260
|
$self->debug(2,"Node: _handle_close: check2(",$#{$self->{SIDS}->{$sid}->{node}},")"); |
|
252
|
|
|
|
|
616
|
|
520
|
|
|
|
|
|
|
|
521
|
252
|
100
|
|
|
|
241
|
if($#{$self->{SIDS}->{$sid}->{node}} == -1) |
|
252
|
|
|
|
|
866
|
|
522
|
|
|
|
|
|
|
{ |
523
|
39
|
|
|
|
|
56
|
push @{$self->{SIDS}->{$sid}->{node}}, $CLOSED; |
|
39
|
|
|
|
|
102
|
|
524
|
|
|
|
|
|
|
|
525
|
39
|
100
|
|
|
|
132
|
if (ref($self) ne "XML::Stream::Parser") |
526
|
|
|
|
|
|
|
{ |
527
|
37
|
|
|
|
|
143
|
my $stream_prefix = $self->StreamPrefix($sid); |
528
|
|
|
|
|
|
|
|
529
|
37
|
100
|
66
|
|
|
317
|
if(defined($self->{SIDS}->{$sid}->{node}->[0]) && |
530
|
|
|
|
|
|
|
($self->{SIDS}->{$sid}->{node}->[0]->get_tag() =~ /^${stream_prefix}\:/)) |
531
|
|
|
|
|
|
|
{ |
532
|
3
|
|
|
|
|
11
|
my $node = $self->{SIDS}->{$sid}->{node}->[0]; |
533
|
3
|
|
|
|
|
10
|
$self->{SIDS}->{$sid}->{node} = []; |
534
|
3
|
|
|
|
|
16
|
$self->ProcessStreamPacket($sid,$node); |
535
|
|
|
|
|
|
|
} |
536
|
|
|
|
|
|
|
else |
537
|
|
|
|
|
|
|
{ |
538
|
34
|
|
|
|
|
109
|
my $node = $self->{SIDS}->{$sid}->{node}->[0]; |
539
|
34
|
|
|
|
|
99
|
$self->{SIDS}->{$sid}->{node} = []; |
540
|
|
|
|
|
|
|
|
541
|
34
|
|
|
|
|
121
|
my @special = |
542
|
|
|
|
|
|
|
&XML::Stream::XPath( |
543
|
|
|
|
|
|
|
$node, |
544
|
|
|
|
|
|
|
'[@xmlns="'.&XML::Stream::ConstXMLNS("xmpp-sasl").'" or @xmlns="'.&XML::Stream::ConstXMLNS("xmpp-tls").'"]' |
545
|
|
|
|
|
|
|
); |
546
|
34
|
50
|
|
|
|
116
|
if ($#special > -1) |
547
|
|
|
|
|
|
|
{ |
548
|
0
|
|
|
|
|
0
|
my $xmlns = $node->get_attrib("xmlns"); |
549
|
|
|
|
|
|
|
|
550
|
0
|
0
|
|
|
|
0
|
$self->ProcessSASLPacket($sid,$node) |
551
|
|
|
|
|
|
|
if ($xmlns eq &XML::Stream::ConstXMLNS("xmpp-sasl")); |
552
|
0
|
0
|
|
|
|
0
|
$self->ProcessTLSPacket($sid,$node) |
553
|
|
|
|
|
|
|
if ($xmlns eq &XML::Stream::ConstXMLNS("xmpp-tls")); |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
else |
556
|
|
|
|
|
|
|
{ |
557
|
34
|
|
|
|
|
58
|
&{$self->{CB}->{node}}($sid,$node); |
|
34
|
|
|
|
|
176
|
|
558
|
|
|
|
|
|
|
} |
559
|
|
|
|
|
|
|
} |
560
|
|
|
|
|
|
|
} |
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
} |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
############################################################################## |
566
|
|
|
|
|
|
|
# |
567
|
|
|
|
|
|
|
# SetXMLData - takes a host of arguments and sets a portion of the specified |
568
|
|
|
|
|
|
|
# XML::Parser::Node object with that data. The function works |
569
|
|
|
|
|
|
|
# in two modes "single" or "multiple". "single" denotes that |
570
|
|
|
|
|
|
|
# the function should locate the current tag that matches this |
571
|
|
|
|
|
|
|
# data and overwrite it's contents with data passed in. |
572
|
|
|
|
|
|
|
# "multiple" denotes that a new tag should be created even if |
573
|
|
|
|
|
|
|
# others exist. |
574
|
|
|
|
|
|
|
# |
575
|
|
|
|
|
|
|
# type - single or multiple |
576
|
|
|
|
|
|
|
# XMLTree - pointer to XML::Stream Node object |
577
|
|
|
|
|
|
|
# tag - name of tag to create/modify (if blank assumes |
578
|
|
|
|
|
|
|
# working with top level tag) |
579
|
|
|
|
|
|
|
# data - CDATA to set for tag |
580
|
|
|
|
|
|
|
# attribs - attributes to ADD to tag |
581
|
|
|
|
|
|
|
# |
582
|
|
|
|
|
|
|
############################################################################## |
583
|
|
|
|
|
|
|
sub SetXMLData |
584
|
|
|
|
|
|
|
{ |
585
|
0
|
|
|
0
|
0
|
0
|
my ($type,$XMLTree,$tag,$data,$attribs) = @_; |
586
|
|
|
|
|
|
|
|
587
|
0
|
0
|
|
|
|
0
|
if ($tag ne "") |
588
|
|
|
|
|
|
|
{ |
589
|
0
|
0
|
|
|
|
0
|
if ($type eq "single") |
590
|
|
|
|
|
|
|
{ |
591
|
0
|
|
|
|
|
0
|
foreach my $child ($XMLTree->children()) |
592
|
|
|
|
|
|
|
{ |
593
|
0
|
0
|
|
|
|
0
|
if ($$XMLTree[1]->[$child] eq $tag) |
594
|
|
|
|
|
|
|
{ |
595
|
0
|
|
|
|
|
0
|
$XMLTree->remove_child($child); |
596
|
|
|
|
|
|
|
|
597
|
0
|
|
|
|
|
0
|
my $newChild = $XMLTree->add_child($tag); |
598
|
0
|
|
|
|
|
0
|
$newChild->put_attrib(%{$attribs}); |
|
0
|
|
|
|
|
0
|
|
599
|
0
|
0
|
|
|
|
0
|
$newChild->add_cdata($data) if ($data ne ""); |
600
|
0
|
|
|
|
|
0
|
return; |
601
|
|
|
|
|
|
|
} |
602
|
|
|
|
|
|
|
} |
603
|
|
|
|
|
|
|
} |
604
|
0
|
|
|
|
|
0
|
my $newChild = $XMLTree->add_child($tag); |
605
|
0
|
|
|
|
|
0
|
$newChild->put_attrib(%{$attribs}); |
|
0
|
|
|
|
|
0
|
|
606
|
0
|
0
|
|
|
|
0
|
$newChild->add_cdata($data) if ($data ne ""); |
607
|
|
|
|
|
|
|
} |
608
|
|
|
|
|
|
|
else |
609
|
|
|
|
|
|
|
{ |
610
|
0
|
|
|
|
|
0
|
$XMLTree->put_attrib(%{$attribs}); |
|
0
|
|
|
|
|
0
|
|
611
|
0
|
0
|
|
|
|
0
|
$XMLTree->add_cdata($data) if ($data ne ""); |
612
|
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
|
} |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
############################################################################## |
617
|
|
|
|
|
|
|
# |
618
|
|
|
|
|
|
|
# GetXMLData - takes a host of arguments and returns various data structures |
619
|
|
|
|
|
|
|
# that match them. |
620
|
|
|
|
|
|
|
# |
621
|
|
|
|
|
|
|
# type - "existence" - returns 1 or 0 if the tag exists in the |
622
|
|
|
|
|
|
|
# top level. |
623
|
|
|
|
|
|
|
# "value" - returns either the CDATA of the tag, or the |
624
|
|
|
|
|
|
|
# value of the attribute depending on which is |
625
|
|
|
|
|
|
|
# sought. This ignores any mark ups to the data |
626
|
|
|
|
|
|
|
# and just returns the raw CDATA. |
627
|
|
|
|
|
|
|
# "value array" - returns an array of strings representing |
628
|
|
|
|
|
|
|
# all of the CDATA in the specified tag. |
629
|
|
|
|
|
|
|
# This ignores any mark ups to the data |
630
|
|
|
|
|
|
|
# and just returns the raw CDATA. |
631
|
|
|
|
|
|
|
# "tree" - returns an XML::Parser::Node object with the |
632
|
|
|
|
|
|
|
# specified tag as the root tag. |
633
|
|
|
|
|
|
|
# "tree array" - returns an array of XML::Parser::Node |
634
|
|
|
|
|
|
|
# objects each with the specified tag as |
635
|
|
|
|
|
|
|
# the root tag. |
636
|
|
|
|
|
|
|
# "child array" - returns a list of all children nodes |
637
|
|
|
|
|
|
|
# not including CDATA nodes. |
638
|
|
|
|
|
|
|
# "attribs" - returns a hash with the attributes, and |
639
|
|
|
|
|
|
|
# their values, for the things that match |
640
|
|
|
|
|
|
|
# the parameters |
641
|
|
|
|
|
|
|
# "count" - returns the number of things that match |
642
|
|
|
|
|
|
|
# the arguments |
643
|
|
|
|
|
|
|
# "tag" - returns the root tag of this tree |
644
|
|
|
|
|
|
|
# XMLTree - pointer to XML::Parser::Node object |
645
|
|
|
|
|
|
|
# tag - tag to pull data from. If blank then the top level |
646
|
|
|
|
|
|
|
# tag is accessed. |
647
|
|
|
|
|
|
|
# attrib - attribute value to retrieve. Ignored for types |
648
|
|
|
|
|
|
|
# "value array", "tree", "tree array". If paired |
649
|
|
|
|
|
|
|
# with value can be used to filter tags based on |
650
|
|
|
|
|
|
|
# attributes and values. |
651
|
|
|
|
|
|
|
# value - only valid if an attribute is supplied. Used to |
652
|
|
|
|
|
|
|
# filter for tags that only contain this attribute. |
653
|
|
|
|
|
|
|
# Useful to search through multiple tags that all |
654
|
|
|
|
|
|
|
# reference different name spaces. |
655
|
|
|
|
|
|
|
# |
656
|
|
|
|
|
|
|
############################################################################## |
657
|
|
|
|
|
|
|
sub GetXMLData |
658
|
|
|
|
|
|
|
{ |
659
|
976
|
|
|
976
|
0
|
1080
|
my ($type,$XMLTree,$tag,$attrib,$value) = @_; |
660
|
|
|
|
|
|
|
|
661
|
976
|
100
|
|
|
|
1480
|
$tag = "" if !defined($tag); |
662
|
976
|
100
|
|
|
|
1375
|
$attrib = "" if !defined($attrib); |
663
|
976
|
50
|
|
|
|
1329
|
$value = "" if !defined($value); |
664
|
|
|
|
|
|
|
|
665
|
976
|
|
|
|
|
738
|
my $skipthis = 0; |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
#------------------------------------------------------------------------- |
668
|
|
|
|
|
|
|
# Check if a child tag in the root tag is being requested. |
669
|
|
|
|
|
|
|
#------------------------------------------------------------------------- |
670
|
976
|
100
|
|
|
|
1141
|
if ($tag ne "") |
671
|
|
|
|
|
|
|
{ |
672
|
338
|
|
|
|
|
270
|
my $count = 0; |
673
|
338
|
|
|
|
|
255
|
my @array; |
674
|
338
|
|
|
|
|
468
|
foreach my $child ($XMLTree->children()) |
675
|
|
|
|
|
|
|
{ |
676
|
1840
|
100
|
100
|
|
|
2175
|
if (($child->get_tag() eq $tag) || ($tag eq "*")) |
677
|
|
|
|
|
|
|
{ |
678
|
|
|
|
|
|
|
#------------------------------------------------------------- |
679
|
|
|
|
|
|
|
# Filter out tags that do not contain the attribute and value. |
680
|
|
|
|
|
|
|
#------------------------------------------------------------- |
681
|
1205
|
0
|
33
|
|
|
1911
|
next if (($value ne "") && ($attrib ne "") && $child->get_attrib($attrib) && ($XMLTree->get_attrib($attrib) ne $value)); |
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
682
|
1205
|
50
|
33
|
|
|
1970
|
next if (($attrib ne "") && !$child->get_attrib($attrib)); |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
#------------------------------------------------------------- |
685
|
|
|
|
|
|
|
# Check for existence |
686
|
|
|
|
|
|
|
#------------------------------------------------------------- |
687
|
1205
|
50
|
|
|
|
1592
|
if ($type eq "existence") |
688
|
|
|
|
|
|
|
{ |
689
|
0
|
|
|
|
|
0
|
return 1; |
690
|
|
|
|
|
|
|
} |
691
|
|
|
|
|
|
|
#------------------------------------------------------------- |
692
|
|
|
|
|
|
|
# Return the raw CDATA value without mark ups, or the value of |
693
|
|
|
|
|
|
|
# the requested attribute. |
694
|
|
|
|
|
|
|
#------------------------------------------------------------- |
695
|
1205
|
100
|
|
|
|
1531
|
if ($type eq "value") |
696
|
|
|
|
|
|
|
{ |
697
|
4
|
50
|
|
|
|
14
|
if ($attrib eq "") |
698
|
|
|
|
|
|
|
{ |
699
|
4
|
|
|
|
|
13
|
my $str = $child->get_cdata(); |
700
|
4
|
|
|
|
|
19
|
return $str; |
701
|
|
|
|
|
|
|
} |
702
|
0
|
0
|
|
|
|
0
|
return $XMLTree->get_attrib($attrib) |
703
|
|
|
|
|
|
|
if defined($XMLTree->get_attrib($attrib)); |
704
|
|
|
|
|
|
|
} |
705
|
|
|
|
|
|
|
#------------------------------------------------------------- |
706
|
|
|
|
|
|
|
# Return an array of values that represent the raw CDATA without |
707
|
|
|
|
|
|
|
# mark up tags for the requested tags. |
708
|
|
|
|
|
|
|
#------------------------------------------------------------- |
709
|
1201
|
50
|
|
|
|
1568
|
if ($type eq "value array") |
710
|
|
|
|
|
|
|
{ |
711
|
0
|
0
|
|
|
|
0
|
if ($attrib eq "") |
712
|
|
|
|
|
|
|
{ |
713
|
0
|
|
|
|
|
0
|
my $str = $child->get_cdata(); |
714
|
0
|
|
|
|
|
0
|
push(@array,$str); |
715
|
|
|
|
|
|
|
} |
716
|
|
|
|
|
|
|
else |
717
|
|
|
|
|
|
|
{ |
718
|
0
|
0
|
|
|
|
0
|
push(@array, $XMLTree->get_attrib($attrib)) |
719
|
|
|
|
|
|
|
if defined($XMLTree->get_attrib($attrib)); |
720
|
|
|
|
|
|
|
} |
721
|
|
|
|
|
|
|
} |
722
|
|
|
|
|
|
|
#------------------------------------------------------------- |
723
|
|
|
|
|
|
|
# Return a pointer to a new XML::Parser::Tree object that has |
724
|
|
|
|
|
|
|
# the requested tag as the root tag. |
725
|
|
|
|
|
|
|
#------------------------------------------------------------- |
726
|
1201
|
50
|
|
|
|
1431
|
if ($type eq "tree") |
727
|
|
|
|
|
|
|
{ |
728
|
0
|
|
|
|
|
0
|
return $child; |
729
|
|
|
|
|
|
|
} |
730
|
|
|
|
|
|
|
#------------------------------------------------------------- |
731
|
|
|
|
|
|
|
# Return an array of pointers to XML::Parser::Tree objects |
732
|
|
|
|
|
|
|
# that have the requested tag as the root tags. |
733
|
|
|
|
|
|
|
#------------------------------------------------------------- |
734
|
1201
|
100
|
|
|
|
1494
|
if ($type eq "tree array") |
735
|
|
|
|
|
|
|
{ |
736
|
144
|
|
|
|
|
140
|
push(@array,$child); |
737
|
|
|
|
|
|
|
} |
738
|
|
|
|
|
|
|
#------------------------------------------------------------- |
739
|
|
|
|
|
|
|
# Return an array of pointers to XML::Parser::Tree objects |
740
|
|
|
|
|
|
|
# that have the requested tag as the root tags. |
741
|
|
|
|
|
|
|
#------------------------------------------------------------- |
742
|
1201
|
100
|
|
|
|
1529
|
if ($type eq "child array") |
743
|
|
|
|
|
|
|
{ |
744
|
949
|
100
|
|
|
|
1009
|
push(@array,$child) if ($child->get_tag() ne "__xmlstream__:node:cdata"); |
745
|
|
|
|
|
|
|
} |
746
|
|
|
|
|
|
|
#------------------------------------------------------------- |
747
|
|
|
|
|
|
|
# Return a count of the number of tags that match |
748
|
|
|
|
|
|
|
#------------------------------------------------------------- |
749
|
1201
|
100
|
|
|
|
1738
|
if ($type eq "count") |
750
|
|
|
|
|
|
|
{ |
751
|
108
|
|
|
|
|
99
|
$count++; |
752
|
|
|
|
|
|
|
} |
753
|
|
|
|
|
|
|
#------------------------------------------------------------- |
754
|
|
|
|
|
|
|
# Return the attribute hash that matches this tag |
755
|
|
|
|
|
|
|
#------------------------------------------------------------- |
756
|
1201
|
50
|
|
|
|
1964
|
if ($type eq "attribs") |
757
|
|
|
|
|
|
|
{ |
758
|
0
|
|
|
|
|
0
|
return $XMLTree->attrib(); |
759
|
|
|
|
|
|
|
} |
760
|
|
|
|
|
|
|
} |
761
|
|
|
|
|
|
|
} |
762
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
763
|
|
|
|
|
|
|
# If we are returning arrays then return array. |
764
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
765
|
334
|
100
|
66
|
|
|
1427
|
if (($type eq "tree array") || ($type eq "value array") || |
|
|
|
100
|
|
|
|
|
766
|
|
|
|
|
|
|
($type eq "child array")) |
767
|
|
|
|
|
|
|
{ |
768
|
276
|
|
|
|
|
694
|
return @array; |
769
|
|
|
|
|
|
|
} |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
772
|
|
|
|
|
|
|
# If we are returning then count, then do so |
773
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
774
|
58
|
50
|
|
|
|
86
|
if ($type eq "count") |
775
|
|
|
|
|
|
|
{ |
776
|
58
|
|
|
|
|
147
|
return $count; |
777
|
|
|
|
|
|
|
} |
778
|
|
|
|
|
|
|
} |
779
|
|
|
|
|
|
|
else |
780
|
|
|
|
|
|
|
{ |
781
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
782
|
|
|
|
|
|
|
# This is the root tag, so handle things a level up. |
783
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
786
|
|
|
|
|
|
|
# Return the raw CDATA value without mark ups, or the value of the |
787
|
|
|
|
|
|
|
# requested attribute. |
788
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
789
|
638
|
100
|
|
|
|
952
|
if ($type eq "value") |
790
|
|
|
|
|
|
|
{ |
791
|
193
|
100
|
|
|
|
314
|
if ($attrib eq "") |
792
|
|
|
|
|
|
|
{ |
793
|
25
|
|
|
|
|
67
|
my $str = $XMLTree->get_cdata(); |
794
|
25
|
|
|
|
|
100
|
return $str; |
795
|
|
|
|
|
|
|
} |
796
|
168
|
100
|
|
|
|
329
|
return $XMLTree->get_attrib($attrib) |
797
|
|
|
|
|
|
|
if $XMLTree->get_attrib($attrib); |
798
|
|
|
|
|
|
|
} |
799
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
800
|
|
|
|
|
|
|
# Return a pointer to a new XML::Parser::Tree object that has the |
801
|
|
|
|
|
|
|
# requested tag as the root tag. |
802
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
803
|
523
|
50
|
|
|
|
715
|
if ($type eq "tree") |
804
|
|
|
|
|
|
|
{ |
805
|
0
|
|
|
|
|
0
|
return $XMLTree; |
806
|
|
|
|
|
|
|
} |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
809
|
|
|
|
|
|
|
# Return the 1 if the specified attribute exists in the root tag. |
810
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
811
|
523
|
50
|
|
|
|
670
|
if ($type eq "existence") |
812
|
|
|
|
|
|
|
{ |
813
|
0
|
0
|
|
|
|
0
|
if ($attrib ne "") |
814
|
|
|
|
|
|
|
{ |
815
|
0
|
0
|
|
|
|
0
|
return ($XMLTree->get_attrib($attrib) eq $value) if ($value ne ""); |
816
|
0
|
|
|
|
|
0
|
return defined($XMLTree->get_attrib($attrib)); |
817
|
|
|
|
|
|
|
} |
818
|
0
|
|
|
|
|
0
|
return 0; |
819
|
|
|
|
|
|
|
} |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
822
|
|
|
|
|
|
|
# Return the attribute hash that matches this tag |
823
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
824
|
523
|
100
|
|
|
|
687
|
if ($type eq "attribs") |
825
|
|
|
|
|
|
|
{ |
826
|
1
|
|
|
|
|
5
|
return $XMLTree->attrib(); |
827
|
|
|
|
|
|
|
} |
828
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
829
|
|
|
|
|
|
|
# Return the tag of this node |
830
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
831
|
522
|
100
|
|
|
|
750
|
if ($type eq "tag") |
832
|
|
|
|
|
|
|
{ |
833
|
444
|
|
|
|
|
520
|
return $XMLTree->get_tag(); |
834
|
|
|
|
|
|
|
} |
835
|
|
|
|
|
|
|
} |
836
|
|
|
|
|
|
|
#------------------------------------------------------------------------- |
837
|
|
|
|
|
|
|
# Return 0 if this was a request for existence, or "" if a request for |
838
|
|
|
|
|
|
|
# a "value", or [] for "tree", "value array", and "tree array". |
839
|
|
|
|
|
|
|
#------------------------------------------------------------------------- |
840
|
78
|
50
|
|
|
|
146
|
return 0 if ($type eq "existence"); |
841
|
78
|
50
|
|
|
|
461
|
return "" if ($type eq "value"); |
842
|
0
|
|
|
|
|
0
|
return []; |
843
|
|
|
|
|
|
|
} |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
############################################################################## |
847
|
|
|
|
|
|
|
# |
848
|
|
|
|
|
|
|
# BuildXML - takes an XML::Parser::Tree object and builds the XML string |
849
|
|
|
|
|
|
|
# that it represents. |
850
|
|
|
|
|
|
|
# |
851
|
|
|
|
|
|
|
############################################################################## |
852
|
|
|
|
|
|
|
sub BuildXML |
853
|
|
|
|
|
|
|
{ |
854
|
123
|
|
|
123
|
0
|
169
|
my ($node,$rawXML) = @_; |
855
|
|
|
|
|
|
|
|
856
|
123
|
|
|
|
|
248
|
my $str = "<".$node->get_tag(); |
857
|
|
|
|
|
|
|
|
858
|
123
|
|
|
|
|
334
|
my %attrib = $node->attrib(); |
859
|
|
|
|
|
|
|
|
860
|
123
|
|
|
|
|
401
|
foreach my $att (sort {$a cmp $b} keys(%attrib)) |
|
4
|
|
|
|
|
16
|
|
861
|
|
|
|
|
|
|
{ |
862
|
38
|
|
|
|
|
158
|
$str .= " ".$att."='".&XML::Stream::EscapeXML($attrib{$att})."'"; |
863
|
|
|
|
|
|
|
} |
864
|
|
|
|
|
|
|
|
865
|
123
|
|
|
|
|
328
|
my @children = $node->children(); |
866
|
123
|
100
|
66
|
|
|
465
|
if (($#children > -1) || |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
867
|
|
|
|
|
|
|
(defined($rawXML) && ($rawXML ne "")) || |
868
|
|
|
|
|
|
|
(defined($node->get_raw_xml()) && ($node->get_raw_xml() ne "")) |
869
|
|
|
|
|
|
|
) |
870
|
|
|
|
|
|
|
{ |
871
|
115
|
|
|
|
|
158
|
$str .= ">"; |
872
|
115
|
|
|
|
|
165
|
foreach my $child (@children) |
873
|
|
|
|
|
|
|
{ |
874
|
229
|
100
|
|
|
|
446
|
if ($child->get_tag() eq "__xmlstream__:node:cdata") |
875
|
|
|
|
|
|
|
{ |
876
|
145
|
|
|
|
|
315
|
$str .= &XML::Stream::EscapeXML(join("",$child->children())); |
877
|
|
|
|
|
|
|
} |
878
|
|
|
|
|
|
|
else |
879
|
|
|
|
|
|
|
{ |
880
|
84
|
|
|
|
|
193
|
$str .= &XML::Stream::Node::BuildXML($child); |
881
|
|
|
|
|
|
|
} |
882
|
|
|
|
|
|
|
} |
883
|
115
|
100
|
66
|
|
|
285
|
$str .= $node->get_raw_xml() |
884
|
|
|
|
|
|
|
if (defined($node->get_raw_xml()) && |
885
|
|
|
|
|
|
|
($node->get_raw_xml() ne "") |
886
|
|
|
|
|
|
|
); |
887
|
115
|
100
|
66
|
|
|
354
|
$str .= $rawXML if (defined($rawXML) && ($rawXML ne "")); |
888
|
115
|
|
|
|
|
280
|
$str .= "".$node->get_tag().">"; |
889
|
|
|
|
|
|
|
} |
890
|
|
|
|
|
|
|
else |
891
|
|
|
|
|
|
|
{ |
892
|
8
|
|
|
|
|
13
|
$str .= "/>"; |
893
|
|
|
|
|
|
|
} |
894
|
|
|
|
|
|
|
|
895
|
123
|
|
|
|
|
565
|
return $str; |
896
|
|
|
|
|
|
|
} |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
############################################################################## |
900
|
|
|
|
|
|
|
# |
901
|
|
|
|
|
|
|
# XML2Config - takes an XML data tree and turns it into a hash of hashes. |
902
|
|
|
|
|
|
|
# This only works for certain kinds of XML trees like this: |
903
|
|
|
|
|
|
|
# |
904
|
|
|
|
|
|
|
# |
905
|
|
|
|
|
|
|
# 1 |
906
|
|
|
|
|
|
|
# |
907
|
|
|
|
|
|
|
# foo |
908
|
|
|
|
|
|
|
# |
909
|
|
|
|
|
|
|
# 5 |
910
|
|
|
|
|
|
|
# |
911
|
|
|
|
|
|
|
# |
912
|
|
|
|
|
|
|
# The resulting hash would be: |
913
|
|
|
|
|
|
|
# |
914
|
|
|
|
|
|
|
# $hash{bar} = 1; |
915
|
|
|
|
|
|
|
# $hash{x}->{y} = "foo"; |
916
|
|
|
|
|
|
|
# $hash{z} = 5; |
917
|
|
|
|
|
|
|
# |
918
|
|
|
|
|
|
|
# Good for config files. |
919
|
|
|
|
|
|
|
# |
920
|
|
|
|
|
|
|
############################################################################## |
921
|
|
|
|
|
|
|
sub XML2Config |
922
|
|
|
|
|
|
|
{ |
923
|
59
|
|
|
59
|
0
|
69
|
my ($XMLTree) = @_; |
924
|
|
|
|
|
|
|
|
925
|
59
|
|
|
|
|
45
|
my %hash; |
926
|
59
|
|
|
|
|
103
|
foreach my $tree (&XML::Stream::GetXMLData("tree array",$XMLTree,"*")) |
927
|
|
|
|
|
|
|
{ |
928
|
144
|
100
|
|
|
|
213
|
if ($tree->get_tag() eq "__xmlstream__:node:cdata") |
929
|
|
|
|
|
|
|
{ |
930
|
86
|
|
|
|
|
112
|
my $str = join("",$tree->children()); |
931
|
86
|
100
|
|
|
|
407
|
return $str unless ($str =~ /^\s*$/); |
932
|
|
|
|
|
|
|
} |
933
|
|
|
|
|
|
|
else |
934
|
|
|
|
|
|
|
{ |
935
|
58
|
100
|
|
|
|
81
|
if (&XML::Stream::GetXMLData("count",$XMLTree,$tree->get_tag()) > 1) |
936
|
|
|
|
|
|
|
{ |
937
|
20
|
|
|
|
|
20
|
push(@{$hash{$tree->get_tag()}},&XML::Stream::XML2Config($tree)); |
|
20
|
|
|
|
|
32
|
|
938
|
|
|
|
|
|
|
} |
939
|
|
|
|
|
|
|
else |
940
|
|
|
|
|
|
|
{ |
941
|
38
|
|
|
|
|
83
|
$hash{$tree->get_tag()} = &XML::Stream::XML2Config($tree); |
942
|
|
|
|
|
|
|
} |
943
|
|
|
|
|
|
|
} |
944
|
|
|
|
|
|
|
} |
945
|
36
|
|
|
|
|
185
|
return \%hash; |
946
|
|
|
|
|
|
|
} |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
1; |