diff options
| author | Andreas Brachold <vdr07@deltab.de> | 2007-08-13 18:41:27 +0000 |
|---|---|---|
| committer | Andreas Brachold <vdr07@deltab.de> | 2007-08-13 18:41:27 +0000 |
| commit | bcbf441e09fb502cf64924ff2530fa144bdf52c5 (patch) | |
| tree | f377707a2dac078db8cd0c7d7abfe69ac1006d71 /lib/XML/Stream/XPath | |
| download | xxv-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.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, 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; + |
