File Coverage

blib/lib/XML/Stream/Node.pm
Criterion Covered Total %
statement 214 302 70.8
branch 100 160 62.5
condition 26 45 57.7
subroutine 24 31 77.4
pod 0 25 0.0
total 364 563 64.6


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 11     11   74 use strict;
  11         23  
  11         473  
143 11     11   148 use warnings;
  11         25  
  11         521  
144 11     11   64 use vars qw( $VERSION $LOADED );
  11         26  
  11         80091  
145              
146             $VERSION = "1.23_06";
147             $LOADED = 1;
148              
149             sub new
150             {
151 794     794 0 3386 my $proto = shift;
152 794   33     2956 my $class = ref($proto) || $proto;
153              
154 794 100       1724 if (ref($_[0]) eq "XML::Stream::Node")
155             {
156 213         446 return $_[0];
157             }
158              
159 581         909 my $self = {};
160 581         1396 bless($self, $proto);
161              
162 581         973 my ($tag,$data) = @_;
163              
164 581 100       1872 $self->set_tag($tag) if defined($tag);
165 581 100       1162 $self->add_cdata($data) if defined($data);
166 581         1181 $self->remove_raw_xml();
167              
168 581         1085 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," {TAG}>\n";
209             }
210             }
211              
212              
213             sub children
214             {
215 735     735 0 846 my $self = shift;
216              
217 735 100       2006 return () unless exists($self->{CHILDREN});
218 709         714 return @{$self->{CHILDREN}};
  709         2667  
219             }
220              
221              
222             sub add_child
223             {
224 214     214 0 262 my $self = shift;
225              
226 214         716 my $child = XML::Stream::Node->new(@_);
227 214         260 push(@{$self->{CHILDREN}},$child);
  214         476  
228 214         356 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 433 my $self = shift;
251 324         749 my $child = XML::Stream::Node->new("__xmlstream__:node:cdata");
252 324         6397 foreach my $cdata (@_)
253             {
254 324         487 push(@{$child->{CHILDREN}},$cdata);
  324         1347  
255             }
256 324         478 push(@{$self->{CHILDREN}},$child);
  324         799  
257 324         977 return $child;
258             }
259              
260              
261             sub get_cdata
262             {
263 31     31 0 53 my $self = shift;
264              
265 31         111 my $cdata = "";
266 31         51 foreach my $child (@{$self->{CHILDREN}})
  31         83  
267             {
268 33 100       80 $cdata .= join("",$child->children())
269             if ($child->get_tag() eq "__xmlstream__:node:cdata");
270             }
271              
272 31         84 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 159 my $self = shift;
299 127 100       390 return () unless exists($self->{ATTRIBS});
300 46         48 return %{$self->{ATTRIBS}};
  46         227  
301             }
302              
303              
304             sub get_attrib
305             {
306 295     295 0 528 my $self = shift;
307 295         935 my ($key) = @_;
308              
309 295 100       1265 return unless exists($self->{ATTRIBS}->{$key});
310 204         1045 return $self->{ATTRIBS}->{$key};
311             }
312              
313              
314             sub put_attrib
315             {
316 255     255 0 300 my $self = shift;
317 255         461 my (%att) = @_;
318              
319 255         905 foreach my $key (keys(%att))
320             {
321 79         503 $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 12594 my $self = shift;
339 17         49 my (@raw) = @_;
340              
341 17         25 push(@{$self->{RAWXML}},@raw);
  17         69  
342             }
343              
344             sub get_raw_xml
345             {
346 159     159 0 190 my $self = shift;
347              
348 159 100       171 return if ($#{$self->{RAWXML}} == -1);
  159         644  
349 53         75 return join("",@{$self->{RAWXML}});
  53         277  
350             }
351              
352              
353             sub remove_raw_xml
354             {
355 581     581 0 702 my $self = shift;
356 581         1405 $self->{RAWXML} = [];
357             }
358              
359              
360             sub get_tag
361             {
362 4036     4036 0 6037 my $self = shift;
363              
364 4036         18454 return $self->{TAG};
365             }
366              
367              
368             sub set_tag
369             {
370 581     581 0 1418 my $self = shift;
371 581         854 my ($tag) = @_;
372              
373 581         1705 $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 2694 my $self = shift;
397              
398 5         32 return &BuildXML($self,@_);
399             }
400              
401              
402             sub copy
403             {
404 3     3 0 10 my $self = shift;
405              
406 3         11 my $new_node = XML::Stream::Node->new();
407 3         9 $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       12 if ($child->get_tag() eq "__xmlstream__:node:cdata")
413             {
414 4         12 $new_node->add_cdata($child->children());
415             }
416             else
417             {
418 1         7 $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 251     251   323 my $self;
440 251 100       644 $self = $_[0] if (ref($_[0]) eq "XML::Stream::Parser");
441 251 100       568 $self = shift unless (ref($_[0]) eq "XML::Stream::Parser");
442 251         529 my ($sax, $tag, %att) = @_;
443 251         697 my $sid = $sax->getSID();
444              
445 251         2036 $self->debug(2,"Node: _handle_element: sid($sid) sax($sax) tag($tag) att(",%att,")");
446              
447 251         5644 my $node = XML::Stream::Node->new($tag);
448 251         619 $node->put_attrib(%att);
449              
450 251         399 $self->debug(2,"Node: _handle_element: check(",$#{$self->{SIDS}->{$sid}->{node}},")");
  251         1165  
451              
452 251 100       335 if ($#{$self->{SIDS}->{$sid}->{node}} >= 0)
  251         826  
453             {
454 212         552 $self->{SIDS}->{$sid}->{node}->[$#{$self->{SIDS}->{$sid}->{node}}]->
  212         709  
455             add_child($node);
456             }
457              
458 251         360 push(@{$self->{SIDS}->{$sid}->{node}},$node);
  251         1139  
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   416 my $self;
472 352 100       944 $self = $_[0] if (ref($_[0]) eq "XML::Stream::Parser");
473 352 100       783 $self = shift unless (ref($_[0]) eq "XML::Stream::Parser");
474 352         585 my ($sax, $cdata) = @_;
475 352         1040 my $sid = $sax->getSID();
476              
477 352         1781 $self->debug(2,"Node: _handle_cdata: sid($sid) sax($sax) cdata($cdata)");
478              
479 352 100       450 return if ($#{$self->{SIDS}->{$sid}->{node}} == -1);
  352         1292  
480              
481 316         1400 $self->debug(2,"Node: _handle_cdata: sax($sax) cdata($cdata)");
482              
483 316         696 $self->{SIDS}->{$sid}->{node}->[$#{$self->{SIDS}->{$sid}->{node}}]->
  316         1053  
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 253     253   287 my $self;
498 253 100       733 $self = $_[0] if (ref($_[0]) eq "XML::Stream::Parser");
499 253 100       574 $self = shift unless (ref($_[0]) eq "XML::Stream::Parser");
500 253         366 my ($sax, $tag) = @_;
501 253         659 my $sid = $sax->getSID();
502              
503 253         1234 $self->debug(2,"Node: _handle_close: sid($sid) sax($sax) tag($tag)");
504              
505 253         366 $self->debug(2,"Node: _handle_close: check(",$#{$self->{SIDS}->{$sid}->{node}},")");
  253         2004  
506              
507 253 100       345 if ($#{$self->{SIDS}->{$sid}->{node}} == -1)
  253         1053  
508             {
509 2         20 $self->debug(2,"Node: _handle_close: rootTag($self->{SIDS}->{$sid}->{rootTag}) tag($tag)");
510 2 50       10 if ($self->{SIDS}->{$sid}->{rootTag} ne $tag)
511             {
512 0         0 $self->{SIDS}->{$sid}->{streamerror} = "Root tag mis-match: <$self->{SIDS}->{$sid}->{rootTag}> ... \n";
513             }
514 2         9 return;
515             }
516              
517 251         315 my $CLOSED = pop @{$self->{SIDS}->{$sid}->{node}};
  251         1117  
518              
519 251         769 $self->debug(2,"Node: _handle_close: check2(",$#{$self->{SIDS}->{$sid}->{node}},")");
  251         1007  
520            
521 251 100       317 if($#{$self->{SIDS}->{$sid}->{node}} == -1)
  251         1159  
522             {
523 39         61 push @{$self->{SIDS}->{$sid}->{node}}, $CLOSED;
  39         195  
524              
525 39 100       172 if (ref($self) ne "XML::Stream::Parser")
526             {
527 37         157 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         15 my $node = $self->{SIDS}->{$sid}->{node}->[0];
533 3         16 $self->{SIDS}->{$sid}->{node} = [];
534 3         23 $self->ProcessStreamPacket($sid,$node);
535             }
536             else
537             {
538 34         104 my $node = $self->{SIDS}->{$sid}->{node}->[0];
539 34         78 $self->{SIDS}->{$sid}->{node} = [];
540              
541 34         122 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       123 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         48 &{$self->{CB}->{node}}($sid,$node);
  34         207  
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 975     975 0 1824 my ($type,$XMLTree,$tag,$attrib,$value) = @_;
660              
661 975 100       2040 $tag = "" if !defined($tag);
662 975 100       1882 $attrib = "" if !defined($attrib);
663 975 50       1721 $value = "" if !defined($value);
664              
665 975         1185 my $skipthis = 0;
666              
667             #-------------------------------------------------------------------------
668             # Check if a child tag in the root tag is being requested.
669             #-------------------------------------------------------------------------
670 975 100       1806 if ($tag ne "")
671             {
672 338         388 my $count = 0;
673 338         363 my @array;
674 338         771 foreach my $child ($XMLTree->children())
675             {
676 1839 100 100     4768 if (($child->get_tag() eq $tag) || ($tag eq "*"))
677             {
678             #-------------------------------------------------------------
679             # Filter out tags that do not contain the attribute and value.
680             #-------------------------------------------------------------
681 1204 0 33     3743 next if (($value ne "") && ($attrib ne "") && $child->get_attrib($attrib) && ($XMLTree->get_attrib($attrib) ne $value));
      33        
      0        
682 1204 50 33     2848 next if (($attrib ne "") && !$child->get_attrib($attrib));
683              
684             #-------------------------------------------------------------
685             # Check for existence
686             #-------------------------------------------------------------
687 1204 50       2801 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 1204 100       2224 if ($type eq "value")
696             {
697 4 50       14 if ($attrib eq "")
698             {
699 4         15 my $str = $child->get_cdata();
700 4         21 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 1200 50       2699 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 1200 50       2105 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 1200 100       2143 if ($type eq "tree array")
735             {
736 144         171 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 1200 100       2869 if ($type eq "child array")
743             {
744 948 100       2189 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 1200 100       6374 if ($type eq "count")
750             {
751 108         108 $count++;
752             }
753             #-------------------------------------------------------------
754             # Return the attribute hash that matches this tag
755             #-------------------------------------------------------------
756 1200 50       3008 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     2388 if (($type eq "tree array") || ($type eq "value array") ||
      100        
766             ($type eq "child array"))
767             {
768 276         1318 return @array;
769             }
770              
771             #---------------------------------------------------------------------
772             # If we are returning then count, then do so
773             #---------------------------------------------------------------------
774 58 50       107 if ($type eq "count")
775             {
776 58         190 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 637 100       1248 if ($type eq "value")
790             {
791 193 100       395 if ($attrib eq "")
792             {
793 25         92 my $str = $XMLTree->get_cdata();
794 25         129 return $str;
795             }
796 168 100       482 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 522 50       1140 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 522 50       1189 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 522 100       1023 if ($type eq "attribs")
825             {
826 1         5 return $XMLTree->attrib();
827             }
828             #---------------------------------------------------------------------
829             # Return the tag of this node
830             #---------------------------------------------------------------------
831 521 100       1358 if ($type eq "tag")
832             {
833 443         884 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       255 return 0 if ($type eq "existence");
841 78 50       529 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 187 my ($node,$rawXML) = @_;
855              
856 123         246 my $str = "<".$node->get_tag();
857              
858 123         304 my %attrib = $node->attrib();
859              
860 123         374 foreach my $att (sort {$a cmp $b} keys(%attrib))
  4         15  
861             {
862 38         162 $str .= " ".$att."='".&XML::Stream::EscapeXML($attrib{$att})."'";
863             }
864              
865 123         293 my @children = $node->children();
866 123 100 66     527 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         154 $str .= ">";
872 115         193 foreach my $child (@children)
873             {
874 229 100       429 if ($child->get_tag() eq "__xmlstream__:node:cdata")
875             {
876 145         265 $str .= &XML::Stream::EscapeXML(join("",$child->children()));
877             }
878             else
879             {
880 84         184 $str .= &XML::Stream::Node::BuildXML($child);
881             }
882             }
883 115 100 66     280 $str .= $node->get_raw_xml()
884             if (defined($node->get_raw_xml()) &&
885             ($node->get_raw_xml() ne "")
886             );
887 115 100 66     360 $str .= $rawXML if (defined($rawXML) && ($rawXML ne ""));
888 115         281 $str .= "get_tag().">";
889             }
890             else
891             {
892 8         14 $str .= "/>";
893             }
894              
895 123         547 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 108 my ($XMLTree) = @_;
924              
925 59         59 my %hash;
926 59         138 foreach my $tree (&XML::Stream::GetXMLData("tree array",$XMLTree,"*"))
927             {
928 144 100       256 if ($tree->get_tag() eq "__xmlstream__:node:cdata")
929             {
930 86         157 my $str = join("",$tree->children());
931 86 100       455 return $str unless ($str =~ /^\s*$/);
932             }
933             else
934             {
935 58 100       105 if (&XML::Stream::GetXMLData("count",$XMLTree,$tree->get_tag()) > 1)
936             {
937 20         35 push(@{$hash{$tree->get_tag()}},&XML::Stream::XML2Config($tree));
  20         37  
938             }
939             else
940             {
941 38         102 $hash{$tree->get_tag()} = &XML::Stream::XML2Config($tree);
942             }
943             }
944             }
945 36         190 return \%hash;
946             }
947              
948              
949             1;