source: perl/modules/Jabber/lib/XML/Stream/Node.pm @ 367fbf3

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