source: perl/modules/Jabber/lib/XML/Stream/XPath/Op.pm @ c2bed55

barnowl_perlaimdebianrelease-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since c2bed55 was c2bed55, checked in by Nelson Elhage <nelhage@mit.edu>, 14 years ago
Moving Net::Jabber into Jabber.par
  • Property mode set to 100644
File size: 17.1 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
23
24##############################################################################
25#
26# Op - Base Op class
27#
28##############################################################################
29package XML::Stream::XPath::Op;
30
31use 5.006_001;
32use strict;
33use vars qw( $VERSION );
34
35$VERSION = "1.22";
36
37sub new
38{
39    my $proto = shift;
40    return &allocate($proto,@_);
41}
42
43sub allocate
44{
45    my $proto = shift;
46    my $self = { };
47
48    bless($self,$proto);
49
50    $self->{TYPE} = shift;
51    $self->{VALUE} = shift;
52   
53    return $self;
54}
55
56sub getValue
57{
58    my $self = shift;
59    return $self->{VALUE};
60}
61
62sub calcStr
63{
64    my $self = shift;
65    return $self->{VALUE};
66}
67
68sub getType
69{
70    my $self = shift;
71    return $self->{TYPE};
72}
73
74
75sub isValid
76{
77    my $self = shift;
78    my $ctxt = shift;
79    return 1;
80}
81
82sub display
83{
84    my $self = shift;
85    my $space = shift;
86    $space = "" unless defined($space);
87
88    print $space,"OP: type($self->{TYPE}) value($self->{VALUE})\n";
89}
90
91
92
93##############################################################################
94#
95# PositionOp - class to handle [0] ops
96#
97##############################################################################
98package XML::Stream::XPath::PositionOp;
99
100use vars qw (@ISA);
101@ISA = ( "XML::Stream::XPath::Op" );
102
103sub new
104{
105    my $proto = shift;
106    my $self = $proto->allocate("POSITION","");
107    $self->{POS} = shift;
108
109    return $self;
110}
111
112
113sub isValid
114{
115    my $self = shift;
116    my $ctxt = shift;
117
118    my @elems = $$ctxt->getList();
119    my @valid_elems;
120    if ($#elems+1 < $self->{POS})
121    {
122        return;
123    }
124
125    push(@valid_elems, $elems[$self->{POS}-1]);
126
127    $$ctxt->setList(@valid_elems);
128
129    return 1;
130}
131
132
133
134##############################################################################
135#
136# ContextOp - class to handle [...] ops
137#
138##############################################################################
139package XML::Stream::XPath::ContextOp;
140
141use vars qw (@ISA);
142@ISA = ( "XML::Stream::XPath::Op" );
143
144sub new
145{
146    my $proto = shift;
147    my $self = $proto->allocate("CONTEXT","");
148    $self->{OP} = shift;
149    return $self;
150}
151
152
153sub isValid
154{
155    my $self = shift;
156    my $ctxt = shift;
157
158    my @elems = $$ctxt->getList();
159    my @valid_elems;
160    foreach my $elem (@elems)
161    {
162        my $tmp_ctxt = new XML::Stream::XPath::Value($elem);
163        $tmp_ctxt->in_context(1);
164        if ($self->{OP}->isValid(\$tmp_ctxt))
165        {
166            push(@valid_elems,$elem);
167        }   
168    }
169
170    $$ctxt->setList(@valid_elems);
171   
172    if ($#valid_elems == -1)
173    {
174        return;
175    }
176
177    return 1;
178}
179
180
181sub display
182{
183    my $self = shift;
184    my $space = shift;
185    $space = "" unless defined($space);
186
187    print "${space}OP: type(CONTEXT) op: \n";
188    $self->{OP}->display("$space    ");
189}
190
191
192
193
194##############################################################################
195#
196# AllOp - class to handle // ops
197#
198##############################################################################
199package XML::Stream::XPath::AllOp;
200
201use vars qw (@ISA);
202@ISA = ( "XML::Stream::XPath::Op" );
203
204sub new
205{
206    my $proto = shift;
207    my $name = shift;
208    my $self = $proto->allocate("ALL",$name);
209    return $self;
210}
211
212
213sub isValid
214{
215    my $self = shift;
216    my $ctxt = shift;
217
218    my @elems = $$ctxt->getList();
219
220    if ($#elems == -1)
221    {
222        return;
223    }
224
225    my @valid_elems;
226   
227    foreach my $elem (@elems)
228    {
229        push(@valid_elems,$self->descend($elem));
230    }
231   
232    $$ctxt->setList(@valid_elems);
233
234    if ($#valid_elems == -1)
235    {
236        return;
237    }
238
239    return 1;
240}
241
242
243sub descend
244{
245    my $self = shift;
246    my $elem = shift;
247
248    my @valid_elems;
249   
250    if (($self->{VALUE} eq "*") || (&XML::Stream::GetXMLData("tag",$elem) eq $self->{VALUE}))
251    {
252        push(@valid_elems,$elem);
253    }
254   
255    foreach my $child (&XML::Stream::GetXMLData("child array",$elem,"*"))
256    {
257        push(@valid_elems,$self->descend($child));
258    }
259   
260    return @valid_elems;
261}
262
263
264
265##############################################################################
266#
267# NodeOp - class to handle ops based on node names
268#
269##############################################################################
270package XML::Stream::XPath::NodeOp;
271
272use vars qw (@ISA);
273@ISA = ( "XML::Stream::XPath::Op" );
274
275sub new
276{
277    my $proto = shift;
278    my $name = shift;
279    my $is_root = shift;
280    $is_root = 0 unless defined($is_root);
281    my $self = $proto->allocate("NODE",$name);
282    $self->{ISROOT} = $is_root;
283    return $self;
284}
285
286
287sub isValid
288{
289    my $self = shift;
290    my $ctxt = shift;
291
292    if ($self->{ISROOT})
293    {
294        my $elem = $$ctxt->getFirstElem();
295        if (&XML::Stream::GetXMLData("tag",$elem) ne $self->{VALUE})
296        {
297            return;
298        }
299        return 1;
300    }
301
302    my @valid_elems;
303
304    foreach my $elem ($$ctxt->getList())
305    {
306        my $valid = 0;
307
308        foreach my $child (&XML::Stream::GetXMLData("child array",$elem,"*"))
309        {
310            if (($self->{VALUE} eq "*") ||
311                (&XML::Stream::GetXMLData("tag",$child) eq $self->{VALUE}))
312            {
313                if ($$ctxt->in_context())
314                {
315                    $valid = 1;
316                }
317                else
318                {
319                    push(@valid_elems,$child);
320                }
321            }
322        }
323        if ($valid)
324        {
325            push(@valid_elems,$elem);
326        }
327    }
328   
329    $$ctxt->setList(@valid_elems);
330
331    if ($#valid_elems == -1)
332    {
333        return;
334    }
335
336    return 1;
337}
338
339
340sub calcStr
341{
342    my $self = shift;
343    my $elem = shift;
344    return &XML::Stream::GetXMLData("value",$elem);
345} 
346
347
348##############################################################################
349#
350# EqualOp - class to handle [ x = y ] ops
351#
352##############################################################################
353package XML::Stream::XPath::EqualOp;
354
355use vars qw (@ISA);
356@ISA = ( "XML::Stream::XPath::Op" );
357
358sub new
359{
360    my $proto = shift;
361    my $self = $proto->allocate("EQUAL","");
362    $self->{OP_L} = shift;
363    $self->{OP_R} = shift;
364    return $self;
365}
366
367
368sub isValid
369{
370    my $self = shift;
371    my $ctxt = shift;
372
373    my $tmp_ctxt = new XML::Stream::XPath::Value();
374    $tmp_ctxt->setList($$ctxt->getList());
375    $tmp_ctxt->in_context(0);
376   
377    if (!$self->{OP_L}->isValid(\$tmp_ctxt) || !$self->{OP_R}->isValid(\$tmp_ctxt))
378    {
379        return;
380    }
381
382    my @valid_elems;
383    foreach my $elem ($tmp_ctxt->getList)
384    {
385        if ($self->{OP_L}->calcStr($elem) eq $self->{OP_R}->calcStr($elem))
386        {
387            push(@valid_elems,$elem);
388        }
389    }
390
391    if ( $#valid_elems > -1)
392    {
393        @valid_elems = $$ctxt->getList();
394    }
395   
396    $$ctxt->setList(@valid_elems);
397
398    if ($#valid_elems == -1)
399    {
400        return;
401    }
402
403    return 1;
404}
405
406
407sub display
408{
409    my $self = shift;
410    my $space = shift;
411    $space = "" unless defined($space);
412
413    print $space,"OP: type(EQUAL)\n";
414    print $space,"    op_l: ";
415    $self->{OP_L}->display($space."    ");
416   
417    print $space,"    op_r: ";
418    $self->{OP_R}->display($space."    ");
419}
420
421
422
423##############################################################################
424#
425# NotEqualOp - class to handle [ x != y ] ops
426#
427##############################################################################
428package XML::Stream::XPath::NotEqualOp;
429
430use vars qw (@ISA);
431@ISA = ( "XML::Stream::XPath::Op" );
432
433sub new
434{
435    my $proto = shift;
436    my $self = $proto->allocate("NOTEQUAL","");
437    $self->{OP_L} = shift;
438    $self->{OP_R} = shift;
439    return $self;
440}
441
442
443sub isValid
444{
445    my $self = shift;
446    my $ctxt = shift;
447
448    my $tmp_ctxt = new XML::Stream::XPath::Value();
449    $tmp_ctxt->setList($$ctxt->getList());
450    $tmp_ctxt->in_context(0);
451   
452    if (!$self->{OP_L}->isValid(\$tmp_ctxt) || !$self->{OP_R}->isValid(\$tmp_ctxt))
453    {
454        return;
455    }
456
457    my @valid_elems;
458    foreach my $elem ($tmp_ctxt->getList)
459    {
460        if ($self->{OP_L}->calcStr($elem) ne $self->{OP_R}->calcStr($elem))
461        {
462            push(@valid_elems,$elem);
463        }
464    }
465
466    if ( $#valid_elems > -1)
467    {
468        @valid_elems = $$ctxt->getList();
469    }
470   
471    $$ctxt->setList(@valid_elems);
472
473    if ($#valid_elems == -1)
474    {
475        return;
476    }
477
478    return 1;
479}
480
481
482sub display
483{
484    my $self = shift;
485    my $space = shift;
486    $space = "" unless defined($space);
487
488    print $space,"OP: type(NOTEQUAL)\n";
489    print $space,"    op_l: ";
490    $self->{OP_L}->display($space."    ");
491   
492    print $space,"    op_r: ";
493    $self->{OP_R}->display($space."    ");
494}
495
496
497
498##############################################################################
499#
500# AttributeOp - class to handle @foo ops.
501#
502##############################################################################
503package XML::Stream::XPath::AttributeOp;
504
505use vars qw (@ISA);
506@ISA = ( "XML::Stream::XPath::Op" );
507
508sub new
509{
510    my $proto = shift;
511    my $name = shift;
512    my $self = $proto->allocate("ATTRIBUTE",$name);
513    return $self;
514}
515
516
517sub isValid
518{
519    my $self = shift;
520    my $ctxt = shift;
521
522    my @elems = $$ctxt->getList();
523    my @valid_elems;
524    my @values;
525    my %attribs;
526   
527    foreach my $elem (@elems)
528    {
529        if ($self->{VALUE} ne "*")
530        {
531            if (&XML::Stream::GetXMLData("value",$elem,"",$self->{VALUE}))
532            {
533                $self->{VAL} = $self->calcStr($elem);
534                push(@valid_elems,$elem);
535                push(@values,$self->{VAL});
536            }
537        }
538        else
539        {
540            my %attrib = &XML::Stream::GetXMLData("attribs",$elem);
541            if (scalar(keys(%attrib)) > 0)
542            {
543                push(@valid_elems,$elem);
544                foreach my $key (keys(%attrib))
545                {
546                    $attribs{$key} = $attrib{$key};
547                }
548            }
549        }
550    }
551
552    $$ctxt->setList(@valid_elems);
553    $$ctxt->setValues(@values);
554    $$ctxt->setAttribs(%attribs);
555
556    if ($#valid_elems == -1)
557    {
558        return;
559    }
560   
561    return 1;
562}
563
564
565sub getValue
566{
567    my $self = shift;
568    return $self->{VAL};
569}
570
571
572sub calcStr
573{
574    my $self = shift;
575    my $elem = shift;
576    return &XML::Stream::GetXMLData("value",$elem,"",$self->{VALUE});
577}
578
579
580
581
582##############################################################################
583#
584# AndOp - class to handle [ .... and .... ] ops
585#
586##############################################################################
587package XML::Stream::XPath::AndOp;
588
589use vars qw (@ISA);
590@ISA = ( "XML::Stream::XPath::Op" );
591
592sub new
593{
594    my $proto = shift;
595    my $self = $proto->allocate("AND","and");
596    $self->{OP_L} = shift;
597    $self->{OP_R} = shift;
598    return $self;
599}
600
601
602sub isValid
603{
604    my $self = shift;
605    my $ctxt = shift;
606
607    my $opl = $self->{OP_L}->isValid($ctxt);
608    my $opr = $self->{OP_R}->isValid($ctxt);
609   
610    if ($opl && $opr)
611    {
612        return 1;
613    }
614    else
615    {
616        return;
617    }
618}
619
620
621sub display
622{
623    my $self = shift;
624    my $space = shift;
625    $space = "" unless defined($space);
626
627    print $space,"OP: type(AND)\n";
628    print $space,"  op_l: \n";
629    $self->{OP_L}->display($space."    ");
630   
631    print $space,"  op_r: \n";
632    $self->{OP_R}->display($space."    ");
633}
634
635
636
637##############################################################################
638#
639# OrOp - class to handle [ .... or .... ] ops
640#
641##############################################################################
642package XML::Stream::XPath::OrOp;
643
644use vars qw (@ISA);
645@ISA = ( "XML::Stream::XPath::Op" );
646
647sub new
648{
649    my $proto = shift;
650    my $self = $proto->allocate("OR","or");
651    $self->{OP_L} = shift;
652    $self->{OP_R} = shift;
653    return $self;
654}
655
656
657sub isValid
658{
659    my $self = shift;
660    my $ctxt = shift;
661
662    my @elems = $$ctxt->getList();
663    my @valid_elems;
664
665    foreach my $elem (@elems)
666    {
667        my $tmp_ctxt_l = new XML::Stream::XPath::Value($elem);
668        $tmp_ctxt_l->in_context(1);
669        my $tmp_ctxt_r = new XML::Stream::XPath::Value($elem);
670        $tmp_ctxt_r->in_context(1);
671
672        my $opl = $self->{OP_L}->isValid(\$tmp_ctxt_l);
673        my $opr = $self->{OP_R}->isValid(\$tmp_ctxt_r);
674   
675        if ($opl || $opr)
676        {
677            push(@valid_elems,$elem);
678        }   
679    }
680
681    $$ctxt->setList(@valid_elems);
682   
683    if ($#valid_elems == -1)
684    {
685        return;
686    }
687
688    return 1;
689}
690
691
692sub display
693{
694    my $self = shift;
695    my $space = shift;
696    $space = "" unless defined($space);
697
698    print "${space}OP: type(OR)\n";
699    print "$space    op_l: ";
700    $self->{OP_L}->display("$space    ");
701   
702    print "$space    op_r: ";
703    $self->{OP_R}->display("$space    ");
704}
705
706
707
708##############################################################################
709#
710# FunctionOp - class to handle xxxx(...) ops
711#
712##############################################################################
713package XML::Stream::XPath::FunctionOp;
714
715use vars qw (@ISA);
716@ISA = ( "XML::Stream::XPath::Op" );
717
718sub new
719{
720    my $proto = shift;
721    my $function = shift;
722    my $self = $proto->allocate("FUNCTION",$function);
723    $self->{CLOSED} = 0;
724    return $self;
725}
726
727
728sub addArg
729{
730    my $self = shift;
731    my $arg = shift;
732
733    push(@{$self->{ARGOPS}},$arg);
734}
735
736
737sub isValid
738{
739    my $self = shift;
740    my $ctxt = shift;
741
742    my $result;
743    eval("\$result = &{\$XML::Stream::XPath::FUNCTIONS{\$self->{VALUE}}}(\$ctxt,\@{\$self->{ARGOPS}});");
744    return $result;
745}
746
747
748sub calcStr
749{
750    my $self = shift;
751    my $elem = shift;
752   
753    my $result;
754    eval("\$result = &{\$XML::Stream::XPath::VALUES{\$self->{VALUE}}}(\$elem);");
755    return $result;
756
757}
758
759
760sub display
761{
762    my $self = shift;
763    my $space = shift;
764    $space = "" unless defined($space);
765
766    print $space,"OP: type(FUNCTION)\n";
767    print $space,"    $self->{VALUE}(\n";
768    foreach my $arg (@{$self->{ARGOPS}})
769    {
770        print $arg,"\n";
771        $arg->display($space."        ");
772    }
773    print "$space    )\n";
774}
775
776
777sub function_name
778{
779    my $ctxt = shift;
780    my (@args) = @_;
781
782    my @elems = $$ctxt->getList();
783    my @valid_elems;
784    my @valid_values;
785    foreach my $elem (@elems)
786    {
787        my $text = &value_name($elem);
788        if (defined($text))
789        {
790            push(@valid_elems,$elem);
791            push(@valid_values,$text);
792        }   
793    }
794
795    $$ctxt->setList(@valid_elems);
796    $$ctxt->setValues(@valid_values);
797   
798    if ($#valid_elems == -1)
799    {
800        return;
801    }
802
803    return 1;
804}
805
806
807sub function_not
808{
809    my $ctxt = shift;
810    my (@args) = @_;
811
812    my @elems = $$ctxt->getList();
813    my @valid_elems;
814    foreach my $elem (@elems)
815    {
816        my $tmp_ctxt = new XML::Stream::XPath::Value($elem);
817        $tmp_ctxt->in_context(1);
818        if (!($args[0]->isValid(\$tmp_ctxt)))
819        {
820            push(@valid_elems,$elem);
821        }   
822    }
823
824    $$ctxt->setList(@valid_elems);
825   
826    if ($#valid_elems == -1)
827    {
828        return;
829    }
830
831    return 1;
832}
833
834
835sub function_text
836{
837    my $ctxt = shift;
838    my (@args) = @_;
839
840    my @elems = $$ctxt->getList();
841    my @valid_elems;
842    my @valid_values;
843    foreach my $elem (@elems)
844    {
845        my $text = &value_text($elem);
846        if (defined($text))
847        {
848            push(@valid_elems,$elem);
849            push(@valid_values,$text);
850        }   
851    }
852
853    $$ctxt->setList(@valid_elems);
854    $$ctxt->setValues(@valid_values);
855   
856    if ($#valid_elems == -1)
857    {
858        return;
859    }
860
861    return 1;
862}
863
864
865sub function_startswith
866{
867    my $ctxt = shift;
868    my (@args) = @_;
869
870    my @elems = $$ctxt->getList();
871    my @valid_elems;
872    foreach my $elem (@elems)
873    {
874        my $val1 = $args[0]->calcStr($elem);
875        my $val2 = $args[1]->calcStr($elem);
876
877        if (substr($val1,0,length($val2)) eq $val2)
878        {
879            push(@valid_elems,$elem);
880        }   
881    }
882
883    $$ctxt->setList(@valid_elems);
884   
885    if ($#valid_elems == -1)
886    {
887        return;
888    }
889
890    return 1;
891}
892
893
894sub value_name
895{
896    my $elem = shift;
897    return &XML::Stream::GetXMLData("tag",$elem);
898}
899
900
901sub value_text
902{
903    my $elem = shift;
904    return &XML::Stream::GetXMLData("value",$elem);
905}
906
907
908
909$XML::Stream::XPath::FUNCTIONS{'name'} = \&function_name;
910$XML::Stream::XPath::FUNCTIONS{'not'} = \&function_not;
911$XML::Stream::XPath::FUNCTIONS{'text'} = \&function_text;
912$XML::Stream::XPath::FUNCTIONS{'starts-with'} = \&function_startswith;
913
914$XML::Stream::XPath::VALUES{'name'} = \&value_name;
915$XML::Stream::XPath::VALUES{'text'} = \&value_text;
916
9171;
918
919
Note: See TracBrowser for help on using the repository browser.