Index: perl/modules/Jabber/lib/XML/Stream/Namespace.pm
===================================================================
--- perl/modules/Jabber/lib/XML/Stream/Namespace.pm	(revision c2bed5539d456612d69de33e1dacc3afe5f70395)
+++ perl/modules/Jabber/lib/XML/Stream/Namespace.pm	(revision c2bed5539d456612d69de33e1dacc3afe5f70395)
@@ -0,0 +1,190 @@
+##############################################################################
+#
+#  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::Namespace;
+
+=head1 NAME
+
+XML::Stream::Namespace - Object to make defining Namespaces easier in 
+                         XML::Stream.
+
+=head1 SYNOPSIS
+
+XML::Stream::Namespace is a helper package to XML::Stream.  It provides
+a clean way of defining Namespaces for XML::Stream to use when connecting.
+
+=head1 DESCRIPTION
+
+  This module allows you to set and read elements from an XML::Stream
+  Namespace.
+
+=head1 METHODS
+
+  SetNamespace("mynamespace");
+  SetXMLNS("http://www.mynamespace.com/xmlns");
+  SetAttributes(attrib1=>"value1",
+                attrib2=>"value2");
+
+  GetNamespace() returns "mynamespace"
+  GetXMLNS() returns "http://www.mynamespace.com/xmlns"
+  GetAttributes() returns a hash ( attrib1=>"value1",attrib2=>"value2")
+  GetStream() returns the following string:
+    "xmlns:mynamespace='http://www.nynamespace.com/xmlns' 
+     mynamespace:attrib1='value1' 
+     mynamespace:attrib2='value2'"
+
+=head1 EXAMPLES
+
+
+  $myNamespace = new XML::Stream::Namespace("mynamspace");
+  $myNamespace->SetXMLNS("http://www.mynamespace.org/xmlns");
+  $myNamespace->SetAttributes(foo=>"bar",
+                              bob=>"vila");
+
+  $stream = new XML::Stream;
+  $stream->Connect(name=>"foo.bar.org",
+                   port=>1234,
+                   namespace=>"foo:bar",
+                   namespaces=>[ $myNamespace ]);
+
+  #
+  # The above Connect will send the following as the opening string
+  # of the stream to foo.bar.org:1234...
+  #
+  #   <stream:stream 
+  #    xmlns:stream="http://etherx.jabber.org/streams"
+  #    to="foo.bar.org"
+  #    xmlns="foo:bar" 
+  #    xmlns:mynamespace="http://www.mynamespace.org/xmlns"
+  #    mynamespace:foo="bar"
+  #    mynamespace:bob="vila">
+  #
+    
+
+=head1 AUTHOR
+
+Written by Ryan Eatmon in February 2000
+Idea By Thomas Charron in January of 2000 for http://etherx.jabber.org/streams/
+
+=head1 COPYRIGHT
+
+This module is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+use strict;
+use Carp;
+use vars qw( $VERSION );
+
+$VERSION = "1.22";
+
+sub new
+{
+  my $proto = shift;
+  my $self = { };
+
+  ($self->{Namespace}) = @_ if ($#_ > -1);
+
+  $self->{Attributes} = {};
+
+  bless($self,$proto);
+  return $self;
+}
+
+
+sub SetNamespace
+{
+  my $self = shift;
+  my ($namespace) = @_;
+
+  $self->{Namespace} = $namespace;
+}
+
+
+sub SetXMLNS
+{
+  my $self = shift;
+  my ($xmlns) = @_;
+
+  $self->{XMLNS} = $xmlns;
+}
+
+
+sub SetAttributes
+{
+  my $self = shift;
+  my %att = @_;
+
+  my $key;
+  foreach $key (keys(%att))
+  {
+    $self->{Attributes}->{$key} = $att{$key};
+  }
+}
+
+
+sub GetNamespace
+{
+  my $self = shift;
+
+  return $self->{Namespace};
+}
+
+sub GetXMLNS
+{
+  my $self = shift;
+
+  return $self->{XMLNS};
+}
+
+sub GetAttributes
+{
+  my $self = shift;
+  my ($attrib) = @_;
+
+  return $self->{Attributes} if ($attrib eq "");
+  return $self->{Attributes}->{$attrib};
+}
+
+
+sub GetStream
+{
+  my $self = shift;
+
+  my $string = "";
+
+  $string .= "xmlns:".$self->GetNamespace();
+  $string .= "='".$self->GetXMLNS()."'";
+  my $attrib;
+  foreach $attrib (keys(%{$self->GetAttributes()}))
+  {
+    $string .= " ".$self->GetNamespace().":";
+    $string .= $attrib;
+    $string .= "='".$self->GetAttributes($attrib)."'";
+  }
+    
+  return $string;
+}
+
+1;
+
Index: perl/modules/Jabber/lib/XML/Stream/Node.pm
===================================================================
--- perl/modules/Jabber/lib/XML/Stream/Node.pm	(revision c2bed5539d456612d69de33e1dacc3afe5f70395)
+++ perl/modules/Jabber/lib/XML/Stream/Node.pm	(revision c2bed5539d456612d69de33e1dacc3afe5f70395)
@@ -0,0 +1,944 @@
+##############################################################################
+#
+#  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::Node;
+
+=head1 NAME
+
+XML::Stream::Node - 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.
+
+  This creates a hierarchy of Perl objects and provides various methods
+to manipulate the structure of the tree.  It is much like the C library
+libxml.
+
+=head1 FORMAT
+
+The result of parsing:
+
+  <foo><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo>
+
+would be:
+
+  [ tag:       foo
+    att:       {}
+    children:  [ tag:      head
+                 att:      {id=>"a"}
+                 children: [ tag:      "__xmlstream__:node:cdata"
+                             children: "Hello "
+                           ]
+                           [ tag:      em
+                             children: [ tag:      "__xmlstream__:node:cdata"
+                                         children: "there"
+                                       ]
+                           ]
+               ]
+               [ tag:      bar
+                 children: [ tag:      "__xmlstream__:node:cdata"
+                             children: "Howdy "
+                           ]
+                           [ tag:      ref
+                           ]
+               ]
+               [ tag:      "__xmlstream__:node:cdata"
+                 children: "do"
+               ]
+  ]
+
+=head1 METHODS
+
+  new()          - creates a new node.  If you specify tag, then the root
+  new(tag)         tag is set.  If you specify data, then cdata is added
+  new(tag,cdata)   to the node as well.  Returns the created node.
+
+  get_tag() - returns the root tag of the node.
+
+  set_tag(tag) - set the root tag of the node to tag.
+
+  add_child(node)      - adds the specified node as a child to the current
+  add_child(tag)         node, or creates a new node with the specified tag
+  add_child(tag,cdata)   as the root node.  Returns the node added.
+
+  remove_child(node) - removes the child node from the current node.
+  
+  remove_cdata() - removes all of the cdata children from the current node.
+
+  add_cdata(string) - adds the string as cdata onto the current nodes
+                      child list.
+
+  get_cdata() - returns all of the cdata children concatenated together
+                into one string.
+
+  get_attrib(attrib) - returns the value of the attrib if it is valid,
+                       or returns undef is attrib is not a real
+                       attribute.
+
+  put_attrib(hash) - for each key/value pair specified, create an
+                     attribute in the node.
+
+  remove_attrib(attrib) - remove the specified attribute from the node.
+
+  add_raw_xml(string,[string,...]) - directly add a string into the XML
+                                     packet as the last child, with no
+                                     translation.
+
+  get_raw_xml() - return all of the XML in a single string, undef if there
+                  is no raw XML to include.
+
+  remove_raw_xml() - remove all raw XML strings.
+
+  children() - return all of the children of the node in a list.
+
+  attrib() - returns a hash containing all of the attributes on this
+             node.
+
+  copy() - return a recursive copy of the node.
+
+  XPath(path) - run XML::Stream::XPath on this node.
+  
+  XPathCheck(path) - run XML::Stream::XPath on this node and return 1 or 0
+                     to see if it matches or not.
+
+  GetXML() - return the node in XML string form.
+
+=head1 AUTHOR
+
+By Ryan Eatmon in June 2002 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;
+
+sub new
+{
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+
+    if (ref($_[0]) eq "XML::Stream::Node")
+    {
+        return $_[0];
+    }
+
+    my $self = {};
+    bless($self, $proto);
+
+    my ($tag,$data) = @_;
+
+    $self->set_tag($tag) if defined($tag);
+    $self->add_cdata($data) if defined($data);
+    $self->remove_raw_xml();
+
+    return $self;
+}
+
+
+sub debug
+{
+    my $self = shift;
+    my ($indent) = @_;
+
+    $indent = "" unless defined($indent);
+
+    if ($self->{TAG} eq "__xmlstream__:node:cdata")
+    {
+        print        $indent,"cdata(",join("",@{$self->{CHILDREN}}),")\n";
+    }
+    else
+    {
+        print        $indent,"packet($self):\n";
+        print        $indent,"tag:     <$self->{TAG}\n";
+        if (scalar(keys(%{$self->{ATTRIBS}})) > 0)
+        {
+            print      $indent,"attribs:\n";
+            foreach my $key (sort {$a cmp $b} keys(%{$self->{ATTRIBS}}))
+            {
+                print    $indent,"           $key = '$self->{ATTRIBS}->{$key}'\n";
+            }
+        }
+        if ($#{$self->{CHILDREN}} == -1)
+        {
+            print      $indent,"         />\n";
+        }
+        else
+        {
+            print      $indent,"         >\n";
+            print      $indent,"children:\n";
+            foreach my $child (@{$self->{CHILDREN}})
+            {
+                $child->debug($indent."  ");
+            }
+        }
+        print      $indent,"         </$self->{TAG}>\n";
+    }
+}
+
+
+sub children
+{
+    my $self = shift;
+
+    return () unless exists($self->{CHILDREN});
+    return @{$self->{CHILDREN}};
+}
+
+
+sub add_child
+{
+    my $self = shift;
+
+    my $child = new XML::Stream::Node(@_);
+    push(@{$self->{CHILDREN}},$child);
+    return $child;
+}
+
+
+sub remove_child
+{
+    my $self = shift;
+    my $child = shift;
+
+    foreach my $index (0..$#{$self->{CHILDREN}})
+    {
+        if ($child == $self->{CHILDREN}->[$index])
+        {
+            splice(@{$self->{CHILDREN}},$index,1);
+            last;
+        }
+    }
+}
+
+
+sub add_cdata
+{
+    my $self = shift;
+    my $child = new XML::Stream::Node("__xmlstream__:node:cdata");
+    foreach my $cdata (@_)
+    {
+        push(@{$child->{CHILDREN}},$cdata);
+    }
+    push(@{$self->{CHILDREN}},$child);
+    return $child;
+}
+
+
+sub get_cdata
+{
+    my $self = shift;
+
+    my $cdata = "";
+    foreach my $child (@{$self->{CHILDREN}})
+    {
+        $cdata .= join("",$child->children())
+            if ($child->get_tag() eq "__xmlstream__:node:cdata");
+    }
+
+    return $cdata;
+} 
+
+
+sub remove_cdata
+{
+    my $self = shift;
+
+    my @remove = ();
+    foreach my $index (0..$#{$self->{CHILDREN}})
+    {
+        if ($self->{CHILDREN}->[$index]->get_tag() eq "__xmlstream__:node:cdata")
+        {
+
+            unshift(@remove,$index);
+        }
+    }
+    foreach my $index (@remove)
+    {
+        splice(@{$self->{CHILDREN}},$index,1);
+    }
+} 
+
+
+sub attrib
+{
+    my $self = shift;
+    return () unless exists($self->{ATTRIBS});
+    return %{$self->{ATTRIBS}};
+} 
+
+
+sub get_attrib
+{
+    my $self = shift;
+    my ($key) = @_;
+
+    return unless exists($self->{ATTRIBS}->{$key});
+    return $self->{ATTRIBS}->{$key};
+}
+
+
+sub put_attrib
+{ 
+    my $self = shift;
+    my (%att) = @_;
+
+    foreach my $key (keys(%att))
+    {
+        $self->{ATTRIBS}->{$key} = $att{$key};
+    }
+}
+
+
+sub remove_attrib
+{
+    my $self = shift;
+    my ($key) = @_;
+
+    return unless exists($self->{ATTRIBS}->{$key});
+    delete($self->{ATTRIBS}->{$key});
+}
+
+
+sub add_raw_xml
+{
+    my $self = shift;
+    my (@raw) = @_;
+
+    push(@{$self->{RAWXML}},@raw);
+}
+
+sub get_raw_xml
+{
+    my $self = shift;
+
+    return if ($#{$self->{RAWXML}} == -1);
+    return join("",@{$self->{RAWXML}});
+}
+
+
+sub remove_raw_xml
+{
+    my $self = shift;
+    $self->{RAWXML} = [];
+}
+
+
+sub get_tag
+{
+    my $self = shift;
+
+    return $self->{TAG};
+}
+
+
+sub set_tag
+{
+    my $self = shift;
+    my ($tag) = @_;
+
+    $self->{TAG} = $tag; 
+}
+
+
+sub XPath
+{
+    my $self = shift;
+    my @results = &XML::Stream::XPath($self,@_);
+    return unless ($#results > -1);
+    return $results[0] unless wantarray;
+    return @results;
+}
+
+
+sub XPathCheck
+{
+    my $self = shift;
+    return &XML::Stream::XPathCheck($self,@_);
+}
+
+
+sub GetXML
+{
+    my $self = shift;
+
+    return &BuildXML($self,@_);
+}
+
+
+sub copy
+{
+    my $self = shift;
+
+    my $new_node = new XML::Stream::Node();
+    $new_node->set_tag($self->get_tag());
+    $new_node->put_attrib($self->attrib());
+
+    foreach my $child ($self->children())
+    {
+        if ($child->get_tag() eq "__xmlstream__:node:cdata")
+        {
+            $new_node->add_cdata($self->get_cdata());
+        }
+        else
+        {
+            $new_node->add_child($child->copy());
+        }
+    }
+
+    return $new_node;
+}
+
+
+
+
+
+##############################################################################
+#
+# _handle_element - handles the main tag elements sent from the server.
+#                   On an open tag it creates a new XML::Parser::Node 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,"Node: _handle_element: sid($sid) sax($sax) tag($tag) att(",%att,")");
+
+    my $node = new XML::Stream::Node($tag);
+    $node->put_attrib(%att);
+
+    $self->debug(2,"Node: _handle_element: check(",$#{$self->{SIDS}->{$sid}->{node}},")");
+
+    if ($#{$self->{SIDS}->{$sid}->{node}} >= 0)
+    {
+        $self->{SIDS}->{$sid}->{node}->[$#{$self->{SIDS}->{$sid}->{node}}]->
+            add_child($node);
+    }
+
+    push(@{$self->{SIDS}->{$sid}->{node}},$node);
+}
+
+
+##############################################################################
+#
+# _handle_cdata - handles the CDATA that is encountered.  Also, in the
+#                      spirit of XML::Parser::Node 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,"Node: _handle_cdata: sid($sid) sax($sax) cdata($cdata)");
+
+    return if ($#{$self->{SIDS}->{$sid}->{node}} == -1);
+
+    $self->debug(2,"Node: _handle_cdata: sax($sax) cdata($cdata)");
+
+    $self->{SIDS}->{$sid}->{node}->[$#{$self->{SIDS}->{$sid}->{node}}]->
+        add_cdata($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,"Node: _handle_close: sid($sid) sax($sax) tag($tag)");
+
+    $self->debug(2,"Node: _handle_close: check(",$#{$self->{SIDS}->{$sid}->{node}},")");
+
+    if ($#{$self->{SIDS}->{$sid}->{node}} == -1)
+    {
+        $self->debug(2,"Node: _handle_close: rootTag($self->{SIDS}->{$sid}->{rootTag}) tag($tag)");
+        if ($self->{SIDS}->{$sid}->{rootTag} ne $tag)
+        {
+            $self->{SIDS}->{$sid}->{streamerror} = "Root tag mis-match: <$self->{SIDS}->{$sid}->{rootTag}> ... </$tag>\n";
+        }
+        return;
+    }
+
+    my $CLOSED = pop @{$self->{SIDS}->{$sid}->{node}};
+
+    $self->debug(2,"Node: _handle_close: check2(",$#{$self->{SIDS}->{$sid}->{node}},")");
+    
+    if($#{$self->{SIDS}->{$sid}->{node}} == -1)
+    {
+        push @{$self->{SIDS}->{$sid}->{node}}, $CLOSED;
+
+        if (ref($self) ne "XML::Stream::Parser")
+        {
+            my $stream_prefix = $self->StreamPrefix($sid);
+            
+            if(defined($self->{SIDS}->{$sid}->{node}->[0]) &&
+               ($self->{SIDS}->{$sid}->{node}->[0]->get_tag() =~ /^${stream_prefix}\:/))
+            {
+                my $node = $self->{SIDS}->{$sid}->{node}->[0];
+                $self->{SIDS}->{$sid}->{node} = [];
+                $self->ProcessStreamPacket($sid,$node);
+            }
+            else
+            {
+                my $node = $self->{SIDS}->{$sid}->{node}->[0];
+                $self->{SIDS}->{$sid}->{node} = [];
+
+                my @special =
+                    &XML::Stream::XPath(
+                        $node,
+                        '[@xmlns="'.&XML::Stream::ConstXMLNS("xmpp-sasl").'" or @xmlns="'.&XML::Stream::ConstXMLNS("xmpp-tls").'"]'
+                    );
+                if ($#special > -1)
+                {
+                    my $xmlns = $node->get_attrib("xmlns");
+                    
+                    $self->ProcessSASLPacket($sid,$node)
+                        if ($xmlns eq &XML::Stream::ConstXMLNS("xmpp-sasl"));
+                    $self->ProcessTLSPacket($sid,$node)
+                        if ($xmlns eq &XML::Stream::ConstXMLNS("xmpp-tls"));
+                }
+                else
+                {
+                    &{$self->{CB}->{node}}($sid,$node);
+                }
+            }
+        }
+    }
+}
+
+
+##############################################################################
+#
+# SetXMLData - takes a host of arguments and sets a portion of the specified
+#              XML::Parser::Node 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 Node 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) = @_;
+
+    if ($tag ne "")
+    {
+        if ($type eq "single")
+        {
+            foreach my $child ($XMLTree->children())
+            {
+                if ($$XMLTree[1]->[$child] eq $tag)
+                {
+                    $XMLTree->remove_child($child);
+
+                    my $newChild = $XMLTree->add_child($tag);
+                    $newChild->put_attrib(%{$attribs});
+                    $newChild->add_cdata($data) if ($data ne "");
+                    return;
+                }
+            }
+        }
+        my $newChild = $XMLTree->add_child($tag);
+        $newChild->put_attrib(%{$attribs});
+        $newChild->add_cdata($data) if ($data ne "");
+    }
+    else
+    {
+        $XMLTree->put_attrib(%{$attribs});
+        $XMLTree->add_cdata($data) if ($data ne "");
+    }
+}
+
+
+##############################################################################
+#
+# 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::Node object with the
+#                              specified tag as the root tag.
+#                     "tree array" - returns an array of XML::Parser::Node
+#                                    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::Node 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 ($XMLTree->children())
+        {
+            if (($child->get_tag() eq $tag) || ($tag eq "*"))
+            {
+                #-------------------------------------------------------------
+                # Filter out tags that do not contain the attribute and value.
+                #-------------------------------------------------------------
+                next if (($value ne "") && ($attrib ne "") && $child->get_attrib($attrib) && ($XMLTree->get_attrib($attrib) ne $value));
+                next if (($attrib ne "") && !$child->get_attrib($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 = $child->get_cdata();
+                        return $str;
+                    }
+                    return $XMLTree->get_attrib($attrib)
+                        if defined($XMLTree->get_attrib($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 = $child->get_cdata();
+                        push(@array,$str);
+                    }
+                    else
+                    {
+                        push(@array, $XMLTree->get_attrib($attrib))
+                        if defined($XMLTree->get_attrib($attrib));
+                    }
+                }
+                #-------------------------------------------------------------
+                # Return a pointer to a new XML::Parser::Tree object that has
+                # the requested tag as the root tag.
+                #-------------------------------------------------------------
+                if ($type eq "tree")
+                {
+                    return $child;
+                }
+                #-------------------------------------------------------------
+                # Return an array of pointers to XML::Parser::Tree objects
+                # that have the requested tag as the root tags.
+                #-------------------------------------------------------------
+                if ($type eq "tree array")
+                {
+                    push(@array,$child);
+                }
+                #-------------------------------------------------------------
+                # Return an array of pointers to XML::Parser::Tree objects
+                # that have the requested tag as the root tags.
+                #-------------------------------------------------------------
+                if ($type eq "child array")
+                {
+                    push(@array,$child) if ($child->get_tag() ne "__xmlstream__:node:cdata");
+                }
+                #-------------------------------------------------------------
+                # Return a count of the number of tags that match
+                #-------------------------------------------------------------
+                if ($type eq "count")
+                {
+                    $count++;
+                }
+                #-------------------------------------------------------------
+                # Return the attribute hash that matches this tag
+                #-------------------------------------------------------------
+                if ($type eq "attribs")
+                {
+                    return $XMLTree->attrib();
+                }
+            }
+        }
+        #---------------------------------------------------------------------
+        # 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 = $XMLTree->get_cdata();
+                return $str;
+            }
+            return $XMLTree->get_attrib($attrib)
+                if $XMLTree->get_attrib($attrib);
+        }
+        #---------------------------------------------------------------------
+        # Return a pointer to a new XML::Parser::Tree object that has the
+        # requested tag as the root tag.
+        #---------------------------------------------------------------------
+        if ($type eq "tree")
+        {
+            return $XMLTree;
+        }
+
+        #---------------------------------------------------------------------
+        # Return the 1 if the specified attribute exists in the root tag.
+        #---------------------------------------------------------------------
+        if ($type eq "existence")
+        {
+            if ($attrib ne "")
+            {
+                return ($XMLTree->get_attrib($attrib) eq $value) if ($value ne "");
+                return defined($XMLTree->get_attrib($attrib));
+            }
+            return 0;
+        }
+
+        #---------------------------------------------------------------------
+        # Return the attribute hash that matches this tag
+        #---------------------------------------------------------------------
+        if ($type eq "attribs")
+        {
+            return $XMLTree->attrib();
+        }
+        #---------------------------------------------------------------------
+        # Return the tag of this node
+        #---------------------------------------------------------------------
+        if ($type eq "tag")
+        {
+            return $XMLTree->get_tag();
+        }
+    }
+    #-------------------------------------------------------------------------
+    # 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 ($node,$rawXML) = @_;
+
+    my $str = "<".$node->get_tag();
+
+    my %attrib = $node->attrib();
+
+    foreach my $att (sort {$a cmp $b} keys(%attrib))
+    {
+        $str .= " ".$att."='".&XML::Stream::EscapeXML($attrib{$att})."'";
+    }
+
+    my @children = $node->children();
+    if (($#children > -1) ||
+        (defined($rawXML) && ($rawXML ne "")) ||
+        (defined($node->get_raw_xml()) && ($node->get_raw_xml() ne ""))
+       )
+    {
+        $str .= ">";
+        foreach my $child (@children)
+        {
+            if ($child->get_tag() eq "__xmlstream__:node:cdata")
+            {
+                $str .= &XML::Stream::EscapeXML(join("",$child->children()));
+            }
+            else
+            {
+                $str .= &XML::Stream::Node::BuildXML($child);
+            }
+        }
+        $str .= $node->get_raw_xml()
+            if (defined($node->get_raw_xml()) &&
+                ($node->get_raw_xml() ne "")
+               );
+        $str .= $rawXML if (defined($rawXML) && ($rawXML ne ""));
+        $str .= "</".$node->get_tag().">";
+    }
+    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->get_tag() eq "__xmlstream__:node:cdata")
+        {
+            my $str = join("",$tree->children());
+            return $str unless ($str =~ /^\s*$/);
+        }
+        else
+        {
+            if (&XML::Stream::GetXMLData("count",$XMLTree,$tree->get_tag()) > 1)
+            {
+                push(@{$hash{$tree->get_tag()}},&XML::Stream::XML2Config($tree));
+            }
+            else
+            {
+                $hash{$tree->get_tag()} = &XML::Stream::XML2Config($tree);
+            }
+        }
+    }
+    return \%hash;
+}
+
+
+1;
Index: perl/modules/Jabber/lib/XML/Stream/Parser.pm
===================================================================
--- perl/modules/Jabber/lib/XML/Stream/Parser.pm	(revision c2bed5539d456612d69de33e1dacc3afe5f70395)
+++ perl/modules/Jabber/lib/XML/Stream/Parser.pm	(revision c2bed5539d456612d69de33e1dacc3afe5f70395)
@@ -0,0 +1,570 @@
+##############################################################################
+#
+#  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::Parser;
+
+=head1 NAME
+
+  XML::Stream::Parser - SAX XML Parser for XML Streams
+
+=head1 SYNOPSIS
+
+  Light weight XML parser that builds XML::Parser::Tree objects from the
+  incoming stream and passes them to a function to tell whoever is using
+  it that there are new packets.
+
+=head1 DESCRIPTION
+
+  This module provides a very light weight parser
+
+=head1 METHODS
+
+=head1 EXAMPLES
+
+=head1 AUTHOR
+
+By Ryan Eatmon in January of 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 strict;
+use vars qw( $VERSION );
+
+$VERSION = "1.22";
+
+sub new
+{
+    my $self = { };
+
+    bless($self);
+
+    my %args;
+    while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
+
+    $self->{PARSING} = 0;
+    $self->{DOC} = 0;
+    $self->{XML} = "";
+    $self->{CNAME} = ();
+    $self->{CURR} = 0;
+
+    $args{nonblocking} = 0 unless exists($args{nonblocking});
+
+    $self->{NONBLOCKING} = delete($args{nonblocking});
+
+    $self->{DEBUGTIME} = 0;
+    $self->{DEBUGTIME} = $args{debugtime} if exists($args{debugtime});
+
+    $self->{DEBUGLEVEL} = 0;
+    $self->{DEBUGLEVEL} = $args{debuglevel} if exists($args{debuglevel});
+
+    $self->{DEBUGFILE} = "";
+
+    if (exists($args{debugfh}) && ($args{debugfh} ne ""))
+    {
+        $self->{DEBUGFILE} = $args{debugfh};
+        $self->{DEBUG} = 1;
+    }
+
+    if ((exists($args{debugfh}) && ($args{debugfh} eq "")) ||
+        (exists($args{debug}) && ($args{debug} ne "")))
+        {
+        $self->{DEBUG} = 1;
+        if (lc($args{debug}) eq "stdout")
+        {
+            $self->{DEBUGFILE} = new FileHandle(">&STDERR");
+            $self->{DEBUGFILE}->autoflush(1);
+        }
+        else
+        {
+            if (-e $args{debug})
+            {
+                if (-w $args{debug})
+                {
+                    $self->{DEBUGFILE} = new FileHandle(">$args{debug}");
+                    $self->{DEBUGFILE}->autoflush(1);
+                }
+                else
+                {
+                    print "WARNING: debug file ($args{debug}) is not writable by you\n";
+                    print "         No debug information being saved.\n";
+                    $self->{DEBUG} = 0;
+                }
+            }
+            else
+            {
+                $self->{DEBUGFILE} = new FileHandle(">$args{debug}");
+                if (defined($self->{DEBUGFILE}))
+                {
+                    $self->{DEBUGFILE}->autoflush(1);
+                }
+                else
+                {
+                    print "WARNING: debug file ($args{debug}) does not exist \n";
+                    print "         and is not writable by you.\n";
+                    print "         No debug information being saved.\n";
+                    $self->{DEBUG} = 0;
+                }
+            }
+        }
+    }
+
+    $self->{SID} = exists($args{sid}) ? $args{sid} : "__xmlstream__:sid";
+
+    $self->{STYLE} = (exists($args{style}) ? lc($args{style}) : "tree");
+    $self->{DTD} = (exists($args{dtd}) ? lc($args{dtd}) : 0);
+
+    if ($self->{STYLE} eq "tree")
+    {
+        $self->{HANDLER}->{startDocument} = sub{ $self->startDocument(@_); };
+        $self->{HANDLER}->{endDocument} = sub{ $self->endDocument(@_); };
+        $self->{HANDLER}->{startElement} = sub{ &XML::Stream::Tree::_handle_element(@_); };
+        $self->{HANDLER}->{endElement} = sub{ &XML::Stream::Tree::_handle_close(@_); };
+        $self->{HANDLER}->{characters} = sub{ &XML::Stream::Tree::_handle_cdata(@_); };
+    }
+    elsif ($self->{STYLE} eq "node")
+    {
+        $self->{HANDLER}->{startDocument} = sub{ $self->startDocument(@_); };
+        $self->{HANDLER}->{endDocument} = sub{ $self->endDocument(@_); };
+        $self->{HANDLER}->{startElement} = sub{ &XML::Stream::Node::_handle_element(@_); };
+        $self->{HANDLER}->{endElement} = sub{ &XML::Stream::Node::_handle_close(@_); };
+        $self->{HANDLER}->{characters} = sub{ &XML::Stream::Node::_handle_cdata(@_); };
+    }
+    $self->setHandlers(%{$args{handlers}});
+
+    $self->{XMLONHOLD} = "";
+
+    return $self;
+}
+
+
+###########################################################################
+#
+# debug - prints the arguments to the debug log if debug is turned on.
+#
+###########################################################################
+sub debug
+{
+    return if ($_[1] > $_[0]->{DEBUGLEVEL});
+    my $self = shift;
+    my ($limit,@args) = @_;
+    return if ($self->{DEBUGFILE} eq "");
+    my $fh = $self->{DEBUGFILE};
+    if ($self->{DEBUGTIME} == 1)
+    {
+        my ($sec,$min,$hour) = localtime(time);
+        print $fh sprintf("[%02d:%02d:%02d] ",$hour,$min,$sec);
+    }
+    print $fh "XML::Stream::Parser: $self->{STYLE}: @args\n";
+}
+
+
+sub setSID
+{
+    my $self = shift;
+    my $sid = shift;
+    $self->{SID} = $sid;
+}
+
+
+sub getSID
+{
+    my $self = shift;
+    return $self->{SID};
+}
+
+
+sub setHandlers
+{
+    my $self = shift;
+    my (%handlers) = @_;
+
+    foreach my $handler (keys(%handlers))
+    {
+        $self->{HANDLER}->{$handler} = $handlers{$handler};
+    }
+}
+
+
+sub parse
+{
+    my $self = shift;
+    my $xml = shift;
+
+    return unless defined($xml);
+    return if ($xml eq "");
+
+    if ($self->{XMLONHOLD} ne "")
+    {
+        $self->{XML} = $self->{XMLONHOLD};
+        $self->{XMLONHOLD} = "";
+    }
+
+    # XXX change this to not use regex?
+    while($xml =~ s/<\!--.*?-->//gs) {}
+
+    $self->{XML} .= $xml;
+
+    return if ($self->{PARSING} == 1);
+
+    $self->{PARSING} = 1;
+
+    if(!$self->{DOC} == 1)
+    {
+        my $start = index($self->{XML},"<");
+
+        if ((substr($self->{XML},$start,3) eq "<?x") ||
+            (substr($self->{XML},$start,3) eq "<?X"))
+        {
+            my $close = index($self->{XML},"?>");
+            if ($close == -1)
+            {
+                $self->{PARSING} = 0;
+                return;
+            }
+            $self->{XML} = substr($self->{XML},$close+2,length($self->{XML})-$close-2);
+        }
+
+        &{$self->{HANDLER}->{startDocument}}($self);
+        $self->{DOC} = 1;
+    }
+
+    while(1)
+    {
+        if (length($self->{XML}) == 0)
+        {
+            $self->{PARSING} = 0;
+            return $self->returnData(0);
+        }
+        my $eclose = -1;
+        $eclose = index($self->{XML},"</".$self->{CNAME}->[$self->{CURR}].">")
+            if ($#{$self->{CNAME}} > -1);
+
+        if ($eclose == 0)
+        {
+            $self->{XML} = substr($self->{XML},length($self->{CNAME}->[$self->{CURR}])+3,length($self->{XML})-length($self->{CNAME}->[$self->{CURR}])-3);
+
+            $self->{PARSING} = 0 if ($self->{NONBLOCKING} == 1);
+            &{$self->{HANDLER}->{endElement}}($self,$self->{CNAME}->[$self->{CURR}]);
+            $self->{PARSING} = 1 if ($self->{NONBLOCKING} == 1);
+
+            $self->{CURR}--;
+            if ($self->{CURR} == 0)
+            {
+                $self->{DOC} = 0;
+                $self->{PARSING} = 0;
+                &{$self->{HANDLER}->{endDocument}}($self);
+                return $self->returnData(0);
+            }
+            next;
+        }
+
+        my $estart = index($self->{XML},"<");
+        my $cdatastart = index($self->{XML},"<![CDATA[");
+        if (($estart == 0) && ($cdatastart != 0))
+        {
+            my $close = index($self->{XML},">");
+            if ($close == -1)
+            {
+                $self->{PARSING} = 0;
+                return $self->returnData(0);
+            }
+            my $empty = (substr($self->{XML},$close-1,1) eq "/");
+            my $starttag = substr($self->{XML},1,$close-($empty ? 2 : 1));
+            my $nextspace = index($starttag," ");
+            my $attribs;
+            my $name;
+            if ($nextspace != -1)
+            {
+                $name = substr($starttag,0,$nextspace);
+                $attribs = substr($starttag,$nextspace+1,length($starttag)-$nextspace-1);
+            }
+            else
+            {
+                $name = $starttag;
+            }
+
+            my %attribs = $self->attribution($attribs);
+            if (($self->{DTD} == 1) && (exists($attribs{xmlns})))
+            {
+            }
+
+            &{$self->{HANDLER}->{startElement}}($self,$name,%attribs);
+
+            if($empty == 1)
+            {
+                &{$self->{HANDLER}->{endElement}}($self,$name);
+            }
+            else
+            {
+                $self->{CURR}++;
+                $self->{CNAME}->[$self->{CURR}] = $name;
+            }
+    
+            $self->{XML} = substr($self->{XML},$close+1,length($self->{XML})-$close-1);
+            next;
+        }
+
+        if ($cdatastart == 0)
+        {
+            my $cdataclose = index($self->{XML},"]]>");
+            if ($cdataclose == -1)
+            {
+                $self->{PARSING} = 0;
+                return $self->returnData(0);
+            }
+            
+            &{$self->{HANDLER}->{characters}}($self,substr($self->{XML},9,$cdataclose-9));
+            
+            $self->{XML} = substr($self->{XML},$cdataclose+3,length($self->{XML})-$cdataclose-3);
+            next;
+         }
+
+        if ($estart == -1)
+        {
+            $self->{XMLONHOLD} = $self->{XML};
+            $self->{XML} = "";
+        }
+        elsif (($cdatastart == -1) || ($cdatastart > $estart))
+        {
+            &{$self->{HANDLER}->{characters}}($self,$self->entityCheck(substr($self->{XML},0,$estart)));
+            $self->{XML} = substr($self->{XML},$estart,length($self->{XML})-$estart);
+        }
+    }
+}
+
+
+sub attribution
+{
+    my $self = shift;
+    my $str = shift;
+
+    $str = "" unless defined($str);
+
+    my %attribs;
+
+    while(1)
+    {
+        my $eq = index($str,"=");
+        if((length($str) == 0) || ($eq == -1))
+        {
+            return %attribs;
+        }
+
+        my $ids;
+        my $id;
+        my $id1 = index($str,"\'");
+        my $id2 = index($str,"\"");
+
+	return %attribs if ($id1 == -1 && $id2 == -1);
+
+        if((($id1 < $id2) && ($id1 != -1)) || ($id2 == -1))
+        {
+            $ids = $id1;
+            $id = "\'";
+        }
+        if((($id2 < $id1) && ($id2 != -1)) || ($id1 == -1))
+        {
+            $ids = $id2;
+            $id = "\"";
+        }
+
+        my $nextid = index($str,$id,$ids+1);
+        my $val = substr($str,$ids+1,$nextid-$ids-1);
+        my $key = substr($str,0,$eq);
+
+        while($key =~ s/\s//) {}
+
+        $attribs{$key} = $self->entityCheck($val);
+        $str = substr($str,$nextid+1,length($str)-$nextid-1);
+    }
+
+    return %attribs;
+}
+
+
+sub entityCheck
+{
+    my $self = shift;
+    my $str = shift;
+
+    while($str =~ s/\&lt\;/\</) {}
+    while($str =~ s/\&gt\;/\>/) {}
+    while($str =~ s/\&quot\;/\"/) {}
+    while($str =~ s/\&apos\;/\'/) {}
+    while($str =~ s/\&amp\;/\&/) {}
+
+    return $str;
+}
+
+
+sub parsefile
+{
+    my $self = shift;
+    my $fileName = shift;
+
+    open(FILE,"<",$fileName);
+    my $file;
+    while(<FILE>) { $file .= $_; }
+    $self->parse($file);
+    close(FILE);
+
+    return $self->returnData();
+}
+
+
+sub returnData
+{
+    my $self = shift;
+    my $clearData = shift;
+    $clearData = 1 unless defined($clearData);
+
+    my $sid = $self->{SID};
+
+    if ($self->{STYLE} eq "tree")
+    {
+        return unless exists($self->{SIDS}->{$sid}->{tree});
+        my @tree = @{$self->{SIDS}->{$sid}->{tree}};
+        delete($self->{SIDS}->{$sid}->{tree}) if ($clearData == 1);
+        return ( \@tree );
+    }
+    if ($self->{STYLE} eq "node")
+    {
+        return unless exists($self->{SIDS}->{$sid}->{node});
+        my $node = $self->{SIDS}->{$sid}->{node}->[0];
+        delete($self->{SIDS}->{$sid}->{node}) if ($clearData == 1);
+        return $node;
+    }
+}
+
+
+sub startDocument
+{
+    my $self = shift;
+}
+
+
+sub endDocument
+{
+    my $self = shift;
+}
+
+
+sub startElement
+{
+    my $self = shift;
+    my ($sax, $tag, %att) = @_;
+
+    return unless ($self->{DOC} == 1);
+
+    if ($self->{STYLE} eq "debug")
+    {
+        print "$self->{DEBUGHEADER} \\\\ (",join(" ",%att),")\n";
+        $self->{DEBUGHEADER} .= $tag." ";
+    }
+    else
+    {
+        my @NEW;
+        if($#{$self->{TREE}} < 0)
+        {
+            push @{$self->{TREE}}, $tag;
+        }
+        else
+        {
+            push @{ $self->{TREE}[ $#{$self->{TREE}}]}, $tag;
+        }
+        push @NEW, \%att;
+        push @{$self->{TREE}}, \@NEW;
+    }
+}
+
+
+sub characters
+{
+    my $self = shift;
+    my ($sax, $cdata) = @_;
+
+    return unless ($self->{DOC} == 1);
+
+    if ($self->{STYLE} eq "debug") 
+    {
+        my $str = $cdata;
+        $str =~ s/\n/\#10\;/g;
+        print "$self->{DEBUGHEADER} || $str\n";
+    }
+    else
+    {
+        return if ($#{$self->{TREE}} == -1);
+
+        my $pos = $#{$self->{TREE}};
+
+        if ($pos > 0 && $self->{TREE}[$pos - 1] eq "0")
+        {
+            $self->{TREE}[$pos - 1] .= $cdata;
+        }
+        else
+        {
+            push @{$self->{TREE}[$#{$self->{TREE}}]}, 0;
+            push @{$self->{TREE}[$#{$self->{TREE}}]}, $cdata;
+        }  
+    }
+}
+
+
+sub endElement
+{
+    my $self = shift;
+    my ($sax, $tag) = @_;
+
+    return unless ($self->{DOC} == 1);
+
+    if ($self->{STYLE} eq "debug")
+    {
+        $self->{DEBUGHEADER} =~ s/\S+\ $//;
+        print "$self->{DEBUGHEADER} //\n";
+    }
+    else
+    {
+        my $CLOSED = pop @{$self->{TREE}};
+
+        if($#{$self->{TREE}} < 1)
+        {
+            push @{$self->{TREE}}, $CLOSED;
+
+            if($self->{TREE}->[0] eq "stream:error")
+            {
+                $self->{STREAMERROR} = $self->{TREE}[1]->[2];
+            }
+        }
+        else
+        {
+            push @{$self->{TREE}[$#{$self->{TREE}}]}, $CLOSED;
+        }
+    }
+}
+
+
+1;
Index: perl/modules/Jabber/lib/XML/Stream/Parser/DTD.pm
===================================================================
--- perl/modules/Jabber/lib/XML/Stream/Parser/DTD.pm	(revision c2bed5539d456612d69de33e1dacc3afe5f70395)
+++ perl/modules/Jabber/lib/XML/Stream/Parser/DTD.pm	(revision c2bed5539d456612d69de33e1dacc3afe5f70395)
@@ -0,0 +1,769 @@
+##############################################################################
+#
+#  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::Parser::DTD;
+
+=head1 NAME
+
+  XML::Stream::Parser::DTD - XML DTD Parser and Verifier
+
+=head1 SYNOPSIS
+
+  This is a work in progress.  I had need for a DTD parser and verifier
+  and so am working on it here.  If you are reading this then you are
+  snooping.  =)
+
+=head1 DESCRIPTION
+
+  This module provides the initial code for a DTD parser and verifier.
+
+=head1 METHODS
+
+=head1 EXAMPLES
+
+=head1 AUTHOR
+
+By Ryan Eatmon in February of 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 strict;
+use vars qw( $VERSION );
+
+$VERSION = "1.22";
+
+sub new
+{
+    my $self = { };
+
+    bless($self);
+
+    my %args;
+    while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
+
+    $self->{URI} = $args{uri};
+
+    $self->{PARSING} = 0;
+    $self->{DOC} = 0;
+    $self->{XML} = "";
+    $self->{CNAME} = ();
+    $self->{CURR} = 0;
+
+    $self->{ENTITY}->{"&lt;"} = "<";
+    $self->{ENTITY}->{"&gt;"} = ">";
+    $self->{ENTITY}->{"&quot;"} = "\"";
+    $self->{ENTITY}->{"&apos;"} = "'";
+    $self->{ENTITY}->{"&amp;"} = "&";
+
+    $self->{HANDLER}->{startDocument} = sub{ $self->startDocument(@_); };
+    $self->{HANDLER}->{endDocument} = sub{ $self->endDocument(@_); };
+    $self->{HANDLER}->{startElement} = sub{ $self->startElement(@_); };
+    $self->{HANDLER}->{endElement} = sub{ $self->endElement(@_); };
+
+    $self->{STYLE} = "debug";
+
+    open(DTD,$args{uri});
+    my $dtd = join("",<DTD>);
+    close(DTD);
+
+    $self->parse($dtd);
+
+    return $self;
+}
+
+
+sub parse
+{
+    my $self = shift;
+    my $xml = shift;
+
+    while($xml =~ s/<\!--.*?-->//gs) {}
+    while($xml =~ s/\n//g) {}
+
+    $self->{XML} .= $xml;
+
+    return if ($self->{PARSING} == 1);
+
+    $self->{PARSING} = 1;
+
+    if(!$self->{DOC} == 1)
+    {
+        my $start = index($self->{XML},"<");
+
+        if (substr($self->{XML},$start,3) =~ /^<\?x$/i)
+        {
+            my $close = index($self->{XML},"?>");
+            if ($close == -1)
+            {
+                $self->{PARSING} = 0;
+                return;
+            }
+            $self->{XML} = substr($self->{XML},$close+2,length($self->{XML})-$close-2);
+        }
+
+        &{$self->{HANDLER}->{startDocument}}($self);
+        $self->{DOC} = 1;
+    }
+
+    while(1)
+    {
+
+        if (length($self->{XML}) == 0)
+        {
+            $self->{PARSING} = 0;
+            return;
+        }
+
+        my $estart = index($self->{XML},"<");
+        if ($estart == -1)
+        {
+            $self->{PARSING} = 0;
+            return;
+        }
+
+        my $close = index($self->{XML},">");
+        my $dtddata = substr($self->{XML},$estart+1,$close-1);
+        my $nextspace = index($dtddata," ");
+        my $attribs;
+
+        my $type = substr($dtddata,0,$nextspace);
+        $dtddata = substr($dtddata,$nextspace+1,length($dtddata)-$nextspace-1);
+        $nextspace = index($dtddata," ");
+
+        if ($type eq "!ENTITY")
+        {
+            $self->entity($type,$dtddata);
+        }
+        else
+        {
+            my $tag = substr($dtddata,0,$nextspace);
+            $dtddata = substr($dtddata,$nextspace+1,length($dtddata)-$nextspace-1);
+            $nextspace = index($dtddata," ");
+
+            $self->element($type,$tag,$dtddata) if ($type eq "!ELEMENT");
+            $self->attlist($type,$tag,$dtddata) if ($type eq "!ATTLIST");
+        }
+
+        $self->{XML} = substr($self->{XML},$close+1,length($self->{XML})-$close-1);
+        next;
+    }
+}
+
+
+sub startDocument
+{
+    my $self = shift;
+}
+
+
+sub endDocument
+{
+    my $self = shift;
+}
+
+
+sub entity
+{
+    my $self = shift;
+    my ($type, $data) = @_;
+
+    foreach my $entity (keys(%{$self->{ENTITY}}))
+    {
+        $data =~ s/$entity/$self->{ENTITY}->{$entity}/g;
+    }
+
+    my ($symbol,$tag,undef,$string) = ($data =~ /^\s*(\S+)\s+(\S+)\s+(\"|\')([^\3]*)\3\s*$/);
+    $self->{ENTITY}->{"${symbol}${tag}\;"} = $string;
+}
+
+sub element
+{
+    my $self = shift;
+    my ($type, $tag, $data) = @_;
+
+    foreach my $entity (keys(%{$self->{ENTITY}}))
+    {
+        $data =~ s/$entity/$self->{ENTITY}->{$entity}/g;
+    }
+
+    $self->{COUNTER}->{$tag} = 0 unless exists($self->{COUNTER}->{$tag});
+
+    $self->parsegrouping($tag,\$self->{ELEMENT}->{$tag},$data);
+    $self->flattendata(\$self->{ELEMENT}->{$tag});
+
+}
+
+
+sub flattendata
+{
+    my $self = shift;
+    my $dstr = shift;
+
+    if ($$dstr->{type} eq "list")
+    {
+        foreach my $index (0..$#{$$dstr->{list}})
+        {
+            $self->flattendata(\$$dstr->{list}->[$index]);
+        }
+
+        if (!exists($$dstr->{repeat}) && ($#{$$dstr->{list}} == 0))
+        {
+            $$dstr = $$dstr->{list}->[0];
+        }
+    }
+}
+
+sub parsegrouping
+{
+    my $self = shift;
+    my ($tag,$dstr,$data) = @_;
+
+    $data =~ s/^\s*//;
+    $data =~ s/\s*$//;
+
+    if ($data =~ /[\*\+\?]$/)
+    {
+        ($$dstr->{repeat}) = ($data =~ /(.)$/);
+        $data =~ s/.$//;
+    }
+
+    if ($data =~ /^\(.*\)$/)
+    {
+        my ($seperator) = ($data =~ /^\(\s*\S+\s*(\,|\|)/);
+        $$dstr->{ordered} = "yes" if ($seperator eq ",");
+        $$dstr->{ordered} = "no" if ($seperator eq "|");
+
+        my $count = 0;
+        $$dstr->{type} = "list";
+        foreach my $grouping ($self->groupinglist($data,$seperator))
+        {
+            $self->parsegrouping($tag,\$$dstr->{list}->[$count],$grouping);
+            $count++;
+        }
+    }
+    else
+    {
+        $$dstr->{type} = "element";
+        $$dstr->{element} = $data;
+        $self->{COUNTER}->{$data} = 0 unless exists($self->{COUNTER}->{$data});
+        $self->{COUNTER}->{$data}++;
+        $self->{CHILDREN}->{$tag}->{$data} = 1;
+    }
+}
+
+
+sub attlist
+{
+    my $self = shift;
+    my ($type, $tag, $data) = @_;
+
+    foreach my $entity (keys(%{$self->{ENTITY}}))
+    {
+        $data =~ s/$entity/$self->{ENTITY}->{$entity}/g;
+    }
+
+    while($data ne "")
+    {
+        my ($att) = ($data =~ /^\s*(\S+)/);
+        $data =~ s/^\s*\S+\s*//;
+
+        my $value;
+        if ($data =~ /^\(/)
+        {
+            $value = $self->getgrouping($data);
+            $data = substr($data,length($value)+1,length($data));
+            $data =~ s/^\s*//;
+            $self->{ATTLIST}->{$tag}->{$att}->{type} = "list";
+            foreach my $val (split(/\s*\|\s*/,substr($value,1,length($value)-2))) {
+$self->{ATTLIST}->{$tag}->{$att}->{value}->{$val} = 1;
+            }
+        }
+        else
+        {
+            ($value) = ($data =~ /^(\S+)/);
+            $data =~ s/^\S+\s*//;
+            $self->{ATTLIST}->{$tag}->{$att}->{type} = $value;
+        }
+
+        my $default;
+        if ($data =~ /^\"|^\'/)
+        {
+            my($sq,$val) = ($data =~ /^(\"|\')([^\"\']*)\1/);
+            $default = $val;
+            $data =~ s/^$sq$val$sq\s*//;
+        }
+        else
+        {
+            ($default) = ($data =~ /^(\S+)/);
+            $data =~ s/^\S+\s*//;
+        }
+
+        $self->{ATTLIST}->{$tag}->{$att}->{default} = $default;
+    }
+}
+
+
+
+sub getgrouping
+{
+    my $self = shift;
+    my ($data) = @_;
+
+    my $count = 0;
+    my $parens = 0;
+    foreach my $char (split("",$data))
+    {
+        $parens++ if ($char eq "(");
+        $parens-- if ($char eq ")");
+        $count++;
+        last if ($parens == 0);
+    }
+    return substr($data,0,$count);
+}
+
+
+sub groupinglist
+{
+    my $self = shift;
+    my ($grouping,$seperator) = @_;
+
+    my @list;
+    my $item = "";
+    my $parens = 0;
+    my $word = "";
+    $grouping = substr($grouping,1,length($grouping)-2) if ($grouping =~ /^\(/);
+    foreach my $char (split("",$grouping))
+    {
+        $parens++ if ($char eq "(");
+        $parens-- if ($char eq ")");
+        if (($parens == 0) && ($char eq $seperator))
+        {
+            push(@list,$word);
+            $word = "";
+        }
+        else
+        {
+            $word .= $char;
+        }
+    }
+    push(@list,$word) unless ($word eq "");
+    return @list;
+}
+
+
+sub root
+{
+    my $self = shift;
+    my $tag = shift;
+    my @root;
+    foreach my $tag (keys(%{$self->{COUNTER}}))
+    {
+        push(@root,$tag) if ($self->{COUNTER}->{$tag} == 0);
+    }
+
+    print "ERROR:  Too many root tags... Check the DTD...\n"
+        if ($#root > 0);
+    return $root[0];
+}
+
+
+sub children
+{
+    my $self = shift;
+    my ($tag,$tree) = @_;
+
+    return unless exists ($self->{CHILDREN}->{$tag});
+    return if (exists($self->{CHILDREN}->{$tag}->{EMPTY}));
+    if (defined($tree))
+    {
+        my @current;
+        foreach my $current (&XML::Stream::GetXMLData("tree array",$tree,"*","",""))
+        {
+            push(@current,$$current[0]);
+        }
+        return $self->allowedchildren($self->{ELEMENT}->{$tag},\@current);
+    }
+    return $self->allowedchildren($self->{ELEMENT}->{$tag});
+}
+
+
+sub allowedchildren
+{
+    my $self = shift;
+    my ($dstr,$current) = @_;
+
+    my @allowed;
+
+    if ($dstr->{type} eq "element")
+    {
+        my $test = (defined($current) && $#{@{$current}} > -1) ? $$current[0] : "";
+        shift(@{$current}) if ($dstr->{element} eq $test);
+        if ($self->repeatcheck($dstr,$test) == 1)
+        {
+            return $dstr->{element};
+        }
+    }
+    else
+    {
+        foreach my $index (0..$#{$dstr->{list}})
+        {
+            push(@allowed,$self->allowedchildren($dstr->{list}->[$index],$current));
+        }
+    }
+
+    return @allowed;
+}
+
+
+sub repeatcheck
+{
+    my $self = shift;
+    my ($dstr,$tag) = @_;
+
+    $dstr = $self->{ELEMENT}->{$dstr} if exists($self->{ELEMENT}->{$dstr});
+
+#  print "repeatcheck: tag($tag)\n";
+#  print "repeatcheck: repeat($dstr->{repeat})\n"
+#    if exists($dstr->{repeat});
+
+    my $return = 0;
+    $return = ((!defined($tag) ||
+                ($tag eq $dstr->{element})) ?
+               0 :
+               1)
+        if (!exists($dstr->{repeat}) ||
+            ($dstr->{repeat} eq "?"));
+    $return = ((defined($tag) ||
+                (exists($dstr->{ordered}) &&
+                ($dstr->{ordered} eq "yes"))) ?
+               1 :
+               0)
+        if (exists($dstr->{repeat}) &&
+            (($dstr->{repeat} eq "+") ||
+             ($dstr->{repeat} eq "*")));
+
+#  print "repeatcheck: return($return)\n";
+    return $return;
+}
+
+
+sub required
+{
+    my $self = shift;
+    my ($dstr,$tag,$count) = @_;
+
+    $dstr = $self->{ELEMENT}->{$dstr} if exists($self->{ELEMENT}->{$dstr});
+
+    if ($dstr->{type} eq "element")
+    {
+        return 0 if ($dstr->{element} ne $tag);
+        return 1 if !exists($dstr->{repeat});
+        return 1 if (($dstr->{repeat} eq "+") && ($count == 1)) ;
+    }
+    else
+    {
+        return 0 if (($dstr->{repeat} eq "*") || ($dstr->{repeat} eq "?"));
+        my $test = 0;
+        foreach my $index (0..$#{$dstr->{list}})
+        {
+            $test = $test | $self->required($dstr->{list}->[$index],$tag,$count);
+        }
+        return $test;
+    }
+    return 0;
+}
+
+
+sub addchild
+{
+    my $self = shift;
+    my ($tag,$child,$tree) = @_;
+
+#  print "addchild: tag($tag) child($child)\n";
+
+    my @current;
+    if (defined($tree))
+    {
+#    &Net::Jabber::printData("\$tree",$tree);
+
+        @current = &XML::Stream::GetXMLData("index array",$tree,"*","","");
+
+#    &Net::Jabber::printData("\$current",\@current);
+    }
+
+    my @newBranch = $self->addchildrecurse($self->{ELEMENT}->{$tag},$child,\@current);
+
+    return $tree unless ("@newBranch" ne "");
+
+#  &Net::Jabber::printData("\$newBranch",\@newBranch);
+
+    my $location = shift(@newBranch);
+
+    if ($location eq "end")
+    {
+        splice(@{$$tree[1]},@{$$tree[1]},0,@newBranch);
+    }
+    else
+    {
+        splice(@{$$tree[1]},$location,0,@newBranch);
+    }
+    return $tree;
+}
+
+
+sub addcdata
+{
+    my $self = shift;
+    my ($tag,$child,$tree) = @_;
+
+#  print "addchild: tag($tag) child($child)\n";
+
+    my @current;
+    if (defined($tree))
+    {
+#    &Net::Jabber::printData("\$tree",$tree);
+
+        @current = &XML::Stream::GetXMLData("index array",$tree,"*","","");
+
+#    &Net::Jabber::printData("\$current",\@current);
+    }
+
+    my @newBranch = $self->addchildrecurse($self->{ELEMENT}->{$tag},$child,\@current);
+
+    return $tree unless ("@newBranch" ne "");
+
+#  &Net::Jabber::printData("\$newBranch",\@newBranch);
+
+    my $location = shift(@newBranch);
+
+    if ($location eq "end")
+    {
+        splice(@{$$tree[1]},@{$$tree[1]},0,@newBranch);
+    }
+    else
+    {
+        splice(@{$$tree[1]},$location,0,@newBranch);
+    }
+    return $tree;
+}
+
+
+sub addchildrecurse
+{
+    my $self = shift;
+    my ($dstr,$child,$current) = @_;
+
+#  print "addchildrecurse: child($child) type($dstr->{type})\n";
+
+    if ($dstr->{type} eq "element")
+    {
+#    print "addchildrecurse: tag($dstr->{element})\n";
+        my $count = 0;
+        while(($#{@{$current}} > -1) && ($dstr->{element} eq $$current[0]))
+        {
+            shift(@{$current});
+            shift(@{$current});
+            $count++;
+        }
+        if (($dstr->{element} eq $child) &&
+            ($self->repeatcheck($dstr,(($count > 0) ? $child : "")) == 1))
+        {
+            my @return = ( "end" , $self->newbranch($child));
+            @return = ($$current[1], $self->newbranch($child))
+                if ($#{@{$current}} > -1);
+#      print "addchildrecurse: Found the spot! (",join(",",@return),")\n";
+
+            return @return;
+        }
+    }
+    else
+    {
+        foreach my $index (0..$#{$dstr->{list}})
+        {
+            my @newBranch = $self->addchildrecurse($dstr->{list}->[$index],$child,$current);
+            return @newBranch if ("@newBranch" ne "");
+        }
+    }
+#  print "Let's blow....\n";
+    return;
+}
+
+
+sub deletechild
+{
+    my $self = shift;
+    my ($tag,$parent,$parenttree,$tree) = @_;
+
+    return $tree unless exists($self->{ELEMENT}->{$tag});
+    return $tree if $self->required($parent,$tag,&XML::Stream::GetXMLData("count",$parenttree,$tag));
+
+    return [];
+}
+
+
+
+sub newbranch
+{
+    my $self = shift;
+    my $tag = shift;
+
+    $tag = $self->root() unless defined($tag);
+
+    my @tree = ();
+
+    return ("0","") if ($tag eq "#PCDATA");
+
+    push(@tree,$tag);
+    push(@tree,[ {} ]);
+
+    foreach my $att ($self->attribs($tag))
+    {
+        $tree[1]->[0]->{$att} = ""
+            if (($self->{ATTLIST}->{$tag}->{$att}->{default} eq "#REQUIRED") &&
+                ($self->{ATTLIST}->{$tag}->{$att}->{type} eq "CDATA"));
+    }
+
+    push(@{$tree[1]},$self->recursebranch($self->{ELEMENT}->{$tag}));
+    return @tree;
+}
+
+
+sub recursebranch
+{
+    my $self = shift;
+    my $dstr = shift;
+
+    my @tree;
+    if (($dstr->{type} eq "element") &&
+        ($dstr->{element} ne "EMPTY"))
+    {
+        @tree = $self->newbranch($dstr->{element})
+            if (!exists($dstr->{repeat}) ||
+                ($dstr->{repeat} eq "+"));
+    }
+    else
+    {
+        foreach my $index (0..$#{$dstr->{list}})
+        {
+            push(@tree,$self->recursebranch($dstr->{list}->[$index]))
+if (!exists($dstr->{repeat}) ||
+        ($dstr->{repeat} eq "+"));
+        }
+    }
+    return @tree;
+}
+
+
+sub attribs
+{
+    my $self = shift;
+    my ($tag,$tree) = @_;
+
+    return unless exists ($self->{ATTLIST}->{$tag});
+
+    if (defined($tree))
+    {
+        my %current = &XML::Stream::GetXMLData("attribs",$tree,"","","");
+        return $self->allowedattribs($tag,\%current);
+    }
+    return $self->allowedattribs($tag);
+}
+
+
+sub allowedattribs
+{
+    my $self = shift;
+    my ($tag,$current) = @_;
+
+    my %allowed;
+    foreach my $att (keys(%{$self->{ATTLIST}->{$tag}}))
+    {
+        $allowed{$att} = 1 unless (defined($current) &&
+                                   exists($current->{$att}));
+    }
+    return sort {$a cmp $b} keys(%allowed);
+}
+
+
+sub attribvalue
+{
+    my $self = shift;
+    my $tag = shift;
+    my $att = shift;
+
+    return $self->{ATTLIST}->{$tag}->{$att}->{type}
+        if ($self->{ATTLIST}->{$tag}->{$att}->{type} ne "list");
+    return sort {$a cmp $b} keys(%{$self->{ATTLIST}->{$tag}->{$att}->{value}});
+}
+
+
+sub addattrib
+{
+    my $self = shift;
+    my ($tag,$att,$tree) = @_;
+
+    return $tree unless exists($self->{ATTLIST}->{$tag});
+    return $tree unless exists($self->{ATTLIST}->{$tag}->{$att});
+
+    my $default = $self->{ATTLIST}->{$tag}->{$att}->{default};
+    $default = "" if ($default eq "#REQUIRED");
+    $default = "" if ($default eq "#IMPLIED");
+
+    $$tree[1]->[0]->{$att} = $default;
+
+    return $tree;
+}
+
+
+sub attribrequired
+{
+    my $self = shift;
+    my ($tag,$att) = @_;
+
+    return 0 unless exists($self->{ATTLIST}->{$tag});
+    return 0 unless exists($self->{ATTLIST}->{$tag}->{$att});
+
+    return 1 if ($self->{ATTLIST}->{$tag}->{$att}->{default} eq "#REQUIRED");
+    return 0;
+}
+
+
+sub deleteattrib
+{
+    my $self = shift;
+    my ($tag,$att,$tree) = @_;
+
+    return $tree unless exists($self->{ATTLIST}->{$tag});
+    return $tree unless exists($self->{ATTLIST}->{$tag}->{$att});
+
+    return if $self->attribrequired($tag,$att);
+
+    delete($$tree[1]->[0]->{$att});
+
+    return $tree;
+}
+
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;
Index: perl/modules/Jabber/lib/XML/Stream/XPath.pm
===================================================================
--- perl/modules/Jabber/lib/XML/Stream/XPath.pm	(revision c2bed5539d456612d69de33e1dacc3afe5f70395)
+++ perl/modules/Jabber/lib/XML/Stream/XPath.pm	(revision c2bed5539d456612d69de33e1dacc3afe5f70395)
@@ -0,0 +1,50 @@
+##############################################################################
+#
+#  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::XPath;
+
+use 5.006_001;
+use strict;
+use vars qw( $VERSION %FUNCTIONS );
+
+$VERSION = "1.22";
+
+use XML::Stream::XPath::Value;
+use XML::Stream::XPath::Op;
+use XML::Stream::XPath::Query;
+
+sub AddFunction
+{
+    my $function = shift;
+    my $code = shift;
+    if (!defined($code))
+    {
+        delete($FUNCTIONS{$code});
+        return;
+    }
+
+    $FUNCTIONS{$function} = $code;
+}
+
+
+1;
+
Index: perl/modules/Jabber/lib/XML/Stream/XPath/Op.pm
===================================================================
--- perl/modules/Jabber/lib/XML/Stream/XPath/Op.pm	(revision c2bed5539d456612d69de33e1dacc3afe5f70395)
+++ perl/modules/Jabber/lib/XML/Stream/XPath/Op.pm	(revision c2bed5539d456612d69de33e1dacc3afe5f70395)
@@ -0,0 +1,919 @@
+##############################################################################
+#
+#  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/
+#
+##############################################################################
+
+
+##############################################################################
+#
+# Op - Base Op class
+#
+##############################################################################
+package XML::Stream::XPath::Op;
+
+use 5.006_001;
+use strict;
+use vars qw( $VERSION );
+
+$VERSION = "1.22";
+
+sub new
+{
+    my $proto = shift;
+    return &allocate($proto,@_);
+}
+
+sub allocate
+{
+    my $proto = shift;
+    my $self = { };
+
+    bless($self,$proto);
+
+    $self->{TYPE} = shift;
+    $self->{VALUE} = shift;
+    
+    return $self;
+}
+
+sub getValue
+{
+    my $self = shift;
+    return $self->{VALUE};
+}
+
+sub calcStr
+{
+    my $self = shift;
+    return $self->{VALUE};
+}
+
+sub getType
+{
+    my $self = shift;
+    return $self->{TYPE};
+}
+
+
+sub isValid
+{
+    my $self = shift;
+    my $ctxt = shift;
+    return 1;
+}
+
+sub display
+{
+    my $self = shift;
+    my $space = shift;
+    $space = "" unless defined($space);
+
+    print $space,"OP: type($self->{TYPE}) value($self->{VALUE})\n";
+}
+
+
+
+##############################################################################
+#
+# PositionOp - class to handle [0] ops
+#
+##############################################################################
+package XML::Stream::XPath::PositionOp;
+
+use vars qw (@ISA);
+@ISA = ( "XML::Stream::XPath::Op" );
+
+sub new
+{
+    my $proto = shift;
+    my $self = $proto->allocate("POSITION","");
+    $self->{POS} = shift;
+
+    return $self;
+}
+
+
+sub isValid
+{
+    my $self = shift;
+    my $ctxt = shift;
+
+    my @elems = $$ctxt->getList();
+    my @valid_elems;
+    if ($#elems+1 < $self->{POS})
+    {
+        return;
+    }
+
+    push(@valid_elems, $elems[$self->{POS}-1]);
+
+    $$ctxt->setList(@valid_elems);
+
+    return 1;
+}
+
+
+
+##############################################################################
+#
+# ContextOp - class to handle [...] ops
+#
+##############################################################################
+package XML::Stream::XPath::ContextOp;
+
+use vars qw (@ISA);
+@ISA = ( "XML::Stream::XPath::Op" );
+
+sub new
+{
+    my $proto = shift;
+    my $self = $proto->allocate("CONTEXT","");
+    $self->{OP} = shift;
+    return $self;
+}
+
+
+sub isValid
+{
+    my $self = shift;
+    my $ctxt = shift;
+
+    my @elems = $$ctxt->getList();
+    my @valid_elems;
+    foreach my $elem (@elems)
+    {
+        my $tmp_ctxt = new XML::Stream::XPath::Value($elem);
+        $tmp_ctxt->in_context(1);
+        if ($self->{OP}->isValid(\$tmp_ctxt))
+        {
+            push(@valid_elems,$elem);
+        }   
+    }
+
+    $$ctxt->setList(@valid_elems);
+    
+    if ($#valid_elems == -1)
+    {
+        return;
+    }
+
+    return 1;
+}
+
+
+sub display
+{
+    my $self = shift;
+    my $space = shift;
+    $space = "" unless defined($space);
+
+    print "${space}OP: type(CONTEXT) op: \n";
+    $self->{OP}->display("$space    ");
+}
+
+
+
+
+##############################################################################
+#
+# AllOp - class to handle // ops
+#
+##############################################################################
+package XML::Stream::XPath::AllOp;
+
+use vars qw (@ISA);
+@ISA = ( "XML::Stream::XPath::Op" );
+
+sub new
+{
+    my $proto = shift;
+    my $name = shift;
+    my $self = $proto->allocate("ALL",$name);
+    return $self;
+}
+
+
+sub isValid
+{
+    my $self = shift;
+    my $ctxt = shift;
+
+    my @elems = $$ctxt->getList();
+
+    if ($#elems == -1)
+    {
+        return;
+    }
+
+    my @valid_elems;
+    
+    foreach my $elem (@elems)
+    {
+        push(@valid_elems,$self->descend($elem));
+    }
+    
+    $$ctxt->setList(@valid_elems);
+
+    if ($#valid_elems == -1)
+    {
+        return;
+    }
+
+    return 1;
+}
+
+
+sub descend
+{
+    my $self = shift;
+    my $elem = shift;
+
+    my @valid_elems;
+    
+    if (($self->{VALUE} eq "*") || (&XML::Stream::GetXMLData("tag",$elem) eq $self->{VALUE}))
+    {
+        push(@valid_elems,$elem);
+    }
+    
+    foreach my $child (&XML::Stream::GetXMLData("child array",$elem,"*"))
+    {
+        push(@valid_elems,$self->descend($child));
+    }
+    
+    return @valid_elems;
+}
+
+
+
+##############################################################################
+#
+# NodeOp - class to handle ops based on node names
+#
+##############################################################################
+package XML::Stream::XPath::NodeOp;
+
+use vars qw (@ISA);
+@ISA = ( "XML::Stream::XPath::Op" );
+
+sub new
+{
+    my $proto = shift;
+    my $name = shift;
+    my $is_root = shift;
+    $is_root = 0 unless defined($is_root);
+    my $self = $proto->allocate("NODE",$name);
+    $self->{ISROOT} = $is_root;
+    return $self;
+}
+
+
+sub isValid
+{
+    my $self = shift;
+    my $ctxt = shift;
+
+    if ($self->{ISROOT})
+    {
+        my $elem = $$ctxt->getFirstElem();
+        if (&XML::Stream::GetXMLData("tag",$elem) ne $self->{VALUE})
+        {
+            return;
+        }
+        return 1;
+    }
+
+    my @valid_elems;
+
+    foreach my $elem ($$ctxt->getList())
+    {
+        my $valid = 0;
+
+        foreach my $child (&XML::Stream::GetXMLData("child array",$elem,"*"))
+        {
+            if (($self->{VALUE} eq "*") ||
+                (&XML::Stream::GetXMLData("tag",$child) eq $self->{VALUE}))
+            {
+                if ($$ctxt->in_context())
+                {
+                    $valid = 1;
+                }
+                else
+                {
+                    push(@valid_elems,$child);
+                }
+            }
+        }
+        if ($valid)
+        {
+            push(@valid_elems,$elem);
+        }
+    }
+    
+    $$ctxt->setList(@valid_elems);
+
+    if ($#valid_elems == -1)
+    {
+        return;
+    }
+
+    return 1;
+}
+
+
+sub calcStr
+{
+    my $self = shift;
+    my $elem = shift;
+    return &XML::Stream::GetXMLData("value",$elem);
+} 
+
+
+##############################################################################
+#
+# EqualOp - class to handle [ x = y ] ops
+#
+##############################################################################
+package XML::Stream::XPath::EqualOp;
+
+use vars qw (@ISA);
+@ISA = ( "XML::Stream::XPath::Op" );
+
+sub new
+{
+    my $proto = shift;
+    my $self = $proto->allocate("EQUAL","");
+    $self->{OP_L} = shift;
+    $self->{OP_R} = shift;
+    return $self;
+}
+
+
+sub isValid
+{
+    my $self = shift;
+    my $ctxt = shift;
+
+    my $tmp_ctxt = new XML::Stream::XPath::Value();
+    $tmp_ctxt->setList($$ctxt->getList());
+    $tmp_ctxt->in_context(0);
+    
+    if (!$self->{OP_L}->isValid(\$tmp_ctxt) || !$self->{OP_R}->isValid(\$tmp_ctxt))
+    {
+        return;
+    }
+
+    my @valid_elems;
+    foreach my $elem ($tmp_ctxt->getList)
+    {
+        if ($self->{OP_L}->calcStr($elem) eq $self->{OP_R}->calcStr($elem))
+        {
+            push(@valid_elems,$elem);
+        }
+    }
+
+    if ( $#valid_elems > -1)
+    {
+        @valid_elems = $$ctxt->getList();
+    }
+    
+    $$ctxt->setList(@valid_elems);
+
+    if ($#valid_elems == -1)
+    {
+        return;
+    }
+
+    return 1;
+}
+
+
+sub display
+{
+    my $self = shift;
+    my $space = shift;
+    $space = "" unless defined($space);
+
+    print $space,"OP: type(EQUAL)\n";
+    print $space,"    op_l: ";
+    $self->{OP_L}->display($space."    ");
+    
+    print $space,"    op_r: ";
+    $self->{OP_R}->display($space."    ");
+}
+
+
+
+##############################################################################
+#
+# NotEqualOp - class to handle [ x != y ] ops
+#
+##############################################################################
+package XML::Stream::XPath::NotEqualOp;
+
+use vars qw (@ISA);
+@ISA = ( "XML::Stream::XPath::Op" );
+
+sub new
+{
+    my $proto = shift;
+    my $self = $proto->allocate("NOTEQUAL","");
+    $self->{OP_L} = shift;
+    $self->{OP_R} = shift;
+    return $self;
+}
+
+
+sub isValid
+{
+    my $self = shift;
+    my $ctxt = shift;
+
+    my $tmp_ctxt = new XML::Stream::XPath::Value();
+    $tmp_ctxt->setList($$ctxt->getList());
+    $tmp_ctxt->in_context(0);
+    
+    if (!$self->{OP_L}->isValid(\$tmp_ctxt) || !$self->{OP_R}->isValid(\$tmp_ctxt))
+    {
+        return;
+    }
+
+    my @valid_elems;
+    foreach my $elem ($tmp_ctxt->getList)
+    {
+        if ($self->{OP_L}->calcStr($elem) ne $self->{OP_R}->calcStr($elem))
+        {
+            push(@valid_elems,$elem);
+        }
+    }
+
+    if ( $#valid_elems > -1)
+    {
+        @valid_elems = $$ctxt->getList();
+    }
+    
+    $$ctxt->setList(@valid_elems);
+
+    if ($#valid_elems == -1)
+    {
+        return;
+    }
+
+    return 1;
+}
+
+
+sub display
+{
+    my $self = shift;
+    my $space = shift;
+    $space = "" unless defined($space);
+
+    print $space,"OP: type(NOTEQUAL)\n";
+    print $space,"    op_l: ";
+    $self->{OP_L}->display($space."    ");
+    
+    print $space,"    op_r: ";
+    $self->{OP_R}->display($space."    ");
+}
+
+
+
+##############################################################################
+#
+# AttributeOp - class to handle @foo ops.
+#
+##############################################################################
+package XML::Stream::XPath::AttributeOp;
+
+use vars qw (@ISA);
+@ISA = ( "XML::Stream::XPath::Op" );
+
+sub new
+{
+    my $proto = shift;
+    my $name = shift;
+    my $self = $proto->allocate("ATTRIBUTE",$name);
+    return $self;
+}
+
+
+sub isValid
+{
+    my $self = shift;
+    my $ctxt = shift;
+
+    my @elems = $$ctxt->getList();
+    my @valid_elems;
+    my @values;
+    my %attribs;
+    
+    foreach my $elem (@elems)
+    {
+        if ($self->{VALUE} ne "*")
+        {
+            if (&XML::Stream::GetXMLData("value",$elem,"",$self->{VALUE}))
+            {
+                $self->{VAL} = $self->calcStr($elem);
+                push(@valid_elems,$elem);
+                push(@values,$self->{VAL});
+            }
+        }
+        else
+        {
+            my %attrib = &XML::Stream::GetXMLData("attribs",$elem);
+            if (scalar(keys(%attrib)) > 0)
+            {
+                push(@valid_elems,$elem);
+                foreach my $key (keys(%attrib))
+                {
+                    $attribs{$key} = $attrib{$key};
+                }
+            }
+        }
+    }
+
+    $$ctxt->setList(@valid_elems);
+    $$ctxt->setValues(@values);
+    $$ctxt->setAttribs(%attribs);
+
+    if ($#valid_elems == -1)
+    {
+        return;
+    }
+    
+    return 1;
+}
+
+
+sub getValue
+{
+    my $self = shift;
+    return $self->{VAL};
+}
+
+
+sub calcStr
+{
+    my $self = shift;
+    my $elem = shift;
+    return &XML::Stream::GetXMLData("value",$elem,"",$self->{VALUE});
+}
+
+
+
+
+##############################################################################
+#
+# AndOp - class to handle [ .... and .... ] ops
+#
+##############################################################################
+package XML::Stream::XPath::AndOp;
+
+use vars qw (@ISA);
+@ISA = ( "XML::Stream::XPath::Op" );
+
+sub new
+{
+    my $proto = shift;
+    my $self = $proto->allocate("AND","and");
+    $self->{OP_L} = shift;
+    $self->{OP_R} = shift;
+    return $self;
+}
+
+
+sub isValid
+{
+    my $self = shift;
+    my $ctxt = shift;
+
+    my $opl = $self->{OP_L}->isValid($ctxt);
+    my $opr = $self->{OP_R}->isValid($ctxt);
+    
+    if ($opl && $opr)
+    {
+        return 1;
+    }
+    else
+    {
+        return;
+    }
+}
+
+
+sub display
+{
+    my $self = shift;
+    my $space = shift;
+    $space = "" unless defined($space);
+
+    print $space,"OP: type(AND)\n";
+    print $space,"  op_l: \n";
+    $self->{OP_L}->display($space."    ");
+    
+    print $space,"  op_r: \n";
+    $self->{OP_R}->display($space."    ");
+}
+
+
+
+##############################################################################
+#
+# OrOp - class to handle [ .... or .... ] ops
+#
+##############################################################################
+package XML::Stream::XPath::OrOp;
+
+use vars qw (@ISA);
+@ISA = ( "XML::Stream::XPath::Op" );
+
+sub new
+{
+    my $proto = shift;
+    my $self = $proto->allocate("OR","or");
+    $self->{OP_L} = shift;
+    $self->{OP_R} = shift;
+    return $self;
+}
+
+
+sub isValid
+{
+    my $self = shift;
+    my $ctxt = shift;
+
+    my @elems = $$ctxt->getList();
+    my @valid_elems;
+
+    foreach my $elem (@elems)
+    {
+        my $tmp_ctxt_l = new XML::Stream::XPath::Value($elem);
+        $tmp_ctxt_l->in_context(1);
+        my $tmp_ctxt_r = new XML::Stream::XPath::Value($elem);
+        $tmp_ctxt_r->in_context(1);
+
+        my $opl = $self->{OP_L}->isValid(\$tmp_ctxt_l);
+        my $opr = $self->{OP_R}->isValid(\$tmp_ctxt_r);
+    
+        if ($opl || $opr)
+        {
+            push(@valid_elems,$elem);
+        }   
+    }
+
+    $$ctxt->setList(@valid_elems);
+    
+    if ($#valid_elems == -1)
+    {
+        return;
+    }
+
+    return 1;
+}
+
+
+sub display
+{
+    my $self = shift;
+    my $space = shift;
+    $space = "" unless defined($space);
+
+    print "${space}OP: type(OR)\n";
+    print "$space    op_l: ";
+    $self->{OP_L}->display("$space    ");
+    
+    print "$space    op_r: ";
+    $self->{OP_R}->display("$space    ");
+}
+
+
+
+##############################################################################
+#
+# FunctionOp - class to handle xxxx(...) ops
+#
+##############################################################################
+package XML::Stream::XPath::FunctionOp;
+
+use vars qw (@ISA);
+@ISA = ( "XML::Stream::XPath::Op" );
+
+sub new
+{
+    my $proto = shift;
+    my $function = shift;
+    my $self = $proto->allocate("FUNCTION",$function);
+    $self->{CLOSED} = 0;
+    return $self;
+}
+
+
+sub addArg
+{
+    my $self = shift;
+    my $arg = shift;
+
+    push(@{$self->{ARGOPS}},$arg);
+}
+
+
+sub isValid
+{
+    my $self = shift;
+    my $ctxt = shift;
+
+    my $result;
+    eval("\$result = &{\$XML::Stream::XPath::FUNCTIONS{\$self->{VALUE}}}(\$ctxt,\@{\$self->{ARGOPS}});");
+    return $result;
+}
+
+
+sub calcStr
+{
+    my $self = shift;
+    my $elem = shift;
+    
+    my $result;
+    eval("\$result = &{\$XML::Stream::XPath::VALUES{\$self->{VALUE}}}(\$elem);");
+    return $result;
+
+}
+
+
+sub display
+{
+    my $self = shift;
+    my $space = shift;
+    $space = "" unless defined($space);
+
+    print $space,"OP: type(FUNCTION)\n";
+    print $space,"    $self->{VALUE}(\n";
+    foreach my $arg (@{$self->{ARGOPS}})
+    {
+        print $arg,"\n";
+        $arg->display($space."        ");
+    }
+    print "$space    )\n";
+}
+
+
+sub function_name
+{
+    my $ctxt = shift;
+    my (@args) = @_;
+
+    my @elems = $$ctxt->getList();
+    my @valid_elems;
+    my @valid_values;
+    foreach my $elem (@elems)
+    {
+        my $text = &value_name($elem);
+        if (defined($text))
+        {
+            push(@valid_elems,$elem);
+            push(@valid_values,$text);
+        }   
+    }
+
+    $$ctxt->setList(@valid_elems);
+    $$ctxt->setValues(@valid_values);
+    
+    if ($#valid_elems == -1)
+    {
+        return;
+    }
+
+    return 1;
+}
+
+
+sub function_not
+{
+    my $ctxt = shift;
+    my (@args) = @_;
+
+    my @elems = $$ctxt->getList();
+    my @valid_elems;
+    foreach my $elem (@elems)
+    {
+        my $tmp_ctxt = new XML::Stream::XPath::Value($elem);
+        $tmp_ctxt->in_context(1);
+        if (!($args[0]->isValid(\$tmp_ctxt)))
+        {
+            push(@valid_elems,$elem);
+        }   
+    }
+
+    $$ctxt->setList(@valid_elems);
+    
+    if ($#valid_elems == -1)
+    {
+        return;
+    }
+
+    return 1;
+}
+
+
+sub function_text
+{
+    my $ctxt = shift;
+    my (@args) = @_;
+
+    my @elems = $$ctxt->getList();
+    my @valid_elems;
+    my @valid_values;
+    foreach my $elem (@elems)
+    {
+        my $text = &value_text($elem);
+        if (defined($text))
+        {
+            push(@valid_elems,$elem);
+            push(@valid_values,$text);
+        }   
+    }
+
+    $$ctxt->setList(@valid_elems);
+    $$ctxt->setValues(@valid_values);
+    
+    if ($#valid_elems == -1)
+    {
+        return;
+    }
+
+    return 1;
+}
+
+
+sub function_startswith
+{
+    my $ctxt = shift;
+    my (@args) = @_;
+
+    my @elems = $$ctxt->getList();
+    my @valid_elems;
+    foreach my $elem (@elems)
+    {
+        my $val1 = $args[0]->calcStr($elem);
+        my $val2 = $args[1]->calcStr($elem);
+
+        if (substr($val1,0,length($val2)) eq $val2)
+        {
+            push(@valid_elems,$elem);
+        }   
+    }
+
+    $$ctxt->setList(@valid_elems);
+    
+    if ($#valid_elems == -1)
+    {
+        return;
+    }
+
+    return 1;
+}
+
+
+sub value_name
+{
+    my $elem = shift;
+    return &XML::Stream::GetXMLData("tag",$elem);
+}
+
+
+sub value_text
+{
+    my $elem = shift;
+    return &XML::Stream::GetXMLData("value",$elem);
+}
+
+
+
+$XML::Stream::XPath::FUNCTIONS{'name'} = \&function_name;
+$XML::Stream::XPath::FUNCTIONS{'not'} = \&function_not;
+$XML::Stream::XPath::FUNCTIONS{'text'} = \&function_text;
+$XML::Stream::XPath::FUNCTIONS{'starts-with'} = \&function_startswith;
+
+$XML::Stream::XPath::VALUES{'name'} = \&value_name;
+$XML::Stream::XPath::VALUES{'text'} = \&value_text;
+
+1;
+
+
Index: perl/modules/Jabber/lib/XML/Stream/XPath/Query.pm
===================================================================
--- perl/modules/Jabber/lib/XML/Stream/XPath/Query.pm	(revision c2bed5539d456612d69de33e1dacc3afe5f70395)
+++ perl/modules/Jabber/lib/XML/Stream/XPath/Query.pm	(revision c2bed5539d456612d69de33e1dacc3afe5f70395)
@@ -0,0 +1,374 @@
+##############################################################################
+#
+#  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::XPath::Query;
+
+use 5.006_001;
+use strict;
+use Carp;
+use vars qw( $VERSION );
+
+$VERSION = "1.22";
+
+sub new
+{
+    my $proto = shift;
+    my $self = { };
+
+    bless($self,$proto);
+
+    $self->{TOKENS} = [ '/','[',']','@','"',"'",'=','!','(',')',':',' ',',']; 
+    $self->{QUERY} = shift;
+    
+    if (!defined($self->{QUERY}) || ($self->{QUERY} eq ""))
+    {
+        confess("No query string specified");
+    }
+    
+    $self->parseQuery();
+    
+    return $self;
+}
+
+
+sub getNextToken
+{ 
+    my $self = shift;
+    my $pos = shift;
+
+    my @toks = grep{ $_ eq substr($self->{QUERY},$$pos,1)} @{$self->{TOKENS}};
+    while( $#toks == -1 )
+    {
+        $$pos++;
+        if ($$pos > length($self->{QUERY}))
+        {
+            $$pos = length($self->{QUERY});
+            return 0;
+        }
+        @toks = grep{ $_ eq substr($self->{QUERY},$$pos,1)} @{$self->{TOKENS}};
+    }
+
+    return $toks[0];
+}
+
+
+sub getNextIdentifier
+{
+    my $self = shift;
+    my $pos = shift;
+    my $sp = $$pos;
+    $self->getNextToken($pos);
+    return substr($self->{QUERY},$sp,$$pos-$sp);
+}
+
+
+sub getOp
+{
+    my $self = shift;
+    my $pos = shift;
+    my $in_context = shift;
+    $in_context = 0 unless defined($in_context);
+
+    my $ret_op;
+
+    my $loop = 1;
+    while( $loop )
+    {
+        my $pos_start = $$pos;
+
+        my $token = $self->getNextToken($pos);
+        if (($token eq "0") && $in_context)
+        {
+            return;
+        }
+
+        my $token_start = ++$$pos;
+        my $ident;
+     
+        if (defined($token))
+        {
+
+            if ($pos_start != ($token_start-1))
+            {
+                $$pos = $pos_start;
+                my $temp_ident = $self->getNextIdentifier($pos);
+                $ret_op = new XML::Stream::XPath::NodeOp($temp_ident,"0");
+            }
+            elsif ($token eq "/")
+            {
+                if (substr($self->{QUERY},$token_start,1) eq "/")
+                {
+                    $$pos++;
+                    my $temp_ident = $self->getNextIdentifier($pos);
+                    $ret_op = new XML::Stream::XPath::AllOp($temp_ident);
+                }
+                else
+                {
+                    my $temp_ident = $self->getNextIdentifier($pos);
+                    if ($temp_ident ne "")
+                    {
+                        $ret_op = new XML::Stream::XPath::NodeOp($temp_ident,($pos_start == 0 ? "1" : "0"));
+                    }
+                }
+            }
+            elsif ($token eq "\@")
+            {
+                $ret_op = new XML::Stream::XPath::AttributeOp($self->getNextIdentifier($pos));
+            }
+            elsif ($token eq "]")
+            {
+                if ($in_context eq "[")
+                {
+                    $ret_op = pop(@{$self->{OPS}});
+                    $in_context = 0;
+                }
+                else
+                {
+                    confess("Found ']' but not in context");
+                    return;
+                }
+            }
+            elsif (($token eq "\"") || ($token eq "\'"))
+            {
+                $$pos = index($self->{QUERY},$token,$token_start);
+                $ret_op = new XML::Stream::XPath::Op("LITERAL",substr($self->{QUERY},$token_start,$$pos-$token_start));
+                $$pos++;
+            }
+            elsif ($token eq " ")
+            {
+                $ident = $self->getNextIdentifier($pos);
+                if ($ident eq "and")
+                {
+                    $$pos++;
+                    my $tmp_op = $self->getOp($pos,$in_context);
+                    if (!defined($tmp_op))
+                    {
+                        confess("Invalid 'and' operation");
+                        return;
+                    }
+                    $ret_op = new XML::Stream::XPath::AndOp($self->{OPS}->[$#{$self->{OPS}}],$tmp_op);
+                    $in_context = 0;
+                    pop(@{$self->{OPS}});
+                }
+                elsif ($ident eq "or")
+                {
+                    $$pos++;
+                    my $tmp_op = $self->getOp($pos,$in_context);
+                    if (!defined($tmp_op))
+                    {
+                        confess("Invalid 'or' operation");
+                        return;
+                    }
+                    $ret_op = new XML::Stream::XPath::OrOp($self->{OPS}->[$#{$self->{OPS}}],$tmp_op);
+                    $in_context = 0;
+                    pop(@{$self->{OPS}});
+                }
+            }
+            elsif ($token eq "[")
+            {
+                if ($self->getNextToken($pos) eq "]")
+                {
+                    if ($$pos == $token_start)
+                    {
+                        confess("Nothing in the []");
+                        return;
+                    }
+                    
+                    $$pos = $token_start;
+                    my $val = $self->getNextIdentifier($pos);
+                    if ($val =~ /^\d+$/)
+                    {
+                        $ret_op = new XML::Stream::XPath::PositionOp($val);
+                        $$pos++;
+                    }
+                    else
+                    {
+                        $$pos = $pos_start + 1;
+                        $ret_op = new XML::Stream::XPath::ContextOp($self->getOp($pos,$token));
+                    }
+                }
+                else
+                {
+                    $$pos = $pos_start + 1;
+                    $ret_op = new XML::Stream::XPath::ContextOp($self->getOp($pos,$token));
+                }
+            }
+            elsif ($token eq "(")
+            {
+                #-------------------------------------------------------------
+                # The function name would have been mistaken for a NodeOp.
+                # Pop it off the back and get the function name.
+                #-------------------------------------------------------------
+                my $op = pop(@{$self->{OPS}});
+                if ($op->getType() ne "NODE")
+                {
+                    confess("No function name specified.");
+                }
+                my $function = $op->getValue();
+                if (!exists($XML::Stream::XPath::FUNCTIONS{$function}))
+                {
+                    confess("Undefined function \"$function\"");
+                }
+                $ret_op = new XML::Stream::XPath::FunctionOp($function);
+
+                my $op_pos = $#{$self->{OPS}} + 1;
+
+                $self->getOp($pos,$token);
+                
+                foreach my $arg ($op_pos..$#{$self->{OPS}})
+                {
+                    $ret_op->addArg($self->{OPS}->[$arg]);
+                }
+
+                splice(@{$self->{OPS}},$op_pos);
+                
+            }
+            elsif ($token eq ")")
+            {
+                if ($in_context eq "(")
+                {
+                    $ret_op = undef;
+                    $in_context = 0;
+                }
+                else
+                {
+                    confess("Found ')' but not in context");
+                }
+            }
+            elsif ($token eq ",")
+            {
+                if ($in_context ne "(")
+                {
+                    confess("Found ',' but not in a function");
+                }
+  
+            }
+            elsif ($token eq "=")
+            {
+                my $tmp_op;
+                while(!defined($tmp_op))
+                {
+                    $tmp_op = $self->getOp($pos);
+                }
+                $ret_op = new XML::Stream::XPath::EqualOp($self->{OPS}->[$#{$self->{OPS}}],$tmp_op);
+                pop(@{$self->{OPS}});
+            }
+            elsif ($token eq "!")
+            {
+                if (substr($self->{QUERY},$token_start,1) ne "=")
+                {
+                    confess("Badly formed !=");
+                }
+                $$pos++;
+                
+                my $tmp_op;
+                while(!defined($tmp_op))
+                {
+                    $tmp_op = $self->getOp($pos);
+                }
+                $ret_op = new XML::Stream::XPath::NotEqualOp($self->{OPS}->[$#{$self->{OPS}}],$tmp_op);
+                pop(@{$self->{OPS}});
+            }
+            else
+            {
+                confess("Unhandled \"$token\"");
+            }
+
+            if ($in_context)
+            {
+                if (defined($ret_op))
+                {
+                    push(@{$self->{OPS}},$ret_op);
+                }
+                $ret_op = undef;
+            }
+        }
+        else
+        {
+            confess("Token undefined");
+        }
+        
+        $loop = 0 unless $in_context;
+    }
+
+    return $ret_op;
+}
+
+
+sub parseQuery
+{
+    my $self = shift;
+    my $query = shift;
+
+    my $op;
+    my $pos = 0;
+    while($pos < length($self->{QUERY}))
+    {
+        $op = $self->getOp(\$pos);
+        if (defined($op))
+        {
+            push(@{$self->{OPS}},$op);
+        }
+    }
+
+    #foreach my $op (@{$self->{OPS}})
+    #{
+    #    $op->display();
+    #}
+
+    return 1;
+}
+
+
+sub execute
+{
+    my $self = shift;
+    my $root = shift;
+
+    my $ctxt = new XML::Stream::XPath::Value($root);
+
+    foreach my $op (@{$self->{OPS}})
+    {
+        if (!$op->isValid(\$ctxt))
+        {
+            $ctxt->setValid(0);
+            return $ctxt;
+        }
+    }
+
+    $ctxt->setValid(1);
+    return $ctxt;
+}
+
+
+sub check
+{
+    my $self = shift;
+    my $root = shift;
+
+    my $ctxt = $self->execute($root);
+    return $ctxt->check();
+}
+
+
+1;
+
Index: perl/modules/Jabber/lib/XML/Stream/XPath/Value.pm
===================================================================
--- perl/modules/Jabber/lib/XML/Stream/XPath/Value.pm	(revision c2bed5539d456612d69de33e1dacc3afe5f70395)
+++ perl/modules/Jabber/lib/XML/Stream/XPath/Value.pm	(revision c2bed5539d456612d69de33e1dacc3afe5f70395)
@@ -0,0 +1,153 @@
+##############################################################################
+#
+#  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::XPath::Value;
+
+use 5.006_001;
+use strict;
+use vars qw( $VERSION );
+
+$VERSION = "1.22";
+
+sub new
+{
+    my $proto = shift;
+    my $self = { };
+
+    bless($self,$proto);
+
+    $self->setList(@_);
+    $self->setValues();
+    $self->setAttribs();
+    $self->setValid(0);
+    $self->in_context(0);
+
+    return $self;
+}
+
+
+sub setList
+{
+    my $self = shift;
+    my (@values) = @_;
+    $self->{LIST} = \@values;
+}
+
+
+sub getList
+{
+    my $self = shift;
+    return unless ($#{$self->{LIST}} > -1);
+    return @{$self->{LIST}};
+}
+
+
+sub getFirstElem
+{
+    my $self = shift;
+    return unless ($#{$self->{LIST}} > -1);
+    return $self->{LIST}->[0];
+}
+
+
+sub setValues
+{
+    my $self = shift;
+    my (@values) = @_;
+    $self->{VALUES} = \@values;
+}
+
+
+sub getValues
+{
+    my $self = shift;
+    return unless ($#{$self->{VALUES}} > -1);
+    return $self->{VALUES}->[0] if !wantarray;
+    return @{$self->{VALUES}};
+}
+
+
+sub setAttribs
+{
+    my $self = shift;
+    my (%attribs) = @_;
+    $self->{ATTRIBS} = \%attribs;
+}
+
+
+sub getAttribs
+{ 
+    my $self = shift;
+    return unless (scalar(keys(%{$self->{ATTRIBS}})) > 0);
+    return %{$self->{ATTRIBS}};
+}
+
+
+sub setValid
+{
+    my $self = shift;
+    my $valid = shift;
+    $self->{VALID} = $valid;
+}
+
+
+sub check
+{
+    my $self = shift;
+    return $self->{VALID};
+}
+
+
+sub in_context
+{
+    my $self = shift;
+    my $in_context = shift;
+
+    if (defined($in_context))
+    {
+        $self->{INCONTEXT} = $in_context;
+    }
+    return $self->{INCONTEXT};
+}
+
+
+sub display
+{
+    my $self = shift;
+    if (0)
+    {
+        print "VALUE: list(",join(",",@{$self->{LIST}}),")\n";
+    }
+    else
+    {
+        print "VALUE: list(\n";
+        foreach my $elem (@{$self->{LIST}})
+        {
+            print "VALUE:      ",$elem->GetXML(),"\n";
+        }
+        print "VALUE:     )\n";
+    }
+    print "VALUE: values(",join(",",@{$self->{VALUES}}),")\n";
+}
+
+1;
+
