summaryrefslogtreecommitdiff
path: root/lib/XML/Stream/Tree.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/XML/Stream/Tree.pm')
-rw-r--r--lib/XML/Stream/Tree.pm682
1 files changed, 682 insertions, 0 deletions
diff --git a/lib/XML/Stream/Tree.pm b/lib/XML/Stream/Tree.pm
new file mode 100644
index 0000000..b52269c
--- /dev/null
+++ b/lib/XML/Stream/Tree.pm
@@ -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;
generated by cgit v1.2.3 (git 2.25.1) at 2026-03-05 06:32:37 +0000