summaryrefslogtreecommitdiff
path: root/lib/XML/Stream/XPath
diff options
context:
space:
mode:
authorAndreas Brachold <vdr07@deltab.de>2007-11-11 06:55:13 +0000
committerAndreas Brachold <vdr07@deltab.de>2007-11-11 06:55:13 +0000
commit3282be229999dc36c197b264d63063a18d136331 (patch)
tree98a42db29d955b39e7bed1b599fdcc56c3a29de9 /lib/XML/Stream/XPath
parentcfdd733c17cfa4f1a43b827a656e9e53cc2524ac (diff)
downloadxxv-3282be229999dc36c197b264d63063a18d136331.tar.gz
xxv-3282be229999dc36c197b264d63063a18d136331.tar.bz2
* Update installation list with required modules
* Remove unused/doubled provided external perl moduls
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, 0 insertions, 1446 deletions
diff --git a/lib/XML/Stream/XPath/Op.pm b/lib/XML/Stream/XPath/Op.pm
deleted file mode 100644
index 4209a5c..0000000
--- a/lib/XML/Stream/XPath/Op.pm
+++ /dev/null
@@ -1,919 +0,0 @@
-##############################################################################
-#
-# 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
deleted file mode 100644
index c4831fe..0000000
--- a/lib/XML/Stream/XPath/Query.pm
+++ /dev/null
@@ -1,374 +0,0 @@
-##############################################################################
-#
-# 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
deleted file mode 100644
index 425e183..0000000
--- a/lib/XML/Stream/XPath/Value.pm
+++ /dev/null
@@ -1,153 +0,0 @@
-##############################################################################
-#
-# 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;
-