File Coverage

lib/OPTIMADE/Filter/Parser.yp
Criterion Covered Total %
statement 190 206 92.2
branch 27 36 75.0
condition 6 9 66.6
subroutine 63 66 95.4
pod 0 4 0.0
total 286 321 89.1


line stmt bran cond sub pod time code
1             # Header section
2              
3             %{
4              
5 5     5   42 use warnings;
  5         10  
  5         213  
6              
7 5     5   26 use Scalar::Util qw(blessed);
  5         8  
  5         236  
8              
9 5     5   2052 use OPTIMADE::Filter::AndOr;
  5         16  
  5         155  
10 5     5   2092 use OPTIMADE::Filter::Comparison;
  5         13  
  5         153  
11 5     5   1975 use OPTIMADE::Filter::Known;
  5         14  
  5         143  
12 5     5   1943 use OPTIMADE::Filter::ListComparison;
  5         11  
  5         146  
13 5     5   1951 use OPTIMADE::Filter::Negation;
  5         13  
  5         142  
14 5     5   1982 use OPTIMADE::Filter::Property;
  5         11  
  5         147  
15 5     5   2102 use OPTIMADE::Filter::Zip;
  5         11  
  5         19207  
16              
17             our $allow_LIKE_operator = 0;
18              
19             %}
20              
21             %%
22 76     76 0 22504  
23 76 50       177 # Rules section
24              
25             # The top-level 'filter' rule
26              
27             filter: expression ;
28              
29             # Values
30              
31             constant: string | number ;
32              
33             value: string | number | property ;
34              
35             value_list: value
36             {
37 6     6   406 return [ [ '=', $_[1] ] ];
38             }
39             | operator value
40             {
41 6     6   501 return [ [ @_[1..$#_] ] ];
42             }
43             | value_list comma value
44             {
45 17     17   1124 push @{$_[1]}, [ '=', $_[3] ];
  17         46  
46 17         35 return $_[1];
47             }
48             | value_list comma operator value
49             {
50 17     17   1125 push @{$_[1]}, [ $_[3], $_[4] ];
  17         43  
51 17         32 return $_[1];
52             }
53             ;
54              
55             value_zip: value value_zip_part
56             {
57 9     9   322 return [ [ '=', $_[1] ], $_[2] ];
58             }
59             | operator value value_zip_part
60             {
61 13     13   463 return [ [ $_[1], $_[2] ], $_[3] ];
62             }
63             | value_zip value_zip_part
64             {
65 6     6   196 push @{$_[1]}, $_[2];
  6         13  
66 6         15 return $_[1];
67             }
68             ;
69              
70             value_zip_part: colon value
71             {
72 10     10   671 return [ '=', $_[2] ];
73             }
74             | colon operator value
75             {
76 18     18   1451 return [ $_[2], $_[3] ];
77             }
78             ;
79              
80             value_zip_list: value_zip
81             {
82 10     10   261 return [ $_[1] ];
83             }
84             | value_zip_list comma value_zip
85             {
86 10     10   222 push @{$_[1]}, $_[3];
  10         23  
87 10         16 return $_[1];
88             }
89             ;
90              
91             # Expressions
92              
93             expression: expression_clause
94             | expression_clause OR expression
95             {
96 7     7   555 return OPTIMADE::Filter::AndOr->new( @_[1..$#_] );
97             }
98             ;
99              
100             expression_clause: expression_phrase
101             | expression_phrase AND expression_clause
102             {
103 109     109   5583 return OPTIMADE::Filter::AndOr->new( @_[1..$#_] );
104             }
105             ;
106              
107             expression_phrase: comparison
108             | openingbrace expression closingbrace
109             {
110 156     156   20112 return $_[2];
111             }
112             | NOT comparison
113             {
114 5     5   368 return OPTIMADE::Filter::Negation->new( $_[2] );
115             }
116             | NOT openingbrace expression closingbrace
117             {
118 16     16   2462 return OPTIMADE::Filter::Negation->new( $_[3] );
119             }
120             ;
121              
122             comparison: constant_first_comparison | property_first_comparison ;
123              
124             constant_first_comparison: constant value_op_rhs
125             {
126 4     4   148 $_[2]->unshift_operand( $_[1] );
127 4         8 return $_[2];
128             }
129             ;
130              
131             property_first_comparison: property value_op_rhs
132             {
133 131     131   4611 $_[2]->unshift_operand( $_[1] );
134 131         254 return $_[2];
135             }
136             | property known_op_rhs
137             {
138 4     4   146 $_[2]->property( $_[1] );
139 4         7 return $_[2];
140             }
141             | property fuzzy_string_op_rhs
142             {
143 18     18   637 $_[2]->unshift_operand( $_[1] );
144 18         31 return $_[2];
145             }
146             | property set_op_rhs
147             {
148 16     16   606 $_[2]->property( $_[1] );
149 16         27 return $_[2];
150             }
151             | property set_zip_op_rhs
152             {
153 12     12   420 $_[2]->unshift_property( $_[1] );
154 12         23 return $_[2];
155             }
156             | property length_op_rhs
157             {
158 6     6   210 $_[2]->property( $_[1] );
159 6         10 return $_[2];
160             }
161             ;
162              
163             value_op_rhs: operator value
164             {
165 135     135   9614 my $cmp = OPTIMADE::Filter::Comparison->new( $_[1] );
166 135         322 $cmp->push_operand( $_[2] );
167 135         237 return $cmp;
168             }
169             ;
170              
171             known_op_rhs: IS KNOWN
172             {
173 2     2   88 return OPTIMADE::Filter::Known->new( 1 );
174             }
175             | IS UNKNOWN
176             {
177 2     2   72 return OPTIMADE::Filter::Known->new( 0 );
178             }
179             ;
180              
181             fuzzy_string_op_rhs: CONTAINS value
182             {
183 6     6   462 my $cmp = OPTIMADE::Filter::Comparison->new( $_[1] );
184 6         20 $cmp->push_operand( $_[2] );
185 6         13 return $cmp;
186             }
187             | STARTS value
188             {
189 2     2   143 my $cmp = OPTIMADE::Filter::Comparison->new( $_[1] );
190 2         6 $cmp->push_operand( $_[2] );
191 2         4 return $cmp;
192             }
193             | STARTS WITH value
194             {
195 6     6   429 my $cmp = OPTIMADE::Filter::Comparison->new( "$_[1] $_[2]" );
196 6         26 $cmp->push_operand( $_[3] );
197 6         11 return $cmp;
198             }
199             | ENDS value
200             {
201 0     0   0 my $cmp = OPTIMADE::Filter::Comparison->new( $_[1] );
202 0         0 $cmp->push_operand( $_[2] );
203 0         0 return $cmp;
204             }
205             | ENDS WITH value
206             {
207 2     2   140 my $cmp = OPTIMADE::Filter::Comparison->new( "$_[1] $_[2]" );
208 2         7 $cmp->push_operand( $_[3] );
209 2         4 return $cmp;
210             }
211             | LIKE value
212             {
213 2     2   143 my $cmp = OPTIMADE::Filter::Comparison->new( $_[1] );
214 2         6 $cmp->push_operand( $_[2] );
215 2         4 return $cmp;
216             }
217             ;
218              
219             set_op_rhs: HAS value
220             {
221 1     1   82 my $lc = OPTIMADE::Filter::ListComparison->new( $_[1] );
222 1         6 $lc->values( [ [ '=', $_[2] ] ] );
223 1         2 return $lc;
224             }
225             | HAS operator value
226             {
227 3     3   281 my $lc = OPTIMADE::Filter::ListComparison->new( $_[1] );
228 3         11 $lc->values( [ [ $_[2], $_[3] ] ] );
229 3         6 return $lc;
230             }
231             | HAS ALL value_list
232             {
233 4     4   119 my $lc = OPTIMADE::Filter::ListComparison->new( "$_[1] $_[2]" );
234 4         18 $lc->values( $_[3] );
235 4         11 return $lc;
236             }
237             | HAS ANY value_list
238             {
239 4     4   103 my $lc = OPTIMADE::Filter::ListComparison->new( "$_[1] $_[2]" );
240 4         12 $lc->values( $_[3] );
241 4         7 return $lc;
242             }
243             | HAS ONLY value_list
244             {
245 4     4   105 my $lc = OPTIMADE::Filter::ListComparison->new( "$_[1] $_[2]" );
246 4         12 $lc->values( $_[3] );
247 4         5 return $lc;
248             }
249             ;
250              
251             set_zip_op_rhs: property_zip_addon HAS value_zip
252             {
253 2     2   53 $_[1]->operator( $_[2] );
254 2         8 $_[1]->values( [ $_[3] ] );
255 2         4 return $_[1];
256             }
257             | property_zip_addon HAS ONLY value_zip_list
258             {
259 4     4   164 $_[1]->operator( "$_[2] $_[3]" );
260 4         10 $_[1]->values( $_[4] );
261 4         7 return $_[1];
262             }
263             | property_zip_addon HAS ALL value_zip_list
264             {
265 2     2   82 $_[1]->operator( "$_[2] $_[3]" );
266 2         6 $_[1]->values( $_[4] );
267 2         3 return $_[1];
268             }
269             | property_zip_addon HAS ANY value_zip_list
270             {
271 4     4   165 $_[1]->operator( "$_[2] $_[3]" );
272 4         12 $_[1]->values( $_[4] );
273 4         8 return $_[1];
274             }
275             ;
276              
277             property_zip_addon: colon property
278             {
279 12     12   285 my $zip = OPTIMADE::Filter::Zip->new;
280 12         34 $zip->push_property( $_[2] );
281 12         22 return $zip;
282             }
283             | property_zip_addon colon property
284             {
285 2     2   52 $_[1]->push_property( $_[3] );
286 2         4 return $_[1];
287             }
288             ;
289              
290             length_op_rhs: LENGTH value
291             {
292 0     0   0 my $cmp = OPTIMADE::Filter::ListComparison->new( $_[1] );
293 0         0 $cmp->values( [ [ '=', $_[2] ] ] );
294 0         0 return $cmp;
295             }
296             | LENGTH operator value
297             {
298 6     6   448 my $cmp = OPTIMADE::Filter::ListComparison->new( $_[1] );
299 6         21 $cmp->values( [ [ $_[2], $_[3] ] ] );
300 6         11 return $cmp;
301             }
302             ;
303              
304             # Property
305              
306             property: identifier
307             {
308 221     221   8702 return OPTIMADE::Filter::Property->new( $_[1] );
309             }
310             | property dot identifier
311             {
312 4     4   155 push @{$_[1]}, $_[3];
  4         78  
313 4         10 return $_[1];
314             }
315             ;
316              
317             # Separators
318              
319             openingbrace: '(' ;
320              
321             closingbrace: ')' ;
322              
323             dot: '.' ;
324              
325             comma: ',' ;
326              
327             colon: ':' ;
328              
329             # OperatorComparison operator tokens
330              
331             operator: '<'
332             | '<' '='
333             {
334 3     3   154 return join( '', @_[1..$#_] );
335             }
336             | '>'
337             | '>' '='
338             {
339 5     5   196 return join( '', @_[1..$#_] );
340             }
341             | '='
342             | '!' '='
343             {
344 4     4   145 return join( '', @_[1..$#_] );
345             }
346 76         16519 ;
347              
348             %%
349 76         9342  
350             # Footer section
351              
352             sub _Error
353             {
354 3     3   194 my( $self ) = @_;
355 3 50       48 close $self->{USER}{FILEIN} if $self->{USER}{FILEIN};
356 3         30 my $msg = "$0: syntax error at line $self->{USER}{LINENO}, " .
357             "position $self->{USER}{CHARNO}";
358 3 50       10 if( $self->YYData->{INPUT} ) {
359 3         30 $self->YYData->{INPUT} =~ s/\n$//;
360 3         36 die "$msg: '" . $self->YYData->{INPUT} . "'.\n";
361             } else {
362 0         0 die "$msg.\n";
363             }
364             }
365              
366             sub _Lexer
367             {
368 1418     1418   53826 my( $self ) = @_;
369              
370             # If the line is empty and the input is originating from the file,
371             # another line is read.
372 1418 100 100     2342 if( !$self->YYData->{INPUT} && $self->{USER}{FILEIN} ) {
373 38         458 my $filein = $self->{USER}{FILEIN};
374 38         69 $self->YYData->{INPUT} = <$filein>;
375 38 50       1473 $self->{USER}{LINENO} = -1 unless exists $self->{USER}{LINENO};
376 38         62 $self->{USER}{LINENO}++;
377 38         82 $self->{USER}{CHARNO} = 0;
378             }
379              
380 1418         8761 $self->YYData->{INPUT} =~ s/^(\s+)//;
381 1418 100       11470 $self->{USER}{CHARNO} += length( $1 ) if defined $1;
382              
383             # Escaped double quote or backslash are detected here and returned
384             # as is to the caller in order to be detected as syntax errors.
385 1418 50       2395 if( $self->YYData->{INPUT} =~ s/^(\\"|\\\\)// ) {
386 0         0 $self->{USER}{CHARNO} += length( $1 );
387 0         0 return( $1, $1 );
388             }
389              
390             # Handling strings
391 1418 100       8482 if( $self->YYData->{INPUT} =~ s/^"// ) {
392 172         1183 $self->{USER}{CHARNO} ++;
393 172         261 my $string = '';
394 172         184 while( 1 ) {
395 352 100       628 if( $self->YYData->{INPUT} =~
    100          
    100          
396 5     5   3096 s/^([A-Za-z_0-9 \t!#\$\%&\'\(\)\*\+,\-\.\/\:;<=>\?@\[\]\^`\{\|\}\~\P{ASCII}]+)// ) {
  5         124  
  5         91  
397 176         1401 $self->{USER}{CHARNO} += length( $1 );
398 176         357 $string .= $1;
399             } elsif( $self->YYData->{INPUT} =~ s/^\\([\\"])// ) {
400 4         50 $self->{USER}{CHARNO} ++;
401 4         5 $string .= $1;
402 4         8 next;
403             } elsif( $self->YYData->{INPUT} =~ s/^"// ) {
404 171         2988 $self->{USER}{CHARNO} ++;
405 171         558 return( 'string', $string );
406             } else {
407 1         19 return( undef, undef );
408             }
409             }
410             }
411              
412             # Handling identifiers
413 1246 100       7003 if( $self->YYData->{INPUT} =~ s/^([a-z_][a-z0-9_]*)// ) {
414 225         1817 $self->{USER}{CHARNO} += length( $1 );
415 225         766 return( 'identifier', $1 );
416             }
417              
418             # Handling boolean relations
419 1021 100       6277 if( $self->YYData->{INPUT} =~ s/^(AND|NOT|OR|
420             IS|UNKNOWN|KNOWN|
421             CONTAINS|STARTS|ENDS|WITH|
422             LENGTH|HAS|ALL|ONLY|ANY)//x ) {
423 226         1845 $self->{USER}{CHARNO} += length( $1 );
424 226         774 return( $1, $1 );
425             }
426              
427             # Handling LIKE operator if allowed
428 795 100 100     4868 if( $allow_LIKE_operator && $self->YYData->{INPUT} =~ s/^(LIKE)// ) {
429 2         25 $self->{USER}{CHARNO} += length( $1 );
430 2         10 return( $1, $1 );
431             }
432              
433             # Handling numbers
434 793 100       1282 if( $self->YYData->{INPUT} =~ s/^([+-]?
435             (\d+\.?\d*|\.\d+)
436             ([eE][+-]?\d+)?)//x ) {
437 74         702 $self->{USER}{CHARNO} += length( $1 );
438 74         245 return( 'number', $1 );
439             }
440              
441 719         4813 my $char = substr( $self->YYData->{INPUT}, 0, 1 );
442 719 100       4310 if( $char ne '' ) {
443 646         987 $self->YYData->{INPUT} = substr( $self->YYData->{INPUT}, 1 );
444             }
445 719         5852 $self->{USER}{CHARNO}++;
446 719         1758 return( $char, $char );
447             }
448              
449             sub Run
450             {
451 38     38 0 227 my( $self, $filename ) = @_;
452 38         1636 open $self->{USER}{FILEIN}, $filename;
453 38         285 my $result = $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error );
454 35         5569 close $self->{USER}{FILEIN};
455 35         175 return $result;
456             }
457              
458             sub parse_string
459             {
460 38     38 0 214 my( $self, $string ) = @_;
461 38         104 $self->YYData->{INPUT} = $string;
462 38         350 $self->{USER}{LINENO} = 0;
463 38         60 $self->{USER}{CHARNO} = 0;
464 38         135 return $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error );
465             }
466              
467             sub modify
468             {
469 0     0 0   my $node = shift;
470 0           my $code = shift;
471              
472 0 0 0       if( blessed $node && $node->can( 'modify' ) ) {
    0          
473 0           return $node->modify( $code, @_ );
474             } elsif( ref $node eq 'ARRAY' ) {
475 0           return [ map { modify( $_, $code, @_ ) } @$node ];
  0            
476             } else {
477 0           return $code->( $node, @_ );
478             }
479             }
480              
481             1;