XML-Stream
view release on metacpan or search on metacpan
lib/XML/Stream/Tree.pm view on Meta::CPAN
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/
Currently maintained by Darian Anthony Patrick.
=head1 COPYRIGHT
Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/
This module licensed under the LGPL, version 2.1.
=cut
use 5.008;
use strict;
use warnings;
use vars qw( $VERSION $LOADED );
$VERSION = "1.24";
$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
( run in 2.150 seconds using v1.01-cache-2.11-cpan-13bb782fe5a )