source: perl/lib/XML/Stream/XPath/Query.pm @ 0ff8d110

barnowl_perlaimdebianrelease-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 0ff8d110 was 0ff8d110, checked in by Alejandro R. Sedeño <asedeno@mit.edu>, 15 years ago
Adding XML::Stream, Net::XMPP, and Net::Jabber to perl/lib/
  • Property mode set to 100644
File size: 10.2 KB
Line 
1##############################################################################
2#
3#  This library is free software; you can redistribute it and/or
4#  modify it under the terms of the GNU Library General Public
5#  License as published by the Free Software Foundation; either
6#  version 2 of the License, or (at your option) any later version.
7#
8#  This library is distributed in the hope that it will be useful,
9#  but WITHOUT ANY WARRANTY; without even the implied warranty of
10#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
11#  Library General Public License for more details.
12#
13#  You should have received a copy of the GNU Library General Public
14#  License along with this library; if not, write to the
15#  Free Software Foundation, Inc., 59 Temple Place - Suite 330,
16#  Boston, MA  02111-1307, USA.
17#
18#  Jabber
19#  Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/
20#
21##############################################################################
22
23package XML::Stream::XPath::Query;
24
25use 5.006_001;
26use strict;
27use Carp;
28use vars qw( $VERSION );
29
30$VERSION = "1.22";
31
32sub new
33{
34    my $proto = shift;
35    my $self = { };
36
37    bless($self,$proto);
38
39    $self->{TOKENS} = [ '/','[',']','@','"',"'",'=','!','(',')',':',' ',',']; 
40    $self->{QUERY} = shift;
41   
42    if (!defined($self->{QUERY}) || ($self->{QUERY} eq ""))
43    {
44        confess("No query string specified");
45    }
46   
47    $self->parseQuery();
48   
49    return $self;
50}
51
52
53sub getNextToken
54{ 
55    my $self = shift;
56    my $pos = shift;
57
58    my @toks = grep{ $_ eq substr($self->{QUERY},$$pos,1)} @{$self->{TOKENS}};
59    while( $#toks == -1 )
60    {
61        $$pos++;
62        if ($$pos > length($self->{QUERY}))
63        {
64            $$pos = length($self->{QUERY});
65            return 0;
66        }
67        @toks = grep{ $_ eq substr($self->{QUERY},$$pos,1)} @{$self->{TOKENS}};
68    }
69
70    return $toks[0];
71}
72
73
74sub getNextIdentifier
75{
76    my $self = shift;
77    my $pos = shift;
78    my $sp = $$pos;
79    $self->getNextToken($pos);
80    return substr($self->{QUERY},$sp,$$pos-$sp);
81}
82
83
84sub getOp
85{
86    my $self = shift;
87    my $pos = shift;
88    my $in_context = shift;
89    $in_context = 0 unless defined($in_context);
90
91    my $ret_op;
92
93    my $loop = 1;
94    while( $loop )
95    {
96        my $pos_start = $$pos;
97
98        my $token = $self->getNextToken($pos);
99        if (($token eq "0") && $in_context)
100        {
101            return;
102        }
103
104        my $token_start = ++$$pos;
105        my $ident;
106     
107        if (defined($token))
108        {
109
110            if ($pos_start != ($token_start-1))
111            {
112                $$pos = $pos_start;
113                my $temp_ident = $self->getNextIdentifier($pos);
114                $ret_op = new XML::Stream::XPath::NodeOp($temp_ident,"0");
115            }
116            elsif ($token eq "/")
117            {
118                if (substr($self->{QUERY},$token_start,1) eq "/")
119                {
120                    $$pos++;
121                    my $temp_ident = $self->getNextIdentifier($pos);
122                    $ret_op = new XML::Stream::XPath::AllOp($temp_ident);
123                }
124                else
125                {
126                    my $temp_ident = $self->getNextIdentifier($pos);
127                    if ($temp_ident ne "")
128                    {
129                        $ret_op = new XML::Stream::XPath::NodeOp($temp_ident,($pos_start == 0 ? "1" : "0"));
130                    }
131                }
132            }
133            elsif ($token eq "\@")
134            {
135                $ret_op = new XML::Stream::XPath::AttributeOp($self->getNextIdentifier($pos));
136            }
137            elsif ($token eq "]")
138            {
139                if ($in_context eq "[")
140                {
141                    $ret_op = pop(@{$self->{OPS}});
142                    $in_context = 0;
143                }
144                else
145                {
146                    confess("Found ']' but not in context");
147                    return;
148                }
149            }
150            elsif (($token eq "\"") || ($token eq "\'"))
151            {
152                $$pos = index($self->{QUERY},$token,$token_start);
153                $ret_op = new XML::Stream::XPath::Op("LITERAL",substr($self->{QUERY},$token_start,$$pos-$token_start));
154                $$pos++;
155            }
156            elsif ($token eq " ")
157            {
158                $ident = $self->getNextIdentifier($pos);
159                if ($ident eq "and")
160                {
161                    $$pos++;
162                    my $tmp_op = $self->getOp($pos,$in_context);
163                    if (!defined($tmp_op))
164                    {
165                        confess("Invalid 'and' operation");
166                        return;
167                    }
168                    $ret_op = new XML::Stream::XPath::AndOp($self->{OPS}->[$#{$self->{OPS}}],$tmp_op);
169                    $in_context = 0;
170                    pop(@{$self->{OPS}});
171                }
172                elsif ($ident eq "or")
173                {
174                    $$pos++;
175                    my $tmp_op = $self->getOp($pos,$in_context);
176                    if (!defined($tmp_op))
177                    {
178                        confess("Invalid 'or' operation");
179                        return;
180                    }
181                    $ret_op = new XML::Stream::XPath::OrOp($self->{OPS}->[$#{$self->{OPS}}],$tmp_op);
182                    $in_context = 0;
183                    pop(@{$self->{OPS}});
184                }
185            }
186            elsif ($token eq "[")
187            {
188                if ($self->getNextToken($pos) eq "]")
189                {
190                    if ($$pos == $token_start)
191                    {
192                        confess("Nothing in the []");
193                        return;
194                    }
195                   
196                    $$pos = $token_start;
197                    my $val = $self->getNextIdentifier($pos);
198                    if ($val =~ /^\d+$/)
199                    {
200                        $ret_op = new XML::Stream::XPath::PositionOp($val);
201                        $$pos++;
202                    }
203                    else
204                    {
205                        $$pos = $pos_start + 1;
206                        $ret_op = new XML::Stream::XPath::ContextOp($self->getOp($pos,$token));
207                    }
208                }
209                else
210                {
211                    $$pos = $pos_start + 1;
212                    $ret_op = new XML::Stream::XPath::ContextOp($self->getOp($pos,$token));
213                }
214            }
215            elsif ($token eq "(")
216            {
217                #-------------------------------------------------------------
218                # The function name would have been mistaken for a NodeOp.
219                # Pop it off the back and get the function name.
220                #-------------------------------------------------------------
221                my $op = pop(@{$self->{OPS}});
222                if ($op->getType() ne "NODE")
223                {
224                    confess("No function name specified.");
225                }
226                my $function = $op->getValue();
227                if (!exists($XML::Stream::XPath::FUNCTIONS{$function}))
228                {
229                    confess("Undefined function \"$function\"");
230                }
231                $ret_op = new XML::Stream::XPath::FunctionOp($function);
232
233                my $op_pos = $#{$self->{OPS}} + 1;
234
235                $self->getOp($pos,$token);
236               
237                foreach my $arg ($op_pos..$#{$self->{OPS}})
238                {
239                    $ret_op->addArg($self->{OPS}->[$arg]);
240                }
241
242                splice(@{$self->{OPS}},$op_pos);
243               
244            }
245            elsif ($token eq ")")
246            {
247                if ($in_context eq "(")
248                {
249                    $ret_op = undef;
250                    $in_context = 0;
251                }
252                else
253                {
254                    confess("Found ')' but not in context");
255                }
256            }
257            elsif ($token eq ",")
258            {
259                if ($in_context ne "(")
260                {
261                    confess("Found ',' but not in a function");
262                }
263 
264            }
265            elsif ($token eq "=")
266            {
267                my $tmp_op;
268                while(!defined($tmp_op))
269                {
270                    $tmp_op = $self->getOp($pos);
271                }
272                $ret_op = new XML::Stream::XPath::EqualOp($self->{OPS}->[$#{$self->{OPS}}],$tmp_op);
273                pop(@{$self->{OPS}});
274            }
275            elsif ($token eq "!")
276            {
277                if (substr($self->{QUERY},$token_start,1) ne "=")
278                {
279                    confess("Badly formed !=");
280                }
281                $$pos++;
282               
283                my $tmp_op;
284                while(!defined($tmp_op))
285                {
286                    $tmp_op = $self->getOp($pos);
287                }
288                $ret_op = new XML::Stream::XPath::NotEqualOp($self->{OPS}->[$#{$self->{OPS}}],$tmp_op);
289                pop(@{$self->{OPS}});
290            }
291            else
292            {
293                confess("Unhandled \"$token\"");
294            }
295
296            if ($in_context)
297            {
298                if (defined($ret_op))
299                {
300                    push(@{$self->{OPS}},$ret_op);
301                }
302                $ret_op = undef;
303            }
304        }
305        else
306        {
307            confess("Token undefined");
308        }
309       
310        $loop = 0 unless $in_context;
311    }
312
313    return $ret_op;
314}
315
316
317sub parseQuery
318{
319    my $self = shift;
320    my $query = shift;
321
322    my $op;
323    my $pos = 0;
324    while($pos < length($self->{QUERY}))
325    {
326        $op = $self->getOp(\$pos);
327        if (defined($op))
328        {
329            push(@{$self->{OPS}},$op);
330        }
331    }
332
333    #foreach my $op (@{$self->{OPS}})
334    #{
335    #    $op->display();
336    #}
337
338    return 1;
339}
340
341
342sub execute
343{
344    my $self = shift;
345    my $root = shift;
346
347    my $ctxt = new XML::Stream::XPath::Value($root);
348
349    foreach my $op (@{$self->{OPS}})
350    {
351        if (!$op->isValid(\$ctxt))
352        {
353            $ctxt->setValid(0);
354            return $ctxt;
355        }
356    }
357
358    $ctxt->setValid(1);
359    return $ctxt;
360}
361
362
363sub check
364{
365    my $self = shift;
366    my $root = shift;
367
368    my $ctxt = $self->execute($root);
369    return $ctxt->check();
370}
371
372
3731;
374
Note: See TracBrowser for help on using the repository browser.