Teach QueryParser about search filter callbacks, and if a callback returns a value...
[working/Evergreen.git] / Open-ILS / src / perlmods / lib / OpenILS / Application / Storage / QueryParser.pm
1 use strict;
2 use warnings;
3
4 package QueryParser;
5 use OpenSRF::Utils::JSON;
6 our %parser_config = (
7     QueryParser => {
8         filters => [],
9         modifiers => [],
10         operators => { 
11             'and' => '&&',
12             'or' => '||',
13             group_start => '(',
14             group_end => ')',
15             required => '+',
16             disallowed => '-',
17             modifier => '#'
18         }
19     }
20 );
21
22 sub facet_class_count {
23     my $self = shift;
24     return @{$self->facet_classes};
25 }
26
27 sub search_class_count {
28     my $self = shift;
29     return @{$self->search_classes};
30 }
31
32 sub filter_count {
33     my $self = shift;
34     return @{$self->filters};
35 }
36
37 sub modifier_count {
38     my $self = shift;
39     return @{$self->modifiers};
40 }
41
42 sub custom_data {
43     my $class = shift;
44     $class = ref($class) || $class;
45
46     $parser_config{$class}{custom_data} ||= {};
47     return $parser_config{$class}{custom_data};
48 }
49
50 sub operators {
51     my $class = shift;
52     $class = ref($class) || $class;
53
54     $parser_config{$class}{operators} ||= {};
55     return $parser_config{$class}{operators};
56 }
57
58 sub filters {
59     my $class = shift;
60     $class = ref($class) || $class;
61
62     $parser_config{$class}{filters} ||= [];
63     return $parser_config{$class}{filters};
64 }
65
66 sub filter_callbacks {
67     my $class = shift;
68     $class = ref($class) || $class;
69
70     $parser_config{$class}{filter_callbacks} ||= {};
71     return $parser_config{$class}{filter_callbacks};
72 }
73
74 sub modifiers {
75     my $class = shift;
76     $class = ref($class) || $class;
77
78     $parser_config{$class}{modifiers} ||= [];
79     return $parser_config{$class}{modifiers};
80 }
81
82 sub new {
83     my $class = shift;
84     $class = ref($class) || $class;
85
86     my %opts = @_;
87
88     my $self = bless {} => $class;
89
90     for my $o (keys %{QueryParser->operators}) {
91         $class->operator($o => QueryParser->operator($o)) unless ($class->operator($o));
92     }
93
94     for my $opt ( keys %opts) {
95         $self->$opt( $opts{$opt} ) if ($self->can($opt));
96     }
97
98     return $self;
99 }
100
101 sub new_plan {
102     my $self = shift;
103     my $pkg = ref($self) || $self;
104     return do{$pkg.'::query_plan'}->new( QueryParser => $self, @_ );
105 }
106
107 sub add_search_filter {
108     my $pkg = shift;
109     $pkg = ref($pkg) || $pkg;
110     my $filter = shift;
111     my $callback = shift;
112
113     return $filter if (grep { $_ eq $filter } @{$pkg->filters});
114     push @{$pkg->filters}, $filter;
115     $pkg->filter_callbacks->{$filter} = $callback if ($callback);
116     return $filter;
117 }
118
119 sub add_search_modifier {
120     my $pkg = shift;
121     $pkg = ref($pkg) || $pkg;
122     my $modifier = shift;
123
124     return $modifier if (grep { $_ eq $modifier } @{$pkg->modifiers});
125     push @{$pkg->modifiers}, $modifier;
126     return $modifier;
127 }
128
129 sub add_facet_class {
130     my $pkg = shift;
131     $pkg = ref($pkg) || $pkg;
132     my $class = shift;
133
134     return $class if (grep { $_ eq $class } @{$pkg->facet_classes});
135
136     push @{$pkg->facet_classes}, $class;
137     $pkg->facet_fields->{$class} = [];
138
139     return $class;
140 }
141
142 sub add_search_class {
143     my $pkg = shift;
144     $pkg = ref($pkg) || $pkg;
145     my $class = shift;
146
147     return $class if (grep { $_ eq $class } @{$pkg->search_classes});
148
149     push @{$pkg->search_classes}, $class;
150     $pkg->search_fields->{$class} = [];
151     $pkg->default_search_class( $pkg->search_classes->[0] ) if (@{$pkg->search_classes} == 1);
152
153     return $class;
154 }
155
156 sub operator {
157     my $class = shift;
158     $class = ref($class) || $class;
159     my $opname = shift;
160     my $op = shift;
161
162     return undef unless ($opname);
163
164     $parser_config{$class}{operators} ||= {};
165     $parser_config{$class}{operators}{$opname} = $op if ($op);
166
167     return $parser_config{$class}{operators}{$opname};
168 }
169
170 sub facet_classes {
171     my $class = shift;
172     $class = ref($class) || $class;
173     my $classes = shift;
174
175     $parser_config{$class}{facet_classes} ||= [];
176     $parser_config{$class}{facet_classes} = $classes if (ref($classes) && @$classes);
177     return $parser_config{$class}{facet_classes};
178 }
179
180 sub search_classes {
181     my $class = shift;
182     $class = ref($class) || $class;
183     my $classes = shift;
184
185     $parser_config{$class}{classes} ||= [];
186     $parser_config{$class}{classes} = $classes if (ref($classes) && @$classes);
187     return $parser_config{$class}{classes};
188 }
189
190 sub add_query_normalizer {
191     my $pkg = shift;
192     $pkg = ref($pkg) || $pkg;
193     my $class = shift;
194     my $field = shift;
195     my $func = shift;
196     my $params = shift || [];
197
198     # do not add if function AND params are identical to existing member
199     return $func if (grep {
200         $_->{function} eq $func and 
201         OpenSRF::Utils::JSON->perl2JSON($_->{params}) eq OpenSRF::Utils::JSON->perl2JSON($params)
202     } @{$pkg->query_normalizers->{$class}->{$field}});
203
204     push(@{$pkg->query_normalizers->{$class}->{$field}}, { function => $func, params => $params });
205
206     return $func;
207 }
208
209 sub query_normalizers {
210     my $pkg = shift;
211     $pkg = ref($pkg) || $pkg;
212
213     my $class = shift;
214     my $field = shift;
215
216     $parser_config{$pkg}{normalizers} ||= {};
217     if ($class) {
218         if ($field) {
219             $parser_config{$pkg}{normalizers}{$class}{$field} ||= [];
220             return $parser_config{$pkg}{normalizers}{$class}{$field};
221         } else {
222             return $parser_config{$pkg}{normalizers}{$class};
223         }
224     }
225
226     return $parser_config{$pkg}{normalizers};
227 }
228
229 sub add_filter_normalizer {
230     my $pkg = shift;
231     $pkg = ref($pkg) || $pkg;
232     my $filter = shift;
233     my $func = shift;
234     my $params = shift || [];
235
236     return $func if (grep { $_ eq $func } @{$pkg->filter_normalizers->{$filter}});
237
238     push(@{$pkg->filter_normalizers->{$filter}}, { function => $func, params => $params });
239
240     return $func;
241 }
242
243 sub filter_normalizers {
244     my $pkg = shift;
245     $pkg = ref($pkg) || $pkg;
246
247     my $filter = shift;
248
249     $parser_config{$pkg}{filter_normalizers} ||= {};
250     if ($filter) {
251         $parser_config{$pkg}{filter_normalizers}{$filter} ||= [];
252         return $parser_config{$pkg}{filter_normalizers}{$filter};
253     }
254
255     return $parser_config{$pkg}{filter_normalizers};
256 }
257
258 sub default_search_class {
259     my $pkg = shift;
260     $pkg = ref($pkg) || $pkg;
261     my $class = shift;
262     $QueryParser::parser_config{$pkg}{default_class} = $pkg->add_search_class( $class ) if $class;
263
264     return $QueryParser::parser_config{$pkg}{default_class};
265 }
266
267 sub remove_facet_class {
268     my $pkg = shift;
269     $pkg = ref($pkg) || $pkg;
270     my $class = shift;
271
272     return $class if (!grep { $_ eq $class } @{$pkg->facet_classes});
273
274     $pkg->facet_classes( [ grep { $_ ne $class } @{$pkg->facet_classes} ] );
275     delete $QueryParser::parser_config{$pkg}{facet_fields}{$class};
276
277     return $class;
278 }
279
280 sub remove_search_class {
281     my $pkg = shift;
282     $pkg = ref($pkg) || $pkg;
283     my $class = shift;
284
285     return $class if (!grep { $_ eq $class } @{$pkg->search_classes});
286
287     $pkg->search_classes( [ grep { $_ ne $class } @{$pkg->search_classes} ] );
288     delete $QueryParser::parser_config{$pkg}{fields}{$class};
289
290     return $class;
291 }
292
293 sub add_facet_field {
294     my $pkg = shift;
295     $pkg = ref($pkg) || $pkg;
296     my $class = shift;
297     my $field = shift;
298
299     $pkg->add_facet_class( $class );
300
301     return { $class => $field }  if (grep { $_ eq $field } @{$pkg->facet_fields->{$class}});
302
303     push @{$pkg->facet_fields->{$class}}, $field;
304
305     return { $class => $field };
306 }
307
308 sub facet_fields {
309     my $class = shift;
310     $class = ref($class) || $class;
311
312     $parser_config{$class}{facet_fields} ||= {};
313     return $parser_config{$class}{facet_fields};
314 }
315
316 sub add_search_field {
317     my $pkg = shift;
318     $pkg = ref($pkg) || $pkg;
319     my $class = shift;
320     my $field = shift;
321
322     $pkg->add_search_class( $class );
323
324     return { $class => $field }  if (grep { $_ eq $field } @{$pkg->search_fields->{$class}});
325
326     push @{$pkg->search_fields->{$class}}, $field;
327
328     return { $class => $field };
329 }
330
331 sub search_fields {
332     my $class = shift;
333     $class = ref($class) || $class;
334
335     $parser_config{$class}{fields} ||= {};
336     return $parser_config{$class}{fields};
337 }
338
339 sub add_search_class_alias {
340     my $pkg = shift;
341     $pkg = ref($pkg) || $pkg;
342     my $class = shift;
343     my $alias = shift;
344
345     $pkg->add_search_class( $class );
346
347     return { $class => $alias }  if (grep { $_ eq $alias } @{$pkg->search_class_aliases->{$class}});
348
349     push @{$pkg->search_class_aliases->{$class}}, $alias;
350
351     return { $class => $alias };
352 }
353
354 sub search_class_aliases {
355     my $class = shift;
356     $class = ref($class) || $class;
357
358     $parser_config{$class}{class_map} ||= {};
359     return $parser_config{$class}{class_map};
360 }
361
362 sub add_search_field_alias {
363     my $pkg = shift;
364     $pkg = ref($pkg) || $pkg;
365     my $class = shift;
366     my $field = shift;
367     my $alias = shift;
368
369     return { $class => { $field => $alias } }  if (grep { $_ eq $alias } @{$pkg->search_field_aliases->{$class}{$field}});
370
371     push @{$pkg->search_field_aliases->{$class}{$field}}, $alias;
372
373     return { $class => { $field => $alias } };
374 }
375
376 sub search_field_aliases {
377     my $class = shift;
378     $class = ref($class) || $class;
379
380     $parser_config{$class}{field_alias_map} ||= {};
381     return $parser_config{$class}{field_alias_map};
382 }
383
384 sub remove_facet_field {
385     my $pkg = shift;
386     $pkg = ref($pkg) || $pkg;
387     my $class = shift;
388     my $field = shift;
389
390     return { $class => $field }  if (!$pkg->facet_fields->{$class} || !grep { $_ eq $field } @{$pkg->facet_fields->{$class}});
391
392     $pkg->facet_fields->{$class} = [ grep { $_ ne $field } @{$pkg->facet_fields->{$class}} ];
393
394     return { $class => $field };
395 }
396
397 sub remove_search_field {
398     my $pkg = shift;
399     $pkg = ref($pkg) || $pkg;
400     my $class = shift;
401     my $field = shift;
402
403     return { $class => $field }  if (!$pkg->search_fields->{$class} || !grep { $_ eq $field } @{$pkg->search_fields->{$class}});
404
405     $pkg->search_fields->{$class} = [ grep { $_ ne $field } @{$pkg->search_fields->{$class}} ];
406
407     return { $class => $field };
408 }
409
410 sub remove_search_field_alias {
411     my $pkg = shift;
412     $pkg = ref($pkg) || $pkg;
413     my $class = shift;
414     my $field = shift;
415     my $alias = shift;
416
417     return { $class => { $field => $alias } }  if (!$pkg->search_field_aliases->{$class}{$field} || !grep { $_ eq $alias } @{$pkg->search_field_aliases->{$class}{$field}});
418
419     $pkg->search_field_aliases->{$class}{$field} = [ grep { $_ ne $alias } @{$pkg->search_field_aliases->{$class}{$field}} ];
420
421     return { $class => { $field => $alias } };
422 }
423
424 sub remove_search_class_alias {
425     my $pkg = shift;
426     $pkg = ref($pkg) || $pkg;
427     my $class = shift;
428     my $alias = shift;
429
430     return { $class => $alias }  if (!$pkg->search_class_aliases->{$class} || !grep { $_ eq $alias } @{$pkg->search_class_aliases->{$class}});
431
432     $pkg->search_class_aliases->{$class} = [ grep { $_ ne $alias } @{$pkg->search_class_aliases->{$class}} ];
433
434     return { $class => $alias };
435 }
436
437 sub debug {
438     my $self = shift;
439     my $q = shift;
440     $self->{_debug} = $q if (defined $q);
441     return $self->{_debug};
442 }
443
444 sub query {
445     my $self = shift;
446     my $q = shift;
447     $self->{_query} = $q if (defined $q);
448     return $self->{_query};
449 }
450
451 sub parse_tree {
452     my $self = shift;
453     my $q = shift;
454     $self->{_parse_tree} = $q if (defined $q);
455     return $self->{_parse_tree};
456 }
457
458 sub parse {
459     my $self = shift;
460     my $pkg = ref($self) || $self;
461     warn " ** parse package is $pkg\n" if $self->debug;
462     $self->parse_tree(
463         $self->decompose(
464             $self->query( shift() )
465         )
466     );
467
468     return $self;
469 }
470
471 sub decompose {
472     my $self = shift;
473     my $pkg = ref($self) || $self;
474
475     warn " ** decompose package is $pkg\n" if $self->debug;
476
477     $_ = shift;
478     my $current_class = shift || $self->default_search_class;
479
480     my $recursing = shift || 0;
481     my $phrase_helper = shift || 0;
482
483     # Build the search class+field uber-regexp
484     my $search_class_re = '^\s*(';
485     my $first_class = 1;
486
487     my %seen_classes;
488     for my $class ( keys %{$pkg->search_field_aliases} ) {
489         warn " *** ... Looking for search fields in $class\n" if $self->debug;
490
491         for my $field ( keys %{$pkg->search_field_aliases->{$class}} ) {
492             warn " *** ... Looking for aliases of $field\n" if $self->debug;
493
494             for my $alias ( @{$pkg->search_field_aliases->{$class}{$field}} ) {
495                 my $aliasr = qr/$alias/;
496                 s/(^|\s+)$aliasr\|/$1$class\|$field#$alias\|/g;
497                 s/(^|\s+)$aliasr[:=]/$1$class\|$field#$alias:/g;
498                 warn " *** Rewriting: $alias ($aliasr) as $class\|$field\n" if $self->debug;
499             }
500         }
501
502         $search_class_re .= '|' unless ($first_class);
503         $first_class = 0;
504         $search_class_re .= $class . '(?:[|#][^:|]+)*';
505         $seen_classes{$class} = 1;
506     }
507
508     for my $class ( keys %{$pkg->search_class_aliases} ) {
509
510         for my $alias ( @{$pkg->search_class_aliases->{$class}} ) {
511             my $aliasr = qr/$alias/;
512             s/(^|[^|])\b$aliasr\|/$1$class#$alias\|/g;
513             s/(^|[^|])\b$aliasr[:=]/$1$class#$alias:/g;
514             warn " *** Rewriting: $alias ($aliasr) as $class\n" if $self->debug;
515         }
516
517         if (!$seen_classes{$class}) {
518             $search_class_re .= '|' unless ($first_class);
519             $first_class = 0;
520
521             $search_class_re .= $class . '(?:[|#][^:|]+)*';
522             $seen_classes{$class} = 1;
523         }
524     }
525     $search_class_re .= '):';
526
527     warn " ** Rewritten query: $_\n" if $self->debug;
528     warn " ** Search class RE: $search_class_re\n" if $self->debug;
529
530     my $required_re = $pkg->operator('required');
531     $required_re = qr/\Q$required_re\E/;
532
533     my $disallowed_re = $pkg->operator('disallowed');
534     $disallowed_re = qr/\Q$disallowed_re\E/;
535
536     my $and_re = $pkg->operator('and');
537     $and_re = qr/^\s*\Q$and_re\E/;
538
539     my $or_re = $pkg->operator('or');
540     $or_re = qr/^\s*\Q$or_re\E/;
541
542     my $group_start_re = $pkg->operator('group_start');
543     $group_start_re = qr/^\s*\Q$group_start_re\E/;
544
545     my $group_end = $pkg->operator('group_end');
546     my $group_end_re = qr/^\s*\Q$group_end\E/;
547
548     my $modifier_tag_re = $pkg->operator('modifier');
549     $modifier_tag_re = qr/^\s*\Q$modifier_tag_re\E/;
550
551
552     # Build the filter and modifier uber-regexps
553     my $facet_re = '^\s*(-?)((?:' . join( '|', @{$pkg->facet_classes}) . ')(?:\|\w+)*)\[(.+?)\]';
554     warn " ** Facet RE: $facet_re\n" if $self->debug;
555
556     my $filter_re = '^\s*(-?)(' . join( '|', @{$pkg->filters}) . ')\(([^()]+)\)';
557     my $filter_as_class_re = '^\s*(-?)(' . join( '|', @{$pkg->filters}) . '):\s*(\S+)';
558
559     my $modifier_re = '^\s*'.$modifier_tag_re.'(' . join( '|', @{$pkg->modifiers}) . ')\b';
560     my $modifier_as_class_re = '^\s*(' . join( '|', @{$pkg->modifiers}) . '):\s*(\S+)';
561
562     my $struct = $self->new_plan( level => $recursing );
563     my $remainder = '';
564
565     my $last_type = '';
566     while (!$remainder) {
567         if (/^\s*$/) { # end of an explicit group
568             last;
569         } elsif (/$group_end_re/) { # end of an explicit group
570             warn "Encountered explicit group end\n" if $self->debug;
571
572             $_ = $';
573             $remainder = $struct->top_plan ? '' : $';
574
575             $last_type = '';
576         } elsif ($self->filter_count && /$filter_re/) { # found a filter
577             warn "Encountered search filter: $1$2 set to $3\n" if $self->debug;
578
579             my $negate = ($1 eq $pkg->operator('disallowed')) ? 1 : 0;
580             $_ = $';
581
582             my $filter = $2;
583             my $params = [ split '[,]+', $3 ];
584
585             if ($pkg->filter_callbacks->{$filter}) {
586                 my $replacement = $pkg->filter_callbacks->{$filter}->($self, $struct, $filter, $params, $negate);
587                 $_ = "$replacement $_" if ($replacement);
588             } else {
589                 $struct->new_filter( $filter => $params, $negate );
590             }
591
592
593             $last_type = '';
594         } elsif ($self->filter_count && /$filter_as_class_re/) { # found a filter
595             warn "Encountered search filter: $1$2 set to $3\n" if $self->debug;
596
597             my $negate = ($1 eq $pkg->operator('disallowed')) ? 1 : 0;
598             $_ = $';
599
600             my $filter = $2;
601             my $params = [ split '[,]+', $3 ];
602
603             if ($pkg->filter_callbacks->{$filter}) {
604                 my $replacement = $pkg->filter_callbacks->{$filter}->($self, $struct, $filter, $params, $negate);
605                 $_ = "$replacement $_" if ($replacement);
606             } else {
607                 $struct->new_filter( $filter => $params, $negate );
608             }
609
610             $last_type = '';
611         } elsif ($self->modifier_count && /$modifier_re/) { # found a modifier
612             warn "Encountered search modifier: $1\n" if $self->debug;
613
614             $_ = $';
615             if (!$struct->top_plan) {
616                 warn "  Search modifiers only allowed at the top level of the query\n" if $self->debug;
617             } else {
618                 $struct->new_modifier($1);
619             }
620
621             $last_type = '';
622         } elsif ($self->modifier_count && /$modifier_as_class_re/) { # found a modifier
623             warn "Encountered search modifier: $1\n" if $self->debug;
624
625             my $mod = $1;
626
627             $_ = $';
628             if (!$struct->top_plan) {
629                 warn "  Search modifiers only allowed at the top level of the query\n" if $self->debug;
630             } elsif ($2 =~ /^[ty1]/i) {
631                 $struct->new_modifier($mod);
632             }
633
634             $last_type = '';
635         } elsif (/$group_start_re/) { # start of an explicit group
636             warn "Encountered explicit group start\n" if $self->debug;
637
638             my ($substruct, $subremainder) = $self->decompose( $', $current_class, $recursing + 1 );
639             $struct->add_node( $substruct ) if ($substruct);
640             $_ = $subremainder;
641
642             $last_type = '';
643         } elsif (/$and_re/) { # ANDed expression
644             $_ = $';
645             next if ($last_type eq 'AND');
646             next if ($last_type eq 'OR');
647             warn "Encountered AND\n" if $self->debug;
648
649             $struct->joiner( '&' );
650
651             $last_type = 'AND';
652         } elsif (/$or_re/) { # ORed expression
653             $_ = $';
654             next if ($last_type eq 'AND');
655             next if ($last_type eq 'OR');
656             warn "Encountered OR\n" if $self->debug;
657
658             $struct->joiner( '|' );
659
660             $last_type = 'OR';
661         } elsif ($self->facet_class_count && /$facet_re/) { # changing current class
662             warn "Encountered facet: $1$2 => $3\n" if $self->debug;
663
664             my $negate = ($1 eq $pkg->operator('disallowed')) ? 1 : 0;
665             my $facet = $2;
666             my $facet_value = [ split '\s*#\s*', $3 ];
667             $struct->new_facet( $facet => $facet_value, $negate );
668             $_ = $';
669
670             $last_type = '';
671         } elsif ($self->search_class_count && /$search_class_re/) { # changing current class
672
673             if ($last_type eq 'CLASS') {
674                 $struct->remove_last_node( $current_class );
675                 warn "Encountered class change with no searches!\n" if $self->debug;
676             }
677
678             warn "Encountered class change: $1\n" if $self->debug;
679
680             $current_class = $struct->classed_node( $1 )->requested_class();
681             $_ = $';
682
683             $last_type = 'CLASS';
684         } elsif (/^\s*($required_re|$disallowed_re)?"([^"]+)"/) { # phrase, always anded
685             warn 'Encountered' . ($1 ? " ['$1' modified]" : '') . " phrase: $2\n" if $self->debug;
686
687             my $req_ness = $1 || '';
688             my $phrase = $2;
689
690             if (!$phrase_helper) {
691                 warn "Recursing into decompose with the phrase as a subquery\n" if $self->debug;
692                 my $after = $';
693                 my ($substruct, $subremainder) = $self->decompose( qq/$req_ness"$phrase"/, $current_class, $recursing + 1, 1 );
694                 $struct->add_node( $substruct ) if ($substruct);
695                 $_ = $after;
696             } else {
697                 warn "Directly parsing the phrase subquery\n" if $self->debug;
698                 $struct->joiner( '&' );
699
700                 my $class_node = $struct->classed_node($current_class);
701
702                 if ($req_ness eq $pkg->operator('disallowed')) {
703                     $class_node->add_dummy_atom( node => $class_node );
704                     $class_node->add_unphrase( $phrase );
705                     $phrase = '';
706                     #$phrase =~ s/(^|\s)\b/$1-/g;
707                 } else { 
708                     $class_node->add_phrase( $phrase );
709                 }
710                 $_ = $phrase . $';
711
712             }
713
714             $last_type = '';
715
716 #        } elsif (/^\s*$required_re([^\s"]+)/) { # phrase, always anded
717 #            warn "Encountered required atom (mini phrase): $1\n" if $self->debug;
718 #
719 #            my $phrase = $1;
720 #
721 #            my $class_node = $struct->classed_node($current_class);
722 #            $class_node->add_phrase( $phrase );
723 #            $_ = $phrase . $';
724 #            $struct->joiner( '&' );
725 #
726 #            $last_type = '';
727         } elsif (/^\s*([^$group_end\s]+)/o) { # atom
728             warn "Encountered atom: $1\n" if $self->debug;
729             warn "Remainder: $'\n" if $self->debug;
730
731             my $atom = $1;
732             my $after = $';
733
734             $_ = $after;
735             $last_type = '';
736
737             my $class_node = $struct->classed_node($current_class);
738
739             my $prefix = ($atom =~ s/^$disallowed_re//o) ? '!' : '';
740             my $truncate = ($atom =~ s/\*$//o) ? '*' : '';
741
742             if ($atom ne '' and !grep { $atom =~ /^\Q$_\E+$/ } ('&','|','-','+')) { # throw away & and |, not allowed in tsquery, and not really useful anyway
743 #                $class_node->add_phrase( $atom ) if ($atom =~ s/^$required_re//o);
744 #                $class_node->add_unphrase( $atom ) if ($prefix eq '!');
745
746                 $class_node->add_fts_atom( $atom, suffix => $truncate, prefix => $prefix, node => $class_node );
747                 $struct->joiner( '&' );
748             }
749         } 
750
751         last unless ($_);
752
753     }
754
755     $struct = undef if 
756         scalar(@{$struct->query_nodes}) == 0 &&
757         scalar(@{$struct->filters}) == 0 &&
758         !$struct->top_plan;
759
760     return $struct if !wantarray;
761     return ($struct, $remainder);
762 }
763
764 sub find_class_index {
765     my $class = shift;
766     my $query = shift;
767
768     my ($class_part, @field_parts) = split '\|', $class;
769     $class_part ||= $class;
770
771     for my $idx ( 0 .. scalar(@$query) - 1 ) {
772         next unless ref($$query[$idx]);
773         return $idx if ( $$query[$idx]{requested_class} && $class eq $$query[$idx]{requested_class} );
774     }
775
776     push(@$query, { classname => $class_part, (@field_parts ? (fields => \@field_parts) : ()), requested_class => $class, ftsquery => [], phrases => [] });
777     return -1;
778 }
779
780 sub core_limit {
781     my $self = shift;
782     my $l = shift;
783     $self->{core_limit} = $l if ($l);
784     return $self->{core_limit};
785 }
786
787 sub superpage {
788     my $self = shift;
789     my $l = shift;
790     $self->{superpage} = $l if ($l);
791     return $self->{superpage};
792 }
793
794 sub superpage_size {
795     my $self = shift;
796     my $l = shift;
797     $self->{superpage_size} = $l if ($l);
798     return $self->{superpage_size};
799 }
800
801
802 #-------------------------------
803 package QueryParser::_util;
804
805 # At this level, joiners are always & or |.  This is not
806 # the external, configurable representation of joiners that
807 # defaults to # && and ||.
808 sub is_joiner {
809     my $str = shift;
810
811     return (not ref $str and ($str eq '&' or $str eq '|'));
812 }
813
814 sub default_joiner { '&' }
815
816 # 0 for different, 1 for the same.
817 sub compare_abstract_atoms {
818     my ($left, $right) = @_;
819
820     foreach (qw/prefix suffix content/) {
821         no warnings;    # undef can stand in for '' here
822         return 0 unless $left->{$_} eq $right->{$_};
823     }
824
825     return 1;
826 }
827
828 sub fake_abstract_atom_from_phrase {
829     my ($phrase, $neg) = @_;
830
831     my $prefix = '"';
832     if ($neg) {
833         $prefix =
834             $QueryParser::parser_config{QueryParser}{operators}{disallowed} .
835             $prefix;
836     }
837
838     return {
839         "type" => "atom", "prefix" => $prefix, "suffix" => '"',
840         "content" => $phrase
841     }
842 }
843
844 sub find_arrays_in_abstract {
845     my ($hash) = @_;
846
847     my @arrays;
848     foreach my $key (keys %$hash) {
849         if (ref $hash->{$key} eq "ARRAY") {
850             push @arrays, $hash->{$key};
851             foreach (@{$hash->{$key}}) {
852                 push @arrays, find_arrays_in_abstract($_);
853             }
854         }
855     }
856
857     return @arrays;
858 }
859
860 #-------------------------------
861 package QueryParser::Canonicalize;  # not OO
862
863 sub _abstract_query2str_filter {
864     my $f = shift;
865     my $qpconfig = $parser_config{QueryParser};
866
867     return sprintf(
868         "%s%s(%s)",
869         $f->{negate} ? $qpconfig->{operators}{disallowed} : "",
870         $f->{name},
871         join(",", @{$f->{args}})
872     );
873 }
874
875 sub _abstract_query2str_modifier {
876     my $f = shift;
877     my $qpconfig = $parser_config{QueryParser};
878
879     return $qpconfig->{operators}{modifier} . $f;
880 }
881
882 # This should produce an equivalent query to the original, given an
883 # abstract_query.
884 sub abstract_query2str_impl {
885     my ($abstract_query, $depth) = @_;
886
887     my $qpconfig = $parser_config{QueryParser};
888
889     my $gs = $qpconfig->{operators}{group_start};
890     my $ge = $qpconfig->{operators}{group_end};
891     my $and = $qpconfig->{operators}{and};
892     my $or = $qpconfig->{operators}{or};
893
894     my $q = "";
895     $q .= $gs if $abstract_query->{type} and $abstract_query->{type} eq "query_plan" and $depth;
896
897     if (exists $abstract_query->{type}) {
898         if ($abstract_query->{type} eq 'query_plan') {
899             $q .= join(" ", map { _abstract_query2str_filter($_) } @{$abstract_query->{filters}}) if
900                 exists $abstract_query->{filters};
901             $q .= " ";
902
903             $q .= join(" ", map { _abstract_query2str_modifier($_) } @{$abstract_query->{modifiers}}) if
904                 exists $abstract_query->{modifiers};
905         } elsif ($abstract_query->{type} eq 'node') {
906             if ($abstract_query->{alias}) {
907                 $q .= " " . $abstract_query->{alias};
908                 $q .= "|$_" foreach @{$abstract_query->{alias_fields}};
909             } else {
910                 $q .= " " . $abstract_query->{class};
911                 $q .= "|$_" foreach @{$abstract_query->{fields}};
912             }
913             $q .= ":";
914         } elsif ($abstract_query->{type} eq 'atom') {
915             my $prefix = $abstract_query->{prefix} || '';
916             $prefix = $qpconfig->{operators}{disallowed} if $prefix eq '!';
917             $q .= $prefix .
918                 ($abstract_query->{content} || '') .
919                 ($abstract_query->{suffix} || '');
920         } elsif ($abstract_query->{type} eq 'facet') {
921             # facet syntax [ # ] is hardcoded I guess?
922             my $prefix = $abstract_query->{negate} ? $qpconfig->{operators}{disallowed} : '';
923             $q .= $prefix . $abstract_query->{name} . "[" .
924                 join(" # ", @{$abstract_query->{values}}) . "]";
925         }
926     }
927
928     if (exists $abstract_query->{children}) {
929         my $op = (keys(%{$abstract_query->{children}}))[0];
930         $q .= join(
931             " " . ($op eq '&' ? $and : $or) . " ",
932             map {
933                 abstract_query2str_impl($_, $depth + 1)
934             } @{$abstract_query->{children}{$op}}
935         );
936     } elsif ($abstract_query->{'&'} or $abstract_query->{'|'}) {
937         my $op = (keys(%{$abstract_query}))[0];
938         $q .= join(
939             " " . ($op eq '&' ? $and : $or) . " ",
940             map {
941                 abstract_query2str_impl($_, $depth + 1)
942             } @{$abstract_query->{$op}}
943         );
944     }
945     $q .= " ";
946
947     $q .= $ge if $abstract_query->{type} and $abstract_query->{type} eq "query_plan" and $depth;
948
949     return $q;
950 }
951
952 #-------------------------------
953 package QueryParser::query_plan;
954
955 sub QueryParser {
956     my $self = shift;
957     return undef unless ref($self);
958     return $self->{QueryParser};
959 }
960
961 sub new {
962     my $pkg = shift;
963     $pkg = ref($pkg) || $pkg;
964     my %args = (query => [], joiner => '&', @_);
965
966     return bless \%args => $pkg;
967 }
968
969 sub new_node {
970     my $self = shift;
971     my $pkg = ref($self) || $self;
972     my $node = do{$pkg.'::node'}->new( plan => $self, @_ );
973     $self->add_node( $node );
974     return $node;
975 }
976
977 sub new_facet {
978     my $self = shift;
979     my $pkg = ref($self) || $self;
980     my $name = shift;
981     my $args = shift;
982     my $negate = shift;
983
984     my $node = do{$pkg.'::facet'}->new( plan => $self, name => $name, 'values' => $args, negate => $negate );
985     $self->add_node( $node );
986
987     return $node;
988 }
989
990 sub new_filter {
991     my $self = shift;
992     my $pkg = ref($self) || $self;
993     my $name = shift;
994     my $args = shift;
995     my $negate = shift;
996
997     my $node = do{$pkg.'::filter'}->new( plan => $self, name => $name, args => $args, negate => $negate );
998     $self->add_filter( $node );
999
1000     return $node;
1001 }
1002
1003
1004 sub _merge_filters {
1005     my $left_filter = shift;
1006     my $right_filter = shift;
1007     my $join = shift;
1008
1009     return undef unless $left_filter or $right_filter;
1010     return $right_filter unless $left_filter;
1011     return $left_filter unless $right_filter;
1012
1013     my $args = $left_filter->{args} || [];
1014
1015     if ($join eq '|') {
1016         push(@$args, @{$right_filter->{args}});
1017
1018     } else {
1019         # find the intersect values
1020         my %new_vals;
1021         map { $new_vals{$_} = 1 } @{$right_filter->{args} || []};
1022         $args = [ grep { $new_vals{$_} } @$args ];
1023     }
1024
1025     $left_filter->{args} = $args;
1026     return $left_filter;
1027 }
1028
1029 sub collapse_filters {
1030     my $self = shift;
1031     my $name = shift;
1032
1033     # start by merging any filters at this level.
1034     # like-level filters are always ORed together
1035
1036     my $cur_filter;
1037     my @cur_filters = grep {$_->name eq $name } @{ $self->filters };
1038     if (@cur_filters) {
1039         $cur_filter = shift @cur_filters;
1040         my $args = $cur_filter->{args} || [];
1041         $cur_filter = _merge_filters($cur_filter, $_, '|') for @cur_filters;
1042     }
1043
1044     # next gather the collapsed filters from sub-plans and 
1045     # merge them with our own
1046
1047     my @subquery = @{$self->{query}};
1048
1049     while (@subquery) {
1050         my $blob = shift @subquery;
1051         shift @subquery; # joiner
1052         next unless $blob->isa('QueryParser::query_plan');
1053         my $sub_filter = $blob->collapse_filters($name);
1054         $cur_filter = _merge_filters($cur_filter, $sub_filter, $self->joiner);
1055     }
1056
1057     if ($self->QueryParser->debug) {
1058         my @args = ($cur_filter and $cur_filter->{args}) ? @{$cur_filter->{args}} : ();
1059         warn "collapse_filters($name) => [@args]\n";
1060     }
1061
1062     return $cur_filter;
1063 }
1064
1065 sub find_filter {
1066     my $self = shift;
1067     my $needle = shift;;
1068     return undef unless ($needle);
1069
1070     my $filter = $self->collapse_filters($needle);
1071
1072     warn "find_filter($needle) => " . 
1073         (($filter and $filter->{args}) ? "@{$filter->{args}}" : '[]') . "\n" 
1074         if $self->QueryParser->debug;
1075
1076     return $filter ? ($filter) : ();
1077 }
1078
1079 sub find_modifier {
1080     my $self = shift;
1081     my $needle = shift;;
1082     return undef unless ($needle);
1083     return grep { $_->name eq $needle } @{ $self->modifiers };
1084 }
1085
1086 sub new_modifier {
1087     my $self = shift;
1088     my $pkg = ref($self) || $self;
1089     my $name = shift;
1090
1091     my $node = do{$pkg.'::modifier'}->new( $name );
1092     $self->add_modifier( $node );
1093
1094     return $node;
1095 }
1096
1097 sub classed_node {
1098     my $self = shift;
1099     my $requested_class = shift;
1100
1101     my $node;
1102     for my $n (@{$self->{query}}) {
1103         next unless (ref($n) && $n->isa( 'QueryParser::query_plan::node' ));
1104         if ($n->requested_class eq $requested_class) {
1105             $node = $n;
1106             last;
1107         }
1108     }
1109
1110     if (!$node) {
1111         $node = $self->new_node;
1112         $node->requested_class( $requested_class );
1113     }
1114
1115     return $node;
1116 }
1117
1118 sub remove_last_node {
1119     my $self = shift;
1120     my $requested_class = shift;
1121
1122     my $old = pop(@{$self->query_nodes});
1123     pop(@{$self->query_nodes}) if (@{$self->query_nodes});
1124
1125     return $old;
1126 }
1127
1128 sub query_nodes {
1129     my $self = shift;
1130     return $self->{query};
1131 }
1132
1133 sub add_node {
1134     my $self = shift;
1135     my $node = shift;
1136
1137     $self->{query} ||= [];
1138     push(@{$self->{query}}, $self->joiner) if (@{$self->{query}});
1139     push(@{$self->{query}}, $node);
1140
1141     return $self;
1142 }
1143
1144 sub top_plan {
1145     my $self = shift;
1146
1147     return $self->{level} ? 0 : 1;
1148 }
1149
1150 sub plan_level {
1151     my $self = shift;
1152     return $self->{level};
1153 }
1154
1155 sub joiner {
1156     my $self = shift;
1157     my $joiner = shift;
1158
1159     $self->{joiner} = $joiner if ($joiner);
1160     return $self->{joiner};
1161 }
1162
1163 sub modifiers {
1164     my $self = shift;
1165     $self->{modifiers} ||= [];
1166     return $self->{modifiers};
1167 }
1168
1169 sub add_modifier {
1170     my $self = shift;
1171     my $modifier = shift;
1172
1173     $self->{modifiers} ||= [];
1174     $self->{modifiers} = [ grep {$_->name ne $modifier->name} @{$self->{modifiers}} ];
1175
1176     push(@{$self->{modifiers}}, $modifier);
1177
1178     return $self;
1179 }
1180
1181 sub facets {
1182     my $self = shift;
1183     $self->{facets} ||= [];
1184     return $self->{facets};
1185 }
1186
1187 sub add_facet {
1188     my $self = shift;
1189     my $facet = shift;
1190
1191     $self->{facets} ||= [];
1192     $self->{facets} = [ grep {$_->name ne $facet->name} @{$self->{facets}} ];
1193
1194     push(@{$self->{facets}}, $facet);
1195
1196     return $self;
1197 }
1198
1199 sub filters {
1200     my $self = shift;
1201     $self->{filters} ||= [];
1202     return $self->{filters};
1203 }
1204
1205 sub add_filter {
1206     my $self = shift;
1207     my $filter = shift;
1208
1209     $self->{filters} ||= [];
1210
1211     push(@{$self->{filters}}, $filter);
1212
1213     return $self;
1214 }
1215
1216 # %opts supports two options at this time:
1217 #   no_phrases :
1218 #       If true, do not do anything to the phrases and unphrases
1219 #       fields on any discovered nodes.
1220 #   with_config :
1221 #       If true, also return the query parser config as part of the blob.
1222 #       This will get set back to 0 before recursion to avoid repetition.
1223 sub to_abstract_query {
1224     my $self = shift;
1225     my %opts = @_;
1226
1227     my $pkg = ref $self->QueryParser || $self->QueryParser;
1228
1229     my $abstract_query = {
1230         type => "query_plan",
1231         filters => [map { $_->to_abstract_query } @{$self->filters}],
1232         modifiers => [map { $_->to_abstract_query } @{$self->modifiers}]
1233     };
1234
1235     if ($opts{with_config}) {
1236         $opts{with_config} = 0;
1237         $abstract_query->{config} = $QueryParser::parser_config{$pkg};
1238     }
1239
1240     my $kids = [];
1241
1242     for my $qnode (@{$self->query_nodes}) {
1243         # Remember: qnode can be a joiner string, a node, or another query_plan
1244
1245         if (QueryParser::_util::is_joiner($qnode)) {
1246             if ($abstract_query->{children}) {
1247                 my $open_joiner = (keys(%{$abstract_query->{children}}))[0];
1248                 next if $open_joiner eq $qnode;
1249
1250                 my $oldroot = $abstract_query->{children};
1251                 $kids = [$oldroot];
1252                 $abstract_query->{children} = {$qnode => $kids};
1253             } else {
1254                 $abstract_query->{children} = {$qnode => $kids};
1255             }
1256         } else {
1257             push @$kids, $qnode->to_abstract_query(%opts);
1258         }
1259     }
1260
1261     $abstract_query->{children} ||= { QueryParser::_util::default_joiner() => $kids };
1262     return $abstract_query;
1263 }
1264
1265
1266 #-------------------------------
1267 package QueryParser::query_plan::node;
1268 use Data::Dumper;
1269 $Data::Dumper::Indent = 0;
1270
1271 sub new {
1272     my $pkg = shift;
1273     $pkg = ref($pkg) || $pkg;
1274     my %args = @_;
1275
1276     return bless \%args => $pkg;
1277 }
1278
1279 sub new_atom {
1280     my $self = shift;
1281     my $pkg = ref($self) || $self;
1282     return do{$pkg.'::atom'}->new( @_ );
1283 }
1284
1285 sub requested_class { # also split into classname, fields and alias
1286     my $self = shift;
1287     my $class = shift;
1288
1289     if ($class) {
1290         my @afields;
1291         my (undef, $alias) = split '#', $class;
1292         if ($alias) {
1293             $class =~ s/#[^|]+//;
1294             ($alias, @afields) = split '\|', $alias;
1295         }
1296
1297         my @fields = @afields;
1298         my ($class_part, @field_parts) = split '\|', $class;
1299         for my $f (@field_parts) {
1300              push(@fields, $f) unless (grep { $f eq $_ } @fields);
1301         }
1302
1303         $class_part ||= $class;
1304
1305         $self->{requested_class} = $class;
1306         $self->{alias} = $alias if $alias;
1307         $self->{alias_fields} = \@afields if $alias;
1308         $self->{classname} = $class_part;
1309         $self->{fields} = \@fields;
1310     }
1311
1312     return $self->{requested_class};
1313 }
1314
1315 sub plan {
1316     my $self = shift;
1317     my $plan = shift;
1318
1319     $self->{plan} = $plan if ($plan);
1320     return $self->{plan};
1321 }
1322
1323 sub alias {
1324     my $self = shift;
1325     my $alias = shift;
1326
1327     $self->{alias} = $alias if ($alias);
1328     return $self->{alias};
1329 }
1330
1331 sub alias_fields {
1332     my $self = shift;
1333     my $alias = shift;
1334
1335     $self->{alias_fields} = $alias if ($alias);
1336     return $self->{alias_fields};
1337 }
1338
1339 sub classname {
1340     my $self = shift;
1341     my $class = shift;
1342
1343     $self->{classname} = $class if ($class);
1344     return $self->{classname};
1345 }
1346
1347 sub fields {
1348     my $self = shift;
1349     my @fields = @_;
1350
1351     $self->{fields} ||= [];
1352     $self->{fields} = \@fields if (@fields);
1353     return $self->{fields};
1354 }
1355
1356 sub phrases {
1357     my $self = shift;
1358     my @phrases = @_;
1359
1360     $self->{phrases} ||= [];
1361     $self->{phrases} = \@phrases if (@phrases);
1362     return $self->{phrases};
1363 }
1364
1365 sub unphrases {
1366     my $self = shift;
1367     my @phrases = @_;
1368
1369     $self->{unphrases} ||= [];
1370     $self->{unphrases} = \@phrases if (@phrases);
1371     return $self->{unphrases};
1372 }
1373
1374 sub add_phrase {
1375     my $self = shift;
1376     my $phrase = shift;
1377
1378     push(@{$self->phrases}, $phrase);
1379
1380     return $self;
1381 }
1382
1383 sub add_unphrase {
1384     my $self = shift;
1385     my $phrase = shift;
1386
1387     push(@{$self->unphrases}, $phrase);
1388
1389     return $self;
1390 }
1391
1392 sub query_atoms {
1393     my $self = shift;
1394     my @query_atoms = @_;
1395
1396     $self->{query_atoms} ||= [];
1397     $self->{query_atoms} = \@query_atoms if (@query_atoms);
1398     return $self->{query_atoms};
1399 }
1400
1401 sub add_fts_atom {
1402     my $self = shift;
1403     my $atom = shift;
1404
1405     if (!ref($atom)) {
1406         my $content = $atom;
1407         my @parts = @_;
1408
1409         $atom = $self->new_atom( content => $content, @parts );
1410     }
1411
1412     push(@{$self->query_atoms}, $self->plan->joiner) if (@{$self->query_atoms});
1413     push(@{$self->query_atoms}, $atom);
1414
1415     return $self;
1416 }
1417
1418 sub add_dummy_atom {
1419     my $self = shift;
1420     my @parts = @_;
1421
1422     my $atom = $self->new_atom( @parts, dummy => 1 );
1423
1424     push(@{$self->query_atoms}, $self->plan->joiner) if (@{$self->query_atoms});
1425     push(@{$self->query_atoms}, $atom);
1426
1427     return $self;
1428 }
1429
1430 # This will find up to one occurence of @$short_list within @$long_list, and
1431 # replace it with the single atom $replacement.
1432 sub replace_phrase_in_abstract_query {
1433     my ($self, $short_list, $long_list, $replacement) = @_;
1434
1435     my $success = 0;
1436     my @already = ();
1437     my $goal = scalar @$short_list;
1438
1439     for (my $i = 0; $i < scalar (@$long_list); $i++) {
1440         my $right = $long_list->[$i];
1441
1442         if (QueryParser::_util::compare_abstract_atoms(
1443             $short_list->[scalar @already], $right
1444         )) {
1445             push @already, $i;
1446         } elsif (scalar @already) {
1447             @already = ();
1448             next;
1449         }
1450
1451         if (scalar @already == $goal) {
1452             splice @$long_list, $already[0], scalar(@already), $replacement;
1453             $success = 1;
1454             last;
1455         }
1456     }
1457
1458     return $success;
1459 }
1460
1461 sub to_abstract_query {
1462     my $self = shift;
1463     my %opts = @_;
1464
1465     my $pkg = ref $self->plan->QueryParser || $self->plan->QueryParser;
1466
1467     my $abstract_query = {
1468         "type" => "node",
1469         "alias" => $self->alias,
1470         "alias_fields" => $self->alias_fields,
1471         "class" => $self->classname,
1472         "fields" => $self->fields
1473     };
1474
1475     my $kids = [];
1476
1477     for my $qatom (@{$self->query_atoms}) {
1478         if (QueryParser::_util::is_joiner($qatom)) {
1479             if ($abstract_query->{children}) {
1480                 my $open_joiner = (keys(%{$abstract_query->{children}}))[0];
1481                 next if $open_joiner eq $qatom;
1482
1483                 my $oldroot = $abstract_query->{children};
1484                 $kids = [$oldroot];
1485                 $abstract_query->{children} = {$qatom => $kids};
1486             } else {
1487                 $abstract_query->{children} = {$qatom => $kids};
1488             }
1489         } else {
1490             push @$kids, $qatom->to_abstract_query;
1491         }
1492     }
1493
1494     if ($self->{phrases} and not $opts{no_phrases}) {
1495         for my $phrase (@{$self->{phrases}}) {
1496             # Phrases appear duplication in a real QP tree, and we don't want
1497             # that duplication in our abstract query.  So for all our phrases,
1498             # break them into atoms as QP would, and remove any matching
1499             # sequences of atoms from our abstract query.
1500
1501             my $tmptree = $self->{plan}->{QueryParser}->new(query => '"'.$phrase.'"')->parse->parse_tree;
1502             if ($tmptree) {
1503                 # For a well-behaved phrase, we should now have only one node
1504                 # in the $tmptree query plan, and that node should have an
1505                 # orderly list of atoms and joiners.
1506
1507                 if ($tmptree->{query} and scalar(@{$tmptree->{query}}) == 1) {
1508                     my $tmplist;
1509
1510                     eval {
1511                         $tmplist = $tmptree->{query}->[0]->to_abstract_query(
1512                             no_phrases => 1
1513                         )->{children}->{'&'}->[0]->{children}->{'&'};
1514                     };
1515                     next if $@;
1516
1517                     foreach (
1518                         QueryParser::_util::find_arrays_in_abstract($abstract_query->{children})
1519                     ) {
1520                         last if $self->replace_phrase_in_abstract_query(
1521                             $tmplist,
1522                             $_,
1523                             QueryParser::_util::fake_abstract_atom_from_phrase($phrase)
1524                         );
1525                     }
1526                 }
1527             }
1528         }
1529     }
1530
1531     # Do the same as the preceding block for unphrases (negated phrases).
1532     if ($self->{unphrases} and not $opts{no_phrases}) {
1533         for my $phrase (@{$self->{unphrases}}) {
1534             my $tmptree = $self->{plan}->{QueryParser}->new(
1535                 query => $QueryParser::parser_config{$pkg}{operators}{disallowed}.
1536                     '"' . $phrase . '"'
1537             )->parse->parse_tree;
1538
1539             if ($tmptree) {
1540                 if ($tmptree->{query} and scalar(@{$tmptree->{query}}) == 1) {
1541                     my $tmplist;
1542
1543                     eval {
1544                         $tmplist = $tmptree->{query}->[0]->to_abstract_query(
1545                             no_phrases => 1
1546                         )->{children}->{'&'}->[0]->{children}->{'&'};
1547                     };
1548                     next if $@;
1549
1550                     foreach (
1551                         QueryParser::_util::find_arrays_in_abstract($abstract_query->{children})
1552                     ) {
1553                         last if $self->replace_phrase_in_abstract_query(
1554                             $tmplist,
1555                             $_,
1556                             QueryParser::_util::fake_abstract_atom_from_phrase($phrase, 1)
1557                         );
1558                     }
1559                 }
1560             }
1561         }
1562     }
1563
1564     $abstract_query->{children} ||= { QueryParser::_util::default_joiner() => $kids };
1565     return $abstract_query;
1566 }
1567
1568 #-------------------------------
1569 package QueryParser::query_plan::node::atom;
1570
1571 sub new {
1572     my $pkg = shift;
1573     $pkg = ref($pkg) || $pkg;
1574     my %args = @_;
1575
1576     return bless \%args => $pkg;
1577 }
1578
1579 sub node {
1580     my $self = shift;
1581     return undef unless (ref $self);
1582     return $self->{node};
1583 }
1584
1585 sub content {
1586     my $self = shift;
1587     return undef unless (ref $self);
1588     return $self->{content};
1589 }
1590
1591 sub prefix {
1592     my $self = shift;
1593     return undef unless (ref $self);
1594     return $self->{prefix};
1595 }
1596
1597 sub suffix {
1598     my $self = shift;
1599     return undef unless (ref $self);
1600     return $self->{suffix};
1601 }
1602
1603 sub to_abstract_query {
1604     my ($self) = @_;
1605     
1606     return {
1607         (map { $_ => $self->$_ } qw/prefix suffix content/),
1608         "type" => "atom"
1609     };
1610 }
1611 #-------------------------------
1612 package QueryParser::query_plan::filter;
1613
1614 sub new {
1615     my $pkg = shift;
1616     $pkg = ref($pkg) || $pkg;
1617     my %args = @_;
1618
1619     return bless \%args => $pkg;
1620 }
1621
1622 sub plan {
1623     my $self = shift;
1624     return $self->{plan};
1625 }
1626
1627 sub name {
1628     my $self = shift;
1629     return $self->{name};
1630 }
1631
1632 sub negate {
1633     my $self = shift;
1634     return $self->{negate};
1635 }
1636
1637 sub args {
1638     my $self = shift;
1639     return $self->{args};
1640 }
1641
1642 sub to_abstract_query {
1643     my ($self) = @_;
1644     
1645     return {
1646         map { $_ => $self->$_ } qw/name negate args/
1647     };
1648 }
1649
1650 #-------------------------------
1651 package QueryParser::query_plan::facet;
1652
1653 sub new {
1654     my $pkg = shift;
1655     $pkg = ref($pkg) || $pkg;
1656     my %args = @_;
1657
1658     return bless \%args => $pkg;
1659 }
1660
1661 sub plan {
1662     my $self = shift;
1663     return $self->{plan};
1664 }
1665
1666 sub name {
1667     my $self = shift;
1668     return $self->{name};
1669 }
1670
1671 sub negate {
1672     my $self = shift;
1673     return $self->{negate};
1674 }
1675
1676 sub values {
1677     my $self = shift;
1678     return $self->{'values'};
1679 }
1680
1681 sub to_abstract_query {
1682     my ($self) = @_;
1683
1684     return {
1685         (map { $_ => $self->$_ } qw/name negate values/),
1686         "type" => "facet"
1687     };
1688 }
1689
1690 #-------------------------------
1691 package QueryParser::query_plan::modifier;
1692
1693 sub new {
1694     my $pkg = shift;
1695     $pkg = ref($pkg) || $pkg;
1696     my $modifier = shift;
1697     my $negate = shift;
1698
1699     return bless { name => $modifier, negate => $negate } => $pkg;
1700 }
1701
1702 sub name {
1703     my $self = shift;
1704     return $self->{name};
1705 }
1706
1707 sub negate {
1708     my $self = shift;
1709     return $self->{negate};
1710 }
1711
1712 sub to_abstract_query {
1713     my ($self) = @_;
1714     
1715     return $self->name;
1716 }
1717 1;
1718