File Coverage

blib/lib/Text/Query/Parse.pm
Criterion Covered Total %
statement 52 58 89.6
branch 4 6 66.6
condition n/a
subroutine 18 20 90.0
pod 3 18 16.6
total 77 102 75.4


line stmt bran cond sub pod time code
1             #
2             # Copyright (C) 1999 Eric Bohlman, Loic Dachary
3             #
4             # This program is free software; you can redistribute it and/or modify it
5             # under the terms of the GNU General Public License as published by the
6             # Free Software Foundation; either version 2, or (at your option) any
7             # later version. You may also use, redistribute and/or modify it
8             # under the terms of the Artistic License supplied with your Perl
9             # distribution
10             #
11             # This program is distributed in the hope that it will be useful,
12             # but WITHOUT ANY WARRANTY; without even the implied warranty of
13             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14             # GNU General Public License for more details.
15             #
16             # You should have received a copy of the GNU General Public License
17             # along with this program; if not, write to the Free Software
18             # Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19              
20             package Text::Query::Parse;
21              
22 2     2   11 use strict;
  2         4  
  2         61  
23              
24 2     2   11 use Carp;
  2         3  
  2         1909  
25              
26             sub new {
27 7     7 0 14 my $class=shift;
28 7         13 my $self={};
29 7         20 bless $self, $class;
30              
31 7         31 $self->initialize();
32              
33 7         23 return $self;
34             }
35              
36 7     7 0 11 sub initialize {
37             }
38              
39             sub prepare {
40 43     43 1 61 my $self=shift;
41 43         61 my $qstring=shift;
42              
43 43 100       158 @_ = ( %{$self->{parseopts}}, @_ ) if($self->{parseopts});
  36         294  
44 43         390 $self->{parseopts} = { -regexp=>0, -litspace=>0, -case=>0, -whole=>0, -quotes=>"\\'\\\"", @_ };
45 43 50       137 croak("no builder") if(!$self->{-build});
46 43         100 $self->{-build}->{parseopts} = $self->{parseopts};
47              
48 43         128 delete($self->{'token'});
49 43         78 delete($self->{'tokens'});
50 43         121 $self->build_init();
51              
52 43         124 $self->parse_tokens($qstring);
53              
54 43 50       66 croak("no token found") if(!@{$self->{'tokens'}});
  43         128  
55              
56 43         139 return $self->build_final_expression($self->expression());
57             }
58              
59             #parsing routines
60              
61             sub expression($) {
62 0     0 1 0 my($self) = @_;
63            
64 0         0 croak("not implemented");
65              
66 0         0 return "expression";
67             }
68              
69             sub parse_tokens($) {
70 0     0 1 0 my($self, $qstring) = @_;
71              
72 0         0 croak("not implemented");
73              
74 0         0 $self->{'tokens'} = [];
75             }
76              
77             #
78             # Access builder functions
79             #
80              
81             sub build_init {
82 43     43 0 60 my($self) = @_;
83              
84 43         202 return $self->{-build}->build_init();
85             }
86              
87             sub build_final_expression {
88 43     43 0 71 my($self, $t1) = @_;
89              
90 43         140 return $self->{-build}->build_final_expression($t1);
91             }
92              
93             sub build_expression {
94 23     23 0 44 my($self, $l, $r) = @_;
95              
96 23         85 return $self->{-build}->build_expression($l, $r);
97             }
98              
99             sub build_expression_finish {
100 59     59 0 90 my($self, $l) = @_;
101              
102 59         194 return $self->{-build}->build_expression_finish($l);
103             }
104              
105             sub build_conj {
106 15     15 0 28 my($self, $l, $r, $first) = @_;
107              
108 15         56 return $self->{-build}->build_conj($l, $r, $first);
109             }
110              
111             sub build_near {
112 3     3 0 7 my($self, $l, $r) = @_;
113              
114 3         17 return $self->{-build}->build_near($l, $r);
115             }
116              
117             sub build_concat {
118 2     2 0 7 my($self, $l, $r) = @_;
119              
120 2         14 return $self->{-build}->build_concat($l, $r);
121             }
122              
123             sub build_negation {
124 5     5 0 11 my($self, $t) = @_;
125              
126 5         24 return $self->{-build}->build_negation($t);
127             }
128              
129             sub build_literal {
130 86     86 0 131 my($self, $t) = @_;
131              
132 86         301 return $self->{-build}->build_literal($t);
133             }
134              
135             sub build_scope_start {
136 8     8 0 12 my($self) = @_;
137              
138 8         38 return $self->{-build}->build_scope_start($self->{scope});
139             }
140              
141             sub build_scope_end {
142 8     8 0 13 my($self, $t) = @_;
143              
144 8         35 return $self->{-build}->build_scope_end($self->{scope}, $t);
145             }
146              
147             sub build_mandatory {
148 6     6 0 10 my($self, $t) = @_;
149              
150 6         22 return $self->{-build}->build_mandatory($t);
151             }
152              
153             sub build_forbiden {
154 2     2 0 5 my($self, $t) = @_;
155              
156 2         10 return $self->{-build}->build_forbiden($t);
157             }
158              
159             1;
160              
161             __END__