Index: perl/modules/Jabber/lib/XML/Stream/Tree.pm
===================================================================
--- perl/modules/Jabber/lib/XML/Stream/Tree.pm	(revision c2bed5539d456612d69de33e1dacc3afe5f70395)
+++ perl/modules/Jabber/lib/XML/Stream/Tree.pm	(revision c2bed5539d456612d69de33e1dacc3afe5f70395)
@@ -0,0 +1,682 @@
+##############################################################################
+#
+#  This library is free software; you can redistribute it and/or
+#  modify it under the terms of the GNU Library General Public
+#  License as published by the Free Software Foundation; either
+#  version 2 of the License, or (at your option) any later version.
+#
+#  This library is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+#  Library General Public License for more details.
+#
+#  You should have received a copy of the GNU Library General Public
+#  License along with this library; if not, write to the
+#  Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+#  Boston, MA  02111-1307, USA.
+#
+#  Jabber
+#  Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/
+#
+##############################################################################
+
+package XML::Stream::Tree;
+
+=head1 NAME
+
+XML::Stream::Tree - Functions to make building and parsing the tree easier
+to work with.
+
+=head1 SYNOPSIS
+
+  Just a collection of functions that do not need to be in memory if you
+choose one of the other methods of data storage.
+
+=head1 FORMAT
+
+The result of parsing:
+
+  <foo><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo>
+
+would be:
+         Tag   Content
+  ==================================================================
+  [foo, [{},
+         head, [{id => "a"},
+                0, "Hello ",
+                em, [{},
+                     0, "there"
+                    ]
+               ],
+         bar, [{},
+               0, "Howdy",
+               ref, [{}]
+              ],
+         0, "do"
+        ]
+  ]
+
+The above was copied from the XML::Parser man page.  Many thanks to
+Larry and Clark.
+
+=head1 AUTHOR
+
+By Ryan Eatmon in March 2001 for http://jabber.org/
+
+=head1 COPYRIGHT
+
+This module is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+use vars qw( $VERSION $LOADED );
+
+$VERSION = "1.22";
+$LOADED = 1;
+
+##############################################################################
+#
+# _handle_element - handles the main tag elements sent from the server.
+#                   On an open tag it creates a new XML::Parser::Tree so
+#                   that _handle_cdata and _handle_element can add data
+#                   and tags to it later.
+#
+##############################################################################
+sub _handle_element
+{
+    my $self;
+    $self = $_[0] if (ref($_[0]) eq "XML::Stream::Parser");
+    $self = shift unless (ref($_[0]) eq "XML::Stream::Parser");
+    my ($sax, $tag, %att) = @_;
+    my $sid = $sax->getSID();
+
+    $self->debug(2,"_handle_element: sid($sid) sax($sax) tag($tag) att(",%att,")");
+
+    my @NEW;
+    if($#{$self->{SIDS}->{$sid}->{tree}} < 0)
+    {
+        push @{$self->{SIDS}->{$sid}->{tree}}, $tag;
+    }
+    else
+    {
+        push @{ $self->{SIDS}->{$sid}->{tree}[ $#{$self->{SIDS}->{$sid}->{tree}}]}, $tag;
+    }
+    push @NEW, \%att;
+    push @{$self->{SIDS}->{$sid}->{tree}}, \@NEW;
+}
+
+
+##############################################################################
+#
+# _handle_cdata - handles the CDATA that is encountered.  Also, in the
+#                      spirit of XML::Parser::Tree it combines any sequential
+#                      CDATA into one tag.
+#
+##############################################################################
+sub _handle_cdata
+{
+    my $self;
+    $self = $_[0] if (ref($_[0]) eq "XML::Stream::Parser");
+    $self = shift unless (ref($_[0]) eq "XML::Stream::Parser");
+    my ($sax, $cdata) = @_;
+    my $sid = $sax->getSID();
+
+    $self->debug(2,"_handle_cdata: sid($sid) sax($sax) cdata($cdata)");
+
+    return if ($#{$self->{SIDS}->{$sid}->{tree}} == -1);
+
+    $self->debug(2,"_handle_cdata: sax($sax) cdata($cdata)");
+
+    my $pos = $#{$self->{SIDS}->{$sid}->{tree}};
+    $self->debug(2,"_handle_cdata: pos($pos)");
+
+    if ($pos > 0 && $self->{SIDS}->{$sid}->{tree}[$pos - 1] eq "0")
+    {
+        $self->debug(2,"_handle_cdata: append cdata");
+        $self->{SIDS}->{$sid}->{tree}[$pos - 1] .= $cdata;
+    }
+    else
+    {
+        $self->debug(2,"_handle_cdata: new cdata");
+        push @{$self->{SIDS}->{$sid}->{tree}[$#{$self->{SIDS}->{$sid}->{tree}}]}, 0;
+        push @{$self->{SIDS}->{$sid}->{tree}[$#{$self->{SIDS}->{$sid}->{tree}}]}, $cdata;
+    }  
+}
+
+
+##############################################################################
+#
+# _handle_close - when we see a close tag we need to pop the last element
+#                      from the list and push it onto the end of the previous
+#                      element.  This is how we build our hierarchy.
+#
+##############################################################################
+sub _handle_close
+{
+    my $self;
+    $self = $_[0] if (ref($_[0]) eq "XML::Stream::Parser");
+    $self = shift unless (ref($_[0]) eq "XML::Stream::Parser");
+    my ($sax, $tag) = @_;
+    my $sid = $sax->getSID();
+
+    $self->debug(2,"_handle_close: sid($sid) sax($sax) tag($tag)");
+
+    my $CLOSED = pop @{$self->{SIDS}->{$sid}->{tree}};
+
+    $self->debug(2,"_handle_close: check(",$#{$self->{SIDS}->{$sid}->{tree}},")");
+
+    if ($#{$self->{SIDS}->{$sid}->{tree}} == -1)
+    {
+        if ($self->{SIDS}->{$sid}->{rootTag} ne $tag)
+        {
+            $self->{SIDS}->{$sid}->{streamerror} = "Root tag mis-match: <$self->{SIDS}->{$sid}->{rootTag}> ... </$tag>\n";
+        }
+        return;
+    }
+
+    if($#{$self->{SIDS}->{$sid}->{tree}} < 1)
+    {
+
+        push @{$self->{SIDS}->{$sid}->{tree}}, $CLOSED;
+
+        if (ref($self) ne "XML::Stream::Parser")
+        {
+            my $stream_prefix = $self->StreamPrefix($sid);
+
+            if(defined($self->{SIDS}->{$sid}->{tree}->[0]) &&
+               ($self->{SIDS}->{$sid}->{tree}->[0] =~ /^${stream_prefix}\:/))
+            { 
+                my @tree = @{$self->{SIDS}->{$sid}->{tree}};
+                $self->{SIDS}->{$sid}->{tree} = [];
+                $self->ProcessStreamPacket($sid,\@tree);
+            }
+            else
+            {
+                my @tree = @{$self->{SIDS}->{$sid}->{tree}};
+                $self->{SIDS}->{$sid}->{tree} = [];
+                
+                my @special =
+                    &XML::Stream::XPath(
+                        \@tree,
+                        '[@xmlns="'.&XML::Stream::ConstXMLNS("xmpp-sasl").'" or @xmlns="'.&XML::Stream::ConstXMLNS("xmpp-tls").'"]'
+                    );
+                if ($#special > -1)
+                {
+                    my $xmlns = &GetXMLData("value",\@tree,"","xmlns");
+
+                    $self->ProcessSASLPacket($sid,\@tree)
+                        if ($xmlns eq &XML::Stream::ConstXMLNS("xmpp-sasl"));
+                    $self->ProcessTLSPacket($sid,\@tree)
+                        if ($xmlns eq &XML::Stream::ConstXMLNS("xmpp-tls"));
+                }
+                else
+                {
+                    &{$self->{CB}->{node}}($sid,\@tree);
+                }
+            }
+        }
+    }
+    else
+    {
+        push @{$self->{SIDS}->{$sid}->{tree}[$#{$self->{SIDS}->{$sid}->{tree}}]}, $CLOSED;
+    }
+}
+
+
+##############################################################################
+#
+# SetXMLData - takes a host of arguments and sets a portion of the specified
+#              XML::Parser::Tree object with that data.  The function works
+#              in two modes "single" or "multiple".  "single" denotes that
+#              the function should locate the current tag that matches this
+#              data and overwrite it's contents with data passed in.
+#              "multiple" denotes that a new tag should be created even if
+#              others exist.
+#
+#              type    - single or multiple
+#              XMLTree - pointer to XML::Stream Tree object
+#              tag     - name of tag to create/modify (if blank assumes
+#                        working with top level tag)
+#              data    - CDATA to set for tag
+#              attribs - attributes to ADD to tag
+#
+##############################################################################
+sub SetXMLData
+{
+    my ($type,$XMLTree,$tag,$data,$attribs) = @_;
+    my ($key);
+
+    if ($tag ne "")
+    {
+        if ($type eq "single")
+        {
+            my ($child);
+            foreach $child (1..$#{$$XMLTree[1]})
+            {
+                if ($$XMLTree[1]->[$child] eq $tag)
+                {
+                    if ($data ne "")
+                    {
+                        #todo: add code to handle writing the cdata again and appending it.
+                        $$XMLTree[1]->[$child+1]->[1] = 0;
+                        $$XMLTree[1]->[$child+1]->[2] = $data;
+                    }
+                    foreach $key (keys(%{$attribs}))
+                    {
+                        $$XMLTree[1]->[$child+1]->[0]->{$key} = $$attribs{$key};
+                    }
+                    return;
+                }
+            }
+        }
+        $$XMLTree[1]->[($#{$$XMLTree[1]}+1)] = $tag;
+        $$XMLTree[1]->[($#{$$XMLTree[1]}+1)]->[0] = {};
+        foreach $key (keys(%{$attribs}))
+        {
+            $$XMLTree[1]->[$#{$$XMLTree[1]}]->[0]->{$key} = $$attribs{$key};
+        }
+        if ($data ne "")
+        {
+            $$XMLTree[1]->[$#{$$XMLTree[1]}]->[1] = 0;
+            $$XMLTree[1]->[$#{$$XMLTree[1]}]->[2] = $data;
+        }
+    }
+    else
+    {
+        foreach $key (keys(%{$attribs}))
+        {
+            $$XMLTree[1]->[0]->{$key} = $$attribs{$key};
+        }
+        if ($data ne "")
+        {
+            if (($#{$$XMLTree[1]} > 0) &&
+                ($$XMLTree[1]->[($#{$$XMLTree[1]}-1)] eq "0"))
+            {
+                $$XMLTree[1]->[$#{$$XMLTree[1]}] .= $data;
+            }
+            else
+            {
+                $$XMLTree[1]->[($#{$$XMLTree[1]}+1)] = 0;
+                $$XMLTree[1]->[($#{$$XMLTree[1]}+1)] = $data;
+            }
+        }
+    }
+}
+
+
+##############################################################################
+#
+# GetXMLData - takes a host of arguments and returns various data structures
+#              that match them.
+#
+#              type - "existence" - returns 1 or 0 if the tag exists in the
+#                                   top level.
+#                     "value" - returns either the CDATA of the tag, or the
+#                               value of the attribute depending on which is
+#                               sought.  This ignores any mark ups to the data
+#                               and just returns the raw CDATA.
+#                     "value array" - returns an array of strings representing
+#                                     all of the CDATA in the specified tag.
+#                                     This ignores any mark ups to the data
+#                                     and just returns the raw CDATA.
+#                     "tree" - returns an XML::Parser::Tree object with the
+#                              specified tag as the root tag.
+#                     "tree array" - returns an array of XML::Parser::Tree
+#                                    objects each with the specified tag as
+#                                    the root tag.
+#                     "child array" - returns a list of all children nodes
+#                                     not including CDATA nodes.
+#                     "attribs" - returns a hash with the attributes, and
+#                                 their values, for the things that match
+#                                 the parameters
+#                     "count" - returns the number of things that match
+#                               the arguments
+#                     "tag" - returns the root tag of this tree
+#              XMLTree - pointer to XML::Parser::Tree object
+#              tag     - tag to pull data from.  If blank then the top level
+#                        tag is accessed.
+#              attrib  - attribute value to retrieve.  Ignored for types
+#                        "value array", "tree", "tree array".  If paired
+#                        with value can be used to filter tags based on
+#                        attributes and values.
+#              value   - only valid if an attribute is supplied.  Used to
+#                        filter for tags that only contain this attribute.
+#                        Useful to search through multiple tags that all
+#                        reference different name spaces.
+#
+##############################################################################
+sub GetXMLData
+{
+    my ($type,$XMLTree,$tag,$attrib,$value) = @_;
+
+    $tag = "" if !defined($tag);
+    $attrib = "" if !defined($attrib);
+    $value = "" if !defined($value);
+
+    my $skipthis = 0;
+
+    #---------------------------------------------------------------------------
+    # Check if a child tag in the root tag is being requested.
+    #---------------------------------------------------------------------------
+    if ($tag ne "")
+    {
+        my $count = 0;
+        my @array;
+        foreach my $child (1..$#{$$XMLTree[1]})
+        {
+            next if (($child/2) !~ /\./);
+            if (($$XMLTree[1]->[$child] eq $tag) || ($tag eq "*"))
+            {
+                next if (ref($$XMLTree[1]->[$child]) eq "ARRAY");
+
+                #---------------------------------------------------------------------
+                # Filter out tags that do not contain the attribute and value.
+                #---------------------------------------------------------------------
+                next if (($value ne "") && ($attrib ne "") && exists($$XMLTree[1]->[$child+1]->[0]->{$attrib}) && ($$XMLTree[1]->[$child+1]->[0]->{$attrib} ne $value));
+                next if (($attrib ne "") && ((ref($$XMLTree[1]->[$child+1]) ne "ARRAY") || !exists($$XMLTree[1]->[$child+1]->[0]->{$attrib})));
+
+                #---------------------------------------------------------------------
+                # Check for existence
+                #---------------------------------------------------------------------
+                if ($type eq "existence")
+                {
+                    return 1;
+                }
+                
+                #---------------------------------------------------------------------
+                # Return the raw CDATA value without mark ups, or the value of the
+                # requested attribute.
+                #---------------------------------------------------------------------
+                if ($type eq "value")
+                {
+                    if ($attrib eq "")
+                    {
+                        my $str = "";
+                        my $next = 0;
+                        my $index;
+                        foreach $index (1..$#{$$XMLTree[1]->[$child+1]}) {
+                            if ($next == 1) { $next = 0; next; }
+                            if ($$XMLTree[1]->[$child+1]->[$index] eq "0") {
+                                $str .= $$XMLTree[1]->[$child+1]->[$index+1];
+                                $next = 1;
+                            }
+                        }
+                        return $str;
+                    }
+                    return $$XMLTree[1]->[$child+1]->[0]->{$attrib}
+                        if (exists $$XMLTree[1]->[$child+1]->[0]->{$attrib});
+                }
+                #---------------------------------------------------------------------
+                # Return an array of values that represent the raw CDATA without
+                # mark up tags for the requested tags.
+                #---------------------------------------------------------------------
+                if ($type eq "value array")
+                {
+                    if ($attrib eq "")
+                    {
+                        my $str = "";
+                        my $next = 0;
+                        my $index;
+                        foreach $index (1..$#{$$XMLTree[1]->[$child+1]})
+                        {
+                            if ($next == 1) { $next = 0;  next; }
+                            if ($$XMLTree[1]->[$child+1]->[$index] eq "0")
+                            {
+                                $str .= $$XMLTree[1]->[$child+1]->[$index+1];
+                                $next = 1;
+                            }
+                        }
+                        push(@array,$str);
+                    }
+                    else
+                    {
+                        push(@array,$$XMLTree[1]->[$child+1]->[0]->{$attrib})
+                            if (exists $$XMLTree[1]->[$child+1]->[0]->{$attrib});
+                    }
+                }
+                #---------------------------------------------------------------------
+                # Return a pointer to a new XML::Parser::Tree object that has the
+                # requested tag as the root tag.
+                #---------------------------------------------------------------------
+                if ($type eq "tree")
+                {
+                    my @tree = ( $$XMLTree[1]->[$child] , $$XMLTree[1]->[$child+1] );
+                    return @tree;
+                }
+                #---------------------------------------------------------------------
+                # Return an array of pointers to XML::Parser::Tree objects that have
+                # the requested tag as the root tags.
+                #---------------------------------------------------------------------
+                if ($type eq "tree array")
+                {
+                    my @tree = ( $$XMLTree[1]->[$child] , $$XMLTree[1]->[$child+1] );
+                    push(@array,\@tree);
+                }
+                #---------------------------------------------------------------------
+                # Return a count of the number of tags that match
+                #---------------------------------------------------------------------
+                if ($type eq "count")
+                {
+                    if ($$XMLTree[1]->[$child] eq "0")
+                    {
+                        $skipthis = 1;
+                        next;
+                    }
+                    if ($skipthis == 1)
+                    {
+                        $skipthis = 0;
+                        next;
+                    }
+                    $count++;
+                }
+                #---------------------------------------------------------------------
+                # Return a count of the number of tags that match
+                #---------------------------------------------------------------------
+                if ($type eq "child array")
+                {
+                    my @tree = ( $$XMLTree[1]->[$child] , $$XMLTree[1]->[$child+1] );
+                    push(@array,\@tree) if ($tree[0] ne "0");
+                }
+                #---------------------------------------------------------------------
+                # Return the attribute hash that matches this tag
+                #---------------------------------------------------------------------
+                if ($type eq "attribs")
+                {
+                    return (%{$$XMLTree[1]->[$child+1]->[0]});
+                }
+            }
+        }
+        #-------------------------------------------------------------------------
+        # If we are returning arrays then return array.
+        #-------------------------------------------------------------------------
+        if (($type eq "tree array") || ($type eq "value array") ||
+            ($type eq "child array"))
+        {
+            return @array;
+        }
+
+        #-------------------------------------------------------------------------
+        # If we are returning then count, then do so
+        #-------------------------------------------------------------------------
+        if ($type eq "count")
+        {
+            return $count;
+        }
+    }
+    else
+    {
+        #-------------------------------------------------------------------------
+        # This is the root tag, so handle things a level up.
+        #-------------------------------------------------------------------------
+
+        #-------------------------------------------------------------------------
+        # Return the raw CDATA value without mark ups, or the value of the
+        # requested attribute.
+        #-------------------------------------------------------------------------
+        if ($type eq "value")
+        {
+            if ($attrib eq "")
+            {
+                my $str = "";
+                my $next = 0;
+                my $index;
+                foreach $index (1..$#{$$XMLTree[1]})
+                {
+                    if ($next == 1) { $next = 0; next; }
+                    if ($$XMLTree[1]->[$index] eq "0")
+                    {
+                        $str .= $$XMLTree[1]->[$index+1];
+                        $next = 1;
+                    }
+                }
+                return $str;
+            }
+            return $$XMLTree[1]->[0]->{$attrib}
+                if (exists $$XMLTree[1]->[0]->{$attrib});
+        }
+        #-------------------------------------------------------------------------
+        # Return a pointer to a new XML::Parser::Tree object that has the
+        # requested tag as the root tag.
+        #-------------------------------------------------------------------------
+        if ($type eq "tree")
+        {
+            my @tree =  @{$$XMLTree};
+            return @tree;
+        }
+
+        #-------------------------------------------------------------------------
+        # Return the 1 if the specified attribute exists in the root tag.
+        #-------------------------------------------------------------------------
+        if ($type eq "existence")
+        {
+            return 1 if (($attrib ne "") && (exists($$XMLTree[1]->[0]->{$attrib})));
+        }
+
+        #-------------------------------------------------------------------------
+        # Return the attribute hash that matches this tag
+        #-------------------------------------------------------------------------
+        if ($type eq "attribs")
+        {
+            return %{$$XMLTree[1]->[0]};
+        }
+        #-------------------------------------------------------------------------
+        # Return the tag of this node
+        #-------------------------------------------------------------------------
+        if ($type eq "tag")
+        {
+            return $$XMLTree[0];
+        }
+    }
+    #---------------------------------------------------------------------------
+    # Return 0 if this was a request for existence, or "" if a request for
+    # a "value", or [] for "tree", "value array", and "tree array".
+    #---------------------------------------------------------------------------
+    return 0 if ($type eq "existence");
+    return "" if ($type eq "value");
+    return [];
+}
+
+
+##############################################################################
+#
+# BuildXML - takes an XML::Parser::Tree object and builds the XML string
+#                 that it represents.
+#
+##############################################################################
+sub BuildXML
+{
+    my ($parseTree,$rawXML) = @_;
+
+    return "" if $#{$parseTree} == -1;
+
+    my $str = "";
+    if (ref($parseTree->[0]) eq "") 
+    {
+        if ($parseTree->[0] eq "0")
+        {
+            return &XML::Stream::EscapeXML($parseTree->[1]);
+        }
+
+        $str = "<".$parseTree->[0];
+        foreach my $att (sort {$a cmp $b} keys(%{$parseTree->[1]->[0]}))
+        {
+            $str .= " ".$att."='".&XML::Stream::EscapeXML($parseTree->[1]->[0]->{$att})."'";
+        }
+
+        if (($#{$parseTree->[1]} > 0) || (defined($rawXML) && ($rawXML ne "")))
+        {
+            $str .= ">";
+            
+            my $index = 1;
+            while($index <= $#{$parseTree->[1]})
+            {
+                my @newTree = ( $parseTree->[1]->[$index], $parseTree->[1]->[$index+1] );
+                $str .= &XML::Stream::Tree::BuildXML(\@newTree);
+                $index += 2;
+            }
+            
+            $str .= $rawXML if defined($rawXML);
+            $str .= "</".$parseTree->[0].">";
+        }
+        else
+        {
+            $str .= "/>";
+        }
+
+    }
+
+    return $str;
+}
+
+
+##############################################################################
+#
+# XML2Config - takes an XML data tree and turns it into a hash of hashes.
+#              This only works for certain kinds of XML trees like this:
+#
+#                <foo>
+#                  <bar>1</bar>
+#                  <x>
+#                    <y>foo</y>
+#                  </x>
+#                  <z>5</z>
+#                </foo>
+#
+#              The resulting hash would be:
+#
+#                $hash{bar} = 1;
+#                $hash{x}->{y} = "foo";
+#                $hash{z} = 5;
+#
+#              Good for config files.
+#
+##############################################################################
+sub XML2Config
+{
+    my ($XMLTree) = @_;
+
+    my %hash;
+    foreach my $tree (&XML::Stream::GetXMLData("tree array",$XMLTree,"*"))
+    {
+        if ($tree->[0] eq "0")
+        {
+            return $tree->[1] unless ($tree->[1] =~ /^\s*$/);
+        }
+        else
+        {
+            if (&XML::Stream::GetXMLData("count",$XMLTree,$tree->[0]) > 1)
+            {
+                push(@{$hash{$tree->[0]}},&XML::Stream::XML2Config($tree));
+            }
+            else
+            {
+                $hash{$tree->[0]} = &XML::Stream::XML2Config($tree);
+            }
+        }
+    }
+    return \%hash;
+}
+
+
+1;
