File Coverage

blib/lib/XML/Stream/Tree.pm
Criterion Covered Total %
statement 186 266 69.9
branch 93 148 62.8
condition 17 42 40.4
subroutine 10 11 90.9
pod 0 4 0.0
total 306 471 64.9


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::Tree;
24              
25             =head1 NAME
26              
27             XML::Stream::Tree - 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             =head1 FORMAT
36              
37             The result of parsing:
38              
39             Hello thereHowdydo
40              
41             would be:
42             Tag Content
43             ==================================================================
44             [foo, [{},
45             head, [{id => "a"},
46             0, "Hello ",
47             em, [{},
48             0, "there"
49             ]
50             ],
51             bar, [{},
52             0, "Howdy",
53             ref, [{}]
54             ],
55             0, "do"
56             ]
57             ]
58              
59             The above was copied from the XML::Parser man page. Many thanks to
60             Larry and Clark.
61              
62             =head1 AUTHOR
63              
64             By Ryan Eatmon in March 2001 for http://jabber.org/
65              
66             Currently maintained by Darian Anthony Patrick.
67              
68             =head1 COPYRIGHT
69              
70             Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/
71              
72             This module licensed under the LGPL, version 2.1.
73              
74             =cut
75              
76 12     12   311 use 5.008;
  12         40  
  12         805  
77 12     12   61 use strict;
  12         16  
  12         360  
78 12     12   54 use warnings;
  12         13  
  12         340  
79 12     12   52 use vars qw( $VERSION $LOADED );
  12         17  
  12         32663  
80              
81             $VERSION = "1.24";
82             $LOADED = 1;
83              
84             ##############################################################################
85             #
86             # _handle_element - handles the main tag elements sent from the server.
87             # On an open tag it creates a new XML::Parser::Tree so
88             # that _handle_cdata and _handle_element can add data
89             # and tags to it later.
90             #
91             ##############################################################################
92             sub _handle_element
93             {
94 240     240   197 my $self;
95 240 100       476 $self = $_[0] if (ref($_[0]) eq "XML::Stream::Parser");
96 240 100       416 $self = shift unless (ref($_[0]) eq "XML::Stream::Parser");
97 240         426 my ($sax, $tag, %att) = @_;
98 240         503 my $sid = $sax->getSID();
99              
100 240         1115 $self->debug(2,"_handle_element: sid($sid) sax($sax) tag($tag) att(",%att,")");
101              
102 240         234 my @NEW;
103 240 100       215 if($#{$self->{SIDS}->{$sid}->{tree}} < 0)
  240         616  
104             {
105 38         43 push @{$self->{SIDS}->{$sid}->{tree}}, $tag;
  38         128  
106             }
107             else
108             {
109 202         172 push @{ $self->{SIDS}->{$sid}->{tree}[ $#{$self->{SIDS}->{$sid}->{tree}}]}, $tag;
  202         263  
  202         483  
110             }
111 240         447 push @NEW, \%att;
112 240         219 push @{$self->{SIDS}->{$sid}->{tree}}, \@NEW;
  240         784  
113             }
114              
115              
116             ##############################################################################
117             #
118             # _handle_cdata - handles the CDATA that is encountered. Also, in the
119             # spirit of XML::Parser::Tree it combines any sequential
120             # CDATA into one tag.
121             #
122             ##############################################################################
123             sub _handle_cdata
124             {
125 348     348   267 my $self;
126 348 100       754 $self = $_[0] if (ref($_[0]) eq "XML::Stream::Parser");
127 348 100       588 $self = shift unless (ref($_[0]) eq "XML::Stream::Parser");
128 348         484 my ($sax, $cdata) = @_;
129 348         682 my $sid = $sax->getSID();
130              
131 348         1365 $self->debug(2,"_handle_cdata: sid($sid) sax($sax) cdata($cdata)");
132              
133 348 100       344 return if ($#{$self->{SIDS}->{$sid}->{tree}} == -1);
  348         961  
134              
135 312         907 $self->debug(2,"_handle_cdata: sax($sax) cdata($cdata)");
136              
137 312         290 my $pos = $#{$self->{SIDS}->{$sid}->{tree}};
  312         522  
138 312         741 $self->debug(2,"_handle_cdata: pos($pos)");
139              
140 312 50 33     1404 if ($pos > 0 && $self->{SIDS}->{$sid}->{tree}[$pos - 1] eq "0")
141             {
142 0         0 $self->debug(2,"_handle_cdata: append cdata");
143 0         0 $self->{SIDS}->{$sid}->{tree}[$pos - 1] .= $cdata;
144             }
145             else
146             {
147 312         617 $self->debug(2,"_handle_cdata: new cdata");
148 312         247 push @{$self->{SIDS}->{$sid}->{tree}[$#{$self->{SIDS}->{$sid}->{tree}}]}, 0;
  312         443  
  312         611  
149 312         296 push @{$self->{SIDS}->{$sid}->{tree}[$#{$self->{SIDS}->{$sid}->{tree}}]}, $cdata;
  312         391  
  312         1148  
150             }
151             }
152              
153              
154             ##############################################################################
155             #
156             # _handle_close - when we see a close tag we need to pop the last element
157             # from the list and push it onto the end of the previous
158             # element. This is how we build our hierarchy.
159             #
160             ##############################################################################
161             sub _handle_close
162             {
163 242     242   211 my $self;
164 242 100       626 $self = $_[0] if (ref($_[0]) eq "XML::Stream::Parser");
165 242 100       427 $self = shift unless (ref($_[0]) eq "XML::Stream::Parser");
166 242         272 my ($sax, $tag) = @_;
167 242         448 my $sid = $sax->getSID();
168              
169 242         829 $self->debug(2,"_handle_close: sid($sid) sax($sax) tag($tag)");
170              
171 242         293 my $CLOSED = pop @{$self->{SIDS}->{$sid}->{tree}};
  242         424  
172              
173 242         218 $self->debug(2,"_handle_close: check(",$#{$self->{SIDS}->{$sid}->{tree}},")");
  242         618  
174              
175 242 100       197 if ($#{$self->{SIDS}->{$sid}->{tree}} == -1)
  242         571  
176             {
177 2 50       13 if ($self->{SIDS}->{$sid}->{rootTag} ne $tag)
178             {
179 0         0 $self->{SIDS}->{$sid}->{streamerror} = "Root tag mis-match: <$self->{SIDS}->{$sid}->{rootTag}> ... \n";
180             }
181 2         7 return;
182             }
183              
184 240 100       205 if($#{$self->{SIDS}->{$sid}->{tree}} < 1)
  240         532  
185             {
186              
187 38         37 push @{$self->{SIDS}->{$sid}->{tree}}, $CLOSED;
  38         88  
188              
189 38 100       129 if (ref($self) ne "XML::Stream::Parser")
190             {
191 34         122 my $stream_prefix = $self->StreamPrefix($sid);
192              
193 34 50 33     388 if(defined($self->{SIDS}->{$sid}->{tree}->[0]) &&
194             ($self->{SIDS}->{$sid}->{tree}->[0] =~ /^${stream_prefix}\:/))
195             {
196 0         0 my @tree = @{$self->{SIDS}->{$sid}->{tree}};
  0         0  
197 0         0 $self->{SIDS}->{$sid}->{tree} = [];
198 0         0 $self->ProcessStreamPacket($sid,\@tree);
199             }
200             else
201             {
202 34         84 my @tree = @{$self->{SIDS}->{$sid}->{tree}};
  34         179  
203 34         85 $self->{SIDS}->{$sid}->{tree} = [];
204            
205 34         109 my @special =
206             &XML::Stream::XPath(
207             \@tree,
208             '[@xmlns="'.&XML::Stream::ConstXMLNS("xmpp-sasl").'" or @xmlns="'.&XML::Stream::ConstXMLNS("xmpp-tls").'"]'
209             );
210 34 50       97 if ($#special > -1)
211             {
212 0         0 my $xmlns = &GetXMLData("value",\@tree,"","xmlns");
213              
214 0 0       0 $self->ProcessSASLPacket($sid,\@tree)
215             if ($xmlns eq &XML::Stream::ConstXMLNS("xmpp-sasl"));
216 0 0       0 $self->ProcessTLSPacket($sid,\@tree)
217             if ($xmlns eq &XML::Stream::ConstXMLNS("xmpp-tls"));
218             }
219             else
220             {
221 34         52 &{$self->{CB}->{node}}($sid,\@tree);
  34         156  
222             }
223             }
224             }
225             }
226             else
227             {
228 202         162 push @{$self->{SIDS}->{$sid}->{tree}[$#{$self->{SIDS}->{$sid}->{tree}}]}, $CLOSED;
  202         267  
  202         649  
229             }
230             }
231              
232              
233             ##############################################################################
234             #
235             # SetXMLData - takes a host of arguments and sets a portion of the specified
236             # XML::Parser::Tree object with that data. The function works
237             # in two modes "single" or "multiple". "single" denotes that
238             # the function should locate the current tag that matches this
239             # data and overwrite it's contents with data passed in.
240             # "multiple" denotes that a new tag should be created even if
241             # others exist.
242             #
243             # type - single or multiple
244             # XMLTree - pointer to XML::Stream Tree object
245             # tag - name of tag to create/modify (if blank assumes
246             # working with top level tag)
247             # data - CDATA to set for tag
248             # attribs - attributes to ADD to tag
249             #
250             ##############################################################################
251             sub SetXMLData
252             {
253 0     0 0 0 my ($type,$XMLTree,$tag,$data,$attribs) = @_;
254 0         0 my ($key);
255              
256 0 0       0 if ($tag ne "")
257             {
258 0 0       0 if ($type eq "single")
259             {
260 0         0 my ($child);
261 0         0 foreach $child (1..$#{$$XMLTree[1]})
  0         0  
262             {
263 0 0       0 if ($$XMLTree[1]->[$child] eq $tag)
264             {
265 0 0       0 if ($data ne "")
266             {
267             #todo: add code to handle writing the cdata again and appending it.
268 0         0 $$XMLTree[1]->[$child+1]->[1] = 0;
269 0         0 $$XMLTree[1]->[$child+1]->[2] = $data;
270             }
271 0         0 foreach $key (keys(%{$attribs}))
  0         0  
272             {
273 0         0 $$XMLTree[1]->[$child+1]->[0]->{$key} = $$attribs{$key};
274             }
275 0         0 return;
276             }
277             }
278             }
279 0         0 $$XMLTree[1]->[($#{$$XMLTree[1]}+1)] = $tag;
  0         0  
280 0         0 $$XMLTree[1]->[($#{$$XMLTree[1]}+1)]->[0] = {};
  0         0  
281 0         0 foreach $key (keys(%{$attribs}))
  0         0  
282             {
283 0         0 $$XMLTree[1]->[$#{$$XMLTree[1]}]->[0]->{$key} = $$attribs{$key};
  0         0  
284             }
285 0 0       0 if ($data ne "")
286             {
287 0         0 $$XMLTree[1]->[$#{$$XMLTree[1]}]->[1] = 0;
  0         0  
288 0         0 $$XMLTree[1]->[$#{$$XMLTree[1]}]->[2] = $data;
  0         0  
289             }
290             }
291             else
292             {
293 0         0 foreach $key (keys(%{$attribs}))
  0         0  
294             {
295 0         0 $$XMLTree[1]->[0]->{$key} = $$attribs{$key};
296             }
297 0 0       0 if ($data ne "")
298             {
299 0 0 0     0 if (($#{$$XMLTree[1]} > 0) &&
  0         0  
  0         0  
300             ($$XMLTree[1]->[($#{$$XMLTree[1]}-1)] eq "0"))
301             {
302 0         0 $$XMLTree[1]->[$#{$$XMLTree[1]}] .= $data;
  0         0  
303             }
304             else
305             {
306 0         0 $$XMLTree[1]->[($#{$$XMLTree[1]}+1)] = 0;
  0         0  
307 0         0 $$XMLTree[1]->[($#{$$XMLTree[1]}+1)] = $data;
  0         0  
308             }
309             }
310             }
311             }
312              
313              
314             ##############################################################################
315             #
316             # GetXMLData - takes a host of arguments and returns various data structures
317             # that match them.
318             #
319             # type - "existence" - returns 1 or 0 if the tag exists in the
320             # top level.
321             # "value" - returns either the CDATA of the tag, or the
322             # value of the attribute depending on which is
323             # sought. This ignores any mark ups to the data
324             # and just returns the raw CDATA.
325             # "value array" - returns an array of strings representing
326             # all of the CDATA in the specified tag.
327             # This ignores any mark ups to the data
328             # and just returns the raw CDATA.
329             # "tree" - returns an XML::Parser::Tree object with the
330             # specified tag as the root tag.
331             # "tree array" - returns an array of XML::Parser::Tree
332             # objects each with the specified tag as
333             # the root tag.
334             # "child array" - returns a list of all children nodes
335             # not including CDATA nodes.
336             # "attribs" - returns a hash with the attributes, and
337             # their values, for the things that match
338             # the parameters
339             # "count" - returns the number of things that match
340             # the arguments
341             # "tag" - returns the root tag of this tree
342             # XMLTree - pointer to XML::Parser::Tree object
343             # tag - tag to pull data from. If blank then the top level
344             # tag is accessed.
345             # attrib - attribute value to retrieve. Ignored for types
346             # "value array", "tree", "tree array". If paired
347             # with value can be used to filter tags based on
348             # attributes and values.
349             # value - only valid if an attribute is supplied. Used to
350             # filter for tags that only contain this attribute.
351             # Useful to search through multiple tags that all
352             # reference different name spaces.
353             #
354             ##############################################################################
355             sub GetXMLData
356             {
357 873     873 0 931 my ($type,$XMLTree,$tag,$attrib,$value) = @_;
358              
359 873 100       1262 $tag = "" if !defined($tag);
360 873 100       1198 $attrib = "" if !defined($attrib);
361 873 50       1195 $value = "" if !defined($value);
362              
363 873         670 my $skipthis = 0;
364              
365             #---------------------------------------------------------------------------
366             # Check if a child tag in the root tag is being requested.
367             #---------------------------------------------------------------------------
368 873 100       1027 if ($tag ne "")
369             {
370 321         217 my $count = 0;
371 321         238 my @array;
372 321         232 foreach my $child (1..$#{$$XMLTree[1]})
  321         561  
373             {
374 3616 100       9899 next if (($child/2) !~ /\./);
375 1810 100 100     5701 if (($$XMLTree[1]->[$child] eq $tag) || ($tag eq "*"))
376             {
377 1175 50       1716 next if (ref($$XMLTree[1]->[$child]) eq "ARRAY");
378              
379             #---------------------------------------------------------------------
380             # Filter out tags that do not contain the attribute and value.
381             #---------------------------------------------------------------------
382 1175 0 33     1712 next if (($value ne "") && ($attrib ne "") && exists($$XMLTree[1]->[$child+1]->[0]->{$attrib}) && ($$XMLTree[1]->[$child+1]->[0]->{$attrib} ne $value));
      33        
      0        
383 1175 0 0     1446 next if (($attrib ne "") && ((ref($$XMLTree[1]->[$child+1]) ne "ARRAY") || !exists($$XMLTree[1]->[$child+1]->[0]->{$attrib})));
      33        
384              
385             #---------------------------------------------------------------------
386             # Check for existence
387             #---------------------------------------------------------------------
388 1175 50       1521 if ($type eq "existence")
389             {
390 0         0 return 1;
391             }
392            
393             #---------------------------------------------------------------------
394             # Return the raw CDATA value without mark ups, or the value of the
395             # requested attribute.
396             #---------------------------------------------------------------------
397 1175 100       1423 if ($type eq "value")
398             {
399 4 50       10 if ($attrib eq "")
400             {
401 4         8 my $str = "";
402 4         3 my $next = 0;
403 4         5 my $index;
404 4         8 foreach $index (1..$#{$$XMLTree[1]->[$child+1]}) {
  4         13  
405 8 100       21 if ($next == 1) { $next = 0; next; }
  4         4  
  4         7  
406 4 50       12 if ($$XMLTree[1]->[$child+1]->[$index] eq "0") {
407 4         8 $str .= $$XMLTree[1]->[$child+1]->[$index+1];
408 4         6 $next = 1;
409             }
410             }
411 4         21 return $str;
412             }
413 0 0       0 return $$XMLTree[1]->[$child+1]->[0]->{$attrib}
414             if (exists $$XMLTree[1]->[$child+1]->[0]->{$attrib});
415             }
416             #---------------------------------------------------------------------
417             # Return an array of values that represent the raw CDATA without
418             # mark up tags for the requested tags.
419             #---------------------------------------------------------------------
420 1171 50       1506 if ($type eq "value array")
421             {
422 0 0       0 if ($attrib eq "")
423             {
424 0         0 my $str = "";
425 0         0 my $next = 0;
426 0         0 my $index;
427 0         0 foreach $index (1..$#{$$XMLTree[1]->[$child+1]})
  0         0  
428             {
429 0 0       0 if ($next == 1) { $next = 0; next; }
  0         0  
  0         0  
430 0 0       0 if ($$XMLTree[1]->[$child+1]->[$index] eq "0")
431             {
432 0         0 $str .= $$XMLTree[1]->[$child+1]->[$index+1];
433 0         0 $next = 1;
434             }
435             }
436 0         0 push(@array,$str);
437             }
438             else
439             {
440 0 0       0 push(@array,$$XMLTree[1]->[$child+1]->[0]->{$attrib})
441             if (exists $$XMLTree[1]->[$child+1]->[0]->{$attrib});
442             }
443             }
444             #---------------------------------------------------------------------
445             # Return a pointer to a new XML::Parser::Tree object that has the
446             # requested tag as the root tag.
447             #---------------------------------------------------------------------
448 1171 50       1376 if ($type eq "tree")
449             {
450 0         0 my @tree = ( $$XMLTree[1]->[$child] , $$XMLTree[1]->[$child+1] );
451 0         0 return @tree;
452             }
453             #---------------------------------------------------------------------
454             # Return an array of pointers to XML::Parser::Tree objects that have
455             # the requested tag as the root tags.
456             #---------------------------------------------------------------------
457 1171 100       1413 if ($type eq "tree array")
458             {
459 144         315 my @tree = ( $$XMLTree[1]->[$child] , $$XMLTree[1]->[$child+1] );
460 144         181 push(@array,\@tree);
461             }
462             #---------------------------------------------------------------------
463             # Return a count of the number of tags that match
464             #---------------------------------------------------------------------
465 1171 100       1400 if ($type eq "count")
466             {
467 108 50       165 if ($$XMLTree[1]->[$child] eq "0")
468             {
469 0         0 $skipthis = 1;
470 0         0 next;
471             }
472 108 50       135 if ($skipthis == 1)
473             {
474 0         0 $skipthis = 0;
475 0         0 next;
476             }
477 108         91 $count++;
478             }
479             #---------------------------------------------------------------------
480             # Return a count of the number of tags that match
481             #---------------------------------------------------------------------
482 1171 100       1581 if ($type eq "child array")
483             {
484 919         1680 my @tree = ( $$XMLTree[1]->[$child] , $$XMLTree[1]->[$child+1] );
485 919 100       1548 push(@array,\@tree) if ($tree[0] ne "0");
486             }
487             #---------------------------------------------------------------------
488             # Return the attribute hash that matches this tag
489             #---------------------------------------------------------------------
490 1171 50       1771 if ($type eq "attribs")
491             {
492 0         0 return (%{$$XMLTree[1]->[$child+1]->[0]});
  0         0  
493             }
494             }
495             }
496             #-------------------------------------------------------------------------
497             # If we are returning arrays then return array.
498             #-------------------------------------------------------------------------
499 317 100 66     1429 if (($type eq "tree array") || ($type eq "value array") ||
      100        
500             ($type eq "child array"))
501             {
502 259         642 return @array;
503             }
504              
505             #-------------------------------------------------------------------------
506             # If we are returning then count, then do so
507             #-------------------------------------------------------------------------
508 58 50       78 if ($type eq "count")
509             {
510 58         142 return $count;
511             }
512             }
513             else
514             {
515             #-------------------------------------------------------------------------
516             # This is the root tag, so handle things a level up.
517             #-------------------------------------------------------------------------
518              
519             #-------------------------------------------------------------------------
520             # Return the raw CDATA value without mark ups, or the value of the
521             # requested attribute.
522             #-------------------------------------------------------------------------
523 552 100       755 if ($type eq "value")
524             {
525 125 100       212 if ($attrib eq "")
526             {
527 17         19 my $str = "";
528 17         17 my $next = 0;
529 17         13 my $index;
530 17         15 foreach $index (1..$#{$$XMLTree[1]})
  17         41  
531             {
532 38 100       52 if ($next == 1) { $next = 0; next; }
  18         13  
  18         27  
533 20 100       37 if ($$XMLTree[1]->[$index] eq "0")
534             {
535 18         36 $str .= $$XMLTree[1]->[$index+1];
536 18         21 $next = 1;
537             }
538             }
539 17         86 return $str;
540             }
541 108 100       320 return $$XMLTree[1]->[0]->{$attrib}
542             if (exists $$XMLTree[1]->[0]->{$attrib});
543             }
544             #-------------------------------------------------------------------------
545             # Return a pointer to a new XML::Parser::Tree object that has the
546             # requested tag as the root tag.
547             #-------------------------------------------------------------------------
548 505 50       648 if ($type eq "tree")
549             {
550 0         0 my @tree = @{$$XMLTree};
  0         0  
551 0         0 return @tree;
552             }
553              
554             #-------------------------------------------------------------------------
555             # Return the 1 if the specified attribute exists in the root tag.
556             #-------------------------------------------------------------------------
557 505 50       629 if ($type eq "existence")
558             {
559 0 0 0     0 return 1 if (($attrib ne "") && (exists($$XMLTree[1]->[0]->{$attrib})));
560             }
561              
562             #-------------------------------------------------------------------------
563             # Return the attribute hash that matches this tag
564             #-------------------------------------------------------------------------
565 505 100       636 if ($type eq "attribs")
566             {
567 1         1 return %{$$XMLTree[1]->[0]};
  1         9  
568             }
569             #-------------------------------------------------------------------------
570             # Return the tag of this node
571             #-------------------------------------------------------------------------
572 504 100       691 if ($type eq "tag")
573             {
574 426         1546 return $$XMLTree[0];
575             }
576             }
577             #---------------------------------------------------------------------------
578             # Return 0 if this was a request for existence, or "" if a request for
579             # a "value", or [] for "tree", "value array", and "tree array".
580             #---------------------------------------------------------------------------
581 78 50       137 return 0 if ($type eq "existence");
582 78 50       416 return "" if ($type eq "value");
583 0         0 return [];
584             }
585              
586              
587             ##############################################################################
588             #
589             # BuildXML - takes an XML::Parser::Tree object and builds the XML string
590             # that it represents.
591             #
592             ##############################################################################
593             sub BuildXML
594             {
595 126     126 0 161 my ($parseTree,$rawXML) = @_;
596              
597 126 50       110 return "" if $#{$parseTree} == -1;
  126         273  
598              
599 126         142 my $str = "";
600 126 50       276 if (ref($parseTree->[0]) eq "")
601             {
602 126 100       320 if ($parseTree->[0] eq "0")
603             {
604 68         188 return &XML::Stream::EscapeXML($parseTree->[1]);
605             }
606              
607 58         111 $str = "<".$parseTree->[0];
608 58         59 foreach my $att (sort {$a cmp $b} keys(%{$parseTree->[1]->[0]}))
  2         11  
  58         289  
609             {
610 18         90 $str .= " ".$att."='".&XML::Stream::EscapeXML($parseTree->[1]->[0]->{$att})."'";
611             }
612              
613 58 100 66     80 if (($#{$parseTree->[1]} > 0) || (defined($rawXML) && ($rawXML ne "")))
  58   66     254  
614             {
615 54         67 $str .= ">";
616            
617 54         71 my $index = 1;
618 54         56 while($index <= $#{$parseTree->[1]})
  163         378  
619             {
620 109         309 my @newTree = ( $parseTree->[1]->[$index], $parseTree->[1]->[$index+1] );
621 109         231 $str .= &XML::Stream::Tree::BuildXML(\@newTree);
622 109         208 $index += 2;
623             }
624            
625 54 100       113 $str .= $rawXML if defined($rawXML);
626 54         141 $str .= "[0].">";
627             }
628             else
629             {
630 4         7 $str .= "/>";
631             }
632              
633             }
634              
635 58         175 return $str;
636             }
637              
638              
639             ##############################################################################
640             #
641             # XML2Config - takes an XML data tree and turns it into a hash of hashes.
642             # This only works for certain kinds of XML trees like this:
643             #
644             #
645             # 1
646             #
647             # foo
648             #
649             # 5
650             #
651             #
652             # The resulting hash would be:
653             #
654             # $hash{bar} = 1;
655             # $hash{x}->{y} = "foo";
656             # $hash{z} = 5;
657             #
658             # Good for config files.
659             #
660             ##############################################################################
661             sub XML2Config
662             {
663 59     59 0 53 my ($XMLTree) = @_;
664              
665 59         39 my %hash;
666 59         102 foreach my $tree (&XML::Stream::GetXMLData("tree array",$XMLTree,"*"))
667             {
668 144 100       182 if ($tree->[0] eq "0")
669             {
670 86 100       339 return $tree->[1] unless ($tree->[1] =~ /^\s*$/);
671             }
672             else
673             {
674 58 100       121 if (&XML::Stream::GetXMLData("count",$XMLTree,$tree->[0]) > 1)
675             {
676 20         17 push(@{$hash{$tree->[0]}},&XML::Stream::XML2Config($tree));
  20         70  
677             }
678             else
679             {
680 38         80 $hash{$tree->[0]} = &XML::Stream::XML2Config($tree);
681             }
682             }
683             }
684 36         196 return \%hash;
685             }
686              
687              
688             1;