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 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," {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}> ... \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 .= "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;