diff options
| author | Andreas Brachold <vdr07@deltab.de> | 2007-11-11 06:55:13 +0000 |
|---|---|---|
| committer | Andreas Brachold <vdr07@deltab.de> | 2007-11-11 06:55:13 +0000 |
| commit | 3282be229999dc36c197b264d63063a18d136331 (patch) | |
| tree | 98a42db29d955b39e7bed1b599fdcc56c3a29de9 /lib/XML/Stream/XPath | |
| parent | cfdd733c17cfa4f1a43b827a656e9e53cc2524ac (diff) | |
| download | xxv-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.pm | 919 | ||||
| -rw-r--r-- | lib/XML/Stream/XPath/Query.pm | 374 | ||||
| -rw-r--r-- | lib/XML/Stream/XPath/Value.pm | 153 |
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; - |
