summaryrefslogtreecommitdiff
path: root/lib/XML/Stream/XPath
diff options
context:
space:
mode:
authorAndreas Brachold <vdr07@deltab.de>2007-08-13 18:41:27 +0000
committerAndreas Brachold <vdr07@deltab.de>2007-08-13 18:41:27 +0000
commitbcbf441e09fb502cf64924ff2530fa144bdf52c5 (patch)
treef377707a2dac078db8cd0c7d7abfe69ac1006d71 /lib/XML/Stream/XPath
downloadxxv-bcbf441e09fb502cf64924ff2530fa144bdf52c5.tar.gz
xxv-bcbf441e09fb502cf64924ff2530fa144bdf52c5.tar.bz2
* Move files to trunk
Diffstat (limited to 'lib/XML/Stream/XPath')
-rw-r--r--lib/XML/Stream/XPath/Op.pm919
-rw-r--r--lib/XML/Stream/XPath/Query.pm374
-rw-r--r--lib/XML/Stream/XPath/Value.pm153
3 files changed, 1446 insertions, 0 deletions
diff --git a/lib/XML/Stream/XPath/Op.pm b/lib/XML/Stream/XPath/Op.pm
new file mode 100644
index 0000000..4209a5c
--- /dev/null
+++ b/lib/XML/Stream/XPath/Op.pm
@@ -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;
+
+
diff --git a/lib/XML/Stream/XPath/Query.pm b/lib/XML/Stream/XPath/Query.pm
new file mode 100644
index 0000000..c4831fe
--- /dev/null
+++ b/lib/XML/Stream/XPath/Query.pm
@@ -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;
+
diff --git a/lib/XML/Stream/XPath/Value.pm b/lib/XML/Stream/XPath/Value.pm
new file mode 100644
index 0000000..425e183
--- /dev/null
+++ b/lib/XML/Stream/XPath/Value.pm
@@ -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;
+