]> git.evergreen-ils.org Git - Evergreen.git/blob - Open-ILS/src/perlmods/OpenILS/Application/Storage/QueryParser.pm
split search/fact metadata; add facet syntax
[Evergreen.git] / Open-ILS / src / perlmods / OpenILS / Application / Storage / QueryParser.pm
1 package QueryParser;
2 our %parser_config = (
3     QueryParser => {
4         filters => [],
5         modifiers => [],
6         operators => { 
7             'and' => '&&',
8             'or' => '||',
9             group_start => '(',
10             group_end => ')',
11             required => '+',
12             modifier => '#'
13         }
14     }
15 );
16
17 sub facet_class_count {
18     my $self = shift;
19     return @{$self->facet_classes};
20 }
21
22 sub search_class_count {
23     my $self = shift;
24     return @{$self->search_classes};
25 }
26
27 sub filter_count {
28     my $self = shift;
29     return @{$self->filters};
30 }
31
32 sub modifier_count {
33     my $self = shift;
34     return @{$self->modifiers};
35 }
36
37 sub custom_data {
38     my $class = shift;
39     $class = ref($class) || $class;
40
41     $parser_config{$class}{custom_data} ||= {};
42     return $parser_config{$class}{custom_data};
43 }
44
45 sub operators {
46     my $class = shift;
47     $class = ref($class) || $class;
48
49     $parser_config{$class}{operators} ||= {};
50     return $parser_config{$class}{operators};
51 }
52
53 sub filters {
54     my $class = shift;
55     $class = ref($class) || $class;
56
57     $parser_config{$class}{filters} ||= [];
58     return $parser_config{$class}{filters};
59 }
60
61 sub modifiers {
62     my $class = shift;
63     $class = ref($class) || $class;
64
65     $parser_config{$class}{modifiers} ||= [];
66     return $parser_config{$class}{modifiers};
67 }
68
69 sub new {
70     my $class = shift;
71     $class = ref($class) || $class;
72
73     my %opts = @_;
74
75     my $self = bless {} => $class;
76
77     for my $o (keys %{QueryParser->operators}) {
78         $class->operator($o => QueryParser->operator($o)) unless ($class->operator($o));
79     }
80
81     for my $opt ( keys %opts) {
82         $self->$opt( $opts{$opt} ) if ($self->can($opt));
83     }
84
85     return $self;
86 }
87
88 sub new_plan {
89     my $self = shift;
90     my $pkg = ref($self) || $self;
91     return do{$pkg.'::query_plan'}->new( QueryParser => $self, @_ );
92 }
93
94 sub add_search_filter {
95     my $pkg = shift;
96     $pkg = ref($pkg) || $pkg;
97     my $filter = shift;
98
99     return $filter if (grep { $_ eq $filter } @{$pkg->filters});
100     push @{$pkg->filters}, $filter;
101     return $filter;
102 }
103
104 sub add_search_modifier {
105     my $pkg = shift;
106     $pkg = ref($pkg) || $pkg;
107     my $modifier = shift;
108
109     return $modifier if (grep { $_ eq $modifier } @{$pkg->modifiers});
110     push @{$pkg->modifiers}, $modifier;
111     return $modifier;
112 }
113
114 sub add_facet_class {
115     my $pkg = shift;
116     $pkg = ref($pkg) || $pkg;
117     my $class = shift;
118
119     return $class if (grep { $_ eq $class } @{$pkg->facet_classes});
120
121     push @{$pkg->facet_classes}, $class;
122     $pkg->facet_fields->{$class} = [];
123
124     return $class;
125 }
126
127 sub add_search_class {
128     my $pkg = shift;
129     $pkg = ref($pkg) || $pkg;
130     my $class = shift;
131
132     return $class if (grep { $_ eq $class } @{$pkg->search_classes});
133
134     push @{$pkg->search_classes}, $class;
135     $pkg->search_fields->{$class} = [];
136     $pkg->default_search_class( $pkg->search_classes->[0] ) if (@{$pkg->search_classes} == 1);
137
138     return $class;
139 }
140
141 sub operator {
142     my $class = shift;
143     $class = ref($class) || $class;
144     my $opname = shift;
145     my $op = shift;
146
147     return undef unless ($opname);
148
149     $parser_config{$class}{operators} ||= {};
150     $parser_config{$class}{operators}{$opname} = $op if ($op);
151
152     return $parser_config{$class}{operators}{$opname};
153 }
154
155 sub facet_classes {
156     my $class = shift;
157     $class = ref($class) || $class;
158     my $classes = shift;
159
160     $parser_config{$class}{facet_classes} ||= [];
161     $parser_config{$class}{facet_classes} = $classes if (ref($classes) && @$classes);
162     return $parser_config{$class}{facet_classes};
163 }
164
165 sub search_classes {
166     my $class = shift;
167     $class = ref($class) || $class;
168     my $classes = shift;
169
170     $parser_config{$class}{classes} ||= [];
171     $parser_config{$class}{classes} = $classes if (ref($classes) && @$classes);
172     return $parser_config{$class}{classes};
173 }
174
175 sub add_query_normalizer {
176     my $pkg = shift;
177     $pkg = ref($pkg) || $pkg;
178     my $class = shift;
179     my $field = shift;
180     my $func = shift;
181     my $params = shift || [];
182
183     return $func if (grep { $_ eq $func } @{$pkg->query_normalizers->{$class}->{$field}});
184
185     push(@{$pkg->query_normalizers->{$class}->{$field}}, { function => $func, params => $params });
186
187     return $func;
188 }
189
190 sub query_normalizers {
191     my $pkg = shift;
192     $pkg = ref($pkg) || $pkg;
193
194     my $class = shift;
195     my $field = shift;
196
197     $parser_config{$pkg}{normalizers} ||= {};
198     if ($class) {
199         if ($field) {
200             $parser_config{$pkg}{normalizers}{$class}{$field} ||= [];
201             return $parser_config{$pkg}{normalizers}{$class}{$field};
202         } else {
203             return $parser_config{$pkg}{normalizers}{$class};
204         }
205     }
206
207     return $parser_config{$pkg}{normalizers};
208 }
209
210 sub default_search_class {
211     my $pkg = shift;
212     $pkg = ref($pkg) || $pkg;
213     my $class = shift;
214     $QueryParser::parser_config{$pkg}{default_class} = $pkg->add_search_class( $class ) if $class;
215
216     return $QueryParser::parser_config{$pkg}{default_class};
217 }
218
219 sub remove_facet_class {
220     my $pkg = shift;
221     $pkg = ref($pkg) || $pkg;
222     my $class = shift;
223
224     return $class if (!grep { $_ eq $class } @{$pkg->facet_classes});
225
226     $pkg->facet_classes( [ grep { $_ ne $class } @{$pkg->facet_classes} ] );
227     delete $QueryParser::parser_config{$pkg}{facet_fields}{$class};
228
229     return $class;
230 }
231
232 sub remove_search_class {
233     my $pkg = shift;
234     $pkg = ref($pkg) || $pkg;
235     my $class = shift;
236
237     return $class if (!grep { $_ eq $class } @{$pkg->search_classes});
238
239     $pkg->search_classes( [ grep { $_ ne $class } @{$pkg->search_classes} ] );
240     delete $QueryParser::parser_config{$pkg}{fields}{$class};
241
242     return $class;
243 }
244
245 sub add_facet_field {
246     my $pkg = shift;
247     $pkg = ref($pkg) || $pkg;
248     my $class = shift;
249     my $field = shift;
250
251     $pkg->add_facet_class( $class );
252
253     return { $class => $field }  if (grep { $_ eq $field } @{$pkg->facet_fields->{$class}});
254
255     push @{$pkg->facet_fields->{$class}}, $field;
256
257     return { $class => $field };
258 }
259
260 sub facet_fields {
261     my $class = shift;
262     $class = ref($class) || $class;
263
264     $parser_config{$class}{facet_fields} ||= {};
265     return $parser_config{$class}{facet_fields};
266 }
267
268 sub add_search_field {
269     my $pkg = shift;
270     $pkg = ref($pkg) || $pkg;
271     my $class = shift;
272     my $field = shift;
273
274     $pkg->add_search_class( $class );
275
276     return { $class => $field }  if (grep { $_ eq $field } @{$pkg->search_fields->{$class}});
277
278     push @{$pkg->search_fields->{$class}}, $field;
279
280     return { $class => $field };
281 }
282
283 sub search_fields {
284     my $class = shift;
285     $class = ref($class) || $class;
286
287     $parser_config{$class}{fields} ||= {};
288     return $parser_config{$class}{fields};
289 }
290
291 sub add_search_class_alias {
292     my $pkg = shift;
293     $pkg = ref($pkg) || $pkg;
294     my $class = shift;
295     my $alias = shift;
296
297     $pkg->add_search_class( $class );
298
299     return { $class => $alias }  if (grep { $_ eq $alias } @{$pkg->search_class_aliases->{$class}});
300
301     push @{$pkg->search_class_aliases->{$class}}, $alias;
302
303     return { $class => $alias };
304 }
305
306 sub search_class_aliases {
307     my $class = shift;
308     $class = ref($class) || $class;
309
310     $parser_config{$class}{class_map} ||= {};
311     return $parser_config{$class}{class_map};
312 }
313
314 sub add_search_field_alias {
315     my $pkg = shift;
316     $pkg = ref($pkg) || $pkg;
317     my $class = shift;
318     my $field = shift;
319     my $alias = shift;
320
321     return { $class => { $field => $alias } }  if (grep { $_ eq $alias } @{$pkg->search_field_aliases->{$class}{$field}});
322
323     push @{$pkg->search_field_aliases->{$class}{$field}}, $alias;
324
325     return { $class => { $field => $alias } };
326 }
327
328 sub search_field_aliases {
329     my $class = shift;
330     $class = ref($class) || $class;
331
332     $parser_config{$class}{field_alias_map} ||= {};
333     return $parser_config{$class}{field_alias_map};
334 }
335
336 sub remove_facet_field {
337     my $pkg = shift;
338     $pkg = ref($pkg) || $pkg;
339     my $class = shift;
340     my $field = shift;
341
342     return { $class => $field }  if (!$pkg->facet_fields->{$class} || !grep { $_ eq $field } @{$pkg->facet_fields->{$class}});
343
344     $pkg->facet_fields->{$class} = [ grep { $_ ne $field } @{$pkg->facet_fields->{$class}} ];
345
346     return { $class => $field };
347 }
348
349 sub remove_search_field {
350     my $pkg = shift;
351     $pkg = ref($pkg) || $pkg;
352     my $class = shift;
353     my $field = shift;
354
355     return { $class => $field }  if (!$pkg->search_fields->{$class} || !grep { $_ eq $field } @{$pkg->search_fields->{$class}});
356
357     $pkg->search_fields->{$class} = [ grep { $_ ne $field } @{$pkg->search_fields->{$class}} ];
358
359     return { $class => $field };
360 }
361
362 sub remove_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 (!$pkg->search_field_aliases->{$class}{$field} || !grep { $_ eq $alias } @{$pkg->search_field_aliases->{$class}{$field}});
370
371     $pkg->search_field_aliases->{$class}{$field} = [ grep { $_ ne $alias } @{$pkg->search_field_aliases->{$class}{$field}} ];
372
373     return { $class => { $field => $alias } };
374 }
375
376 sub remove_search_class_alias {
377     my $pkg = shift;
378     $pkg = ref($pkg) || $pkg;
379     my $class = shift;
380     my $alias = shift;
381
382     return { $class => $alias }  if (!$pkg->search_class_aliases->{$class} || !grep { $_ eq $alias } @{$pkg->search_class_aliases->{$class}});
383
384     $pkg->search_class_aliases->{$class} = [ grep { $_ ne $alias } @{$pkg->search_class_aliases->{$class}} ];
385
386     return { $class => $alias };
387 }
388
389 sub debug {
390     my $self = shift;
391     my $q = shift;
392     $self->{_debug} = $q if (defined $q);
393     return $self->{_debug};
394 }
395
396 sub query {
397     my $self = shift;
398     my $q = shift;
399     $self->{_query} = $q if (defined $q);
400     return $self->{_query};
401 }
402
403 sub parse_tree {
404     my $self = shift;
405     my $q = shift;
406     $self->{_parse_tree} = $q if (defined $q);
407     return $self->{_parse_tree};
408 }
409
410 sub parse {
411     my $self = shift;
412     my $pkg = ref($self) || $self;
413     warn " ** parse package is $pkg\n" if $self->debug;
414     $self->parse_tree(
415         $self->decompose(
416             $self->query( shift() )
417         )
418     );
419
420     return $self;
421 }
422
423 sub decompose {
424     my $self = shift;
425     my $pkg = ref($self) || $self;
426
427     warn " ** decompose package is $pkg\n" if $self->debug;
428
429     $_ = shift;
430     my $current_class = shift || $self->default_search_class;
431
432     my $recursing = shift || 0;
433
434     # Build the search class+field uber-regexp
435     my $search_class_re = '^\s*(';
436     my $first_class = 1;
437
438     my %seen_classes;
439     for my $class ( keys %{$pkg->search_fields} ) {
440
441         for my $field ( @{$pkg->search_fields->{$class}} ) {
442
443             for my $alias ( @{$pkg->search_field_aliases->{$class}{$field}} ) {
444                 $alias = qr/$alias/;
445                 s/\b$alias[:=]/$class\|$field:/g;
446             }
447         }
448
449         $search_class_re .= '|' unless ($first_class);
450         $first_class = 0;
451         $search_class_re .= $class . '(?:\|\w+)*';
452         $seen_classes{$class} = 1;
453     }
454
455     for my $class ( keys %{$pkg->search_class_aliases} ) {
456
457         for my $alias ( @{$pkg->search_class_aliases->{$class}} ) {
458             $alias = qr/$alias/;
459             s/(^|[^|])\b$alias\|/$1$class\|/g;
460             s/(^|[^|])\b$alias[:=]/$1$class:/g;
461         }
462
463         $search_class_re .= '|' unless ($first_class);
464         $first_class = 0;
465
466         $search_class_re .= $class . '(?:\|\w+)*' if (!$seen_classes{$class});
467         $seen_classes{$class} = 1;
468     }
469     $search_class_re .= '):';
470
471     warn " ** Search class RE: $search_class_re\n" if $self->debug;
472
473     my $required_re = $pkg->operator('required');
474     $required_re = qr/^\s*\Q$required_re\E/;
475     my $and_re = $pkg->operator('and');
476     $and_re = qr/^\s*\Q$and_re\E/;
477
478     my $or_re = $pkg->operator('or');
479     $or_re = qr/^\s*\Q$or_re\E/;
480
481     my $group_start_re = $pkg->operator('group_start');
482     $group_start_re = qr/^\s*\Q$group_start_re\E/;
483
484     my $group_end = $pkg->operator('group_end');
485     my $group_end_re = qr/^\s*\Q$group_end\E/;
486
487     my $modifier_tag_re = $pkg->operator('modifier');
488     $modifier_tag_re = qr/^\s*\Q$modifier_tag_re\E/;
489
490
491     # Build the filter and modifier uber-regexps
492     my $facet_re = '^\s*((?:' . join( '|', @{$pkg->facet_classes}) . ')(?:\|\w+)*)\[(.+?)\]';
493     warn " Facet RE: $facet_re\n" if $self->debug;
494
495     my $filter_re = '^\s*(' . join( '|', @{$pkg->filters}) . ')\(([^()]+)\)';
496     my $filter_as_class_re = '^\s*(' . join( '|', @{$pkg->filters}) . '):\s*(\S+)';
497
498     my $modifier_re = '^\s*'.$modifier_tag_re.'(' . join( '|', @{$pkg->modifiers}) . ')\b';
499     my $modifier_as_class_re = '^\s*(' . join( '|', @{$pkg->modifiers}) . '):\s*(\S+)';
500
501     my $struct = $self->new_plan( level => $recursing );
502     my $remainder = '';
503
504     my $last_type = '';
505     while (!$remainder) {
506         if (/$group_end_re/) { # end of an explicit group
507             warn "Encountered explicit group end\n" if $self->debug;
508
509             $_ = $';
510             $remainder = $';
511
512             $last_type = '';
513         } elsif ($self->filter_count && /$filter_re/) { # found a filter
514             warn "Encountered search filter: $1 set to $2\n" if $self->debug;
515
516             $_ = $';
517             $struct->new_filter( $1 => [ split '[, ]+', $2 ] );
518
519             $last_type = '';
520         } elsif ($self->filter_count && /$filter_as_class_re/) { # found a filter
521             warn "Encountered search filter: $1 set to $2\n" if $self->debug;
522
523             $_ = $';
524             $struct->new_filter( $1 => [ split '[, ]+', $2 ] );
525
526             $last_type = '';
527         } elsif ($self->modifier_count && /$modifier_re/) { # found a modifier
528             warn "Encountered search modifier: $1\n" if $self->debug;
529
530             $_ = $';
531             if (!$struct->top_plan) {
532                 warn "  Search modifiers only allowed at the top level of the query\n" if $self->debug;
533             } else {
534                 $struct->new_modifier($1);
535             }
536
537             $last_type = '';
538         } elsif ($self->modifier_count && /$modifier_as_class_re/) { # found a modifier
539             warn "Encountered search modifier: $1\n" if $self->debug;
540
541             my $mod = $1;
542
543             $_ = $';
544             if (!$struct->top_plan) {
545                 warn "  Search modifiers only allowed at the top level of the query\n" if $self->debug;
546             } elsif ($2 =~ /^[ty1]/i) {
547                 $struct->new_modifier($mod);
548             }
549
550             $last_type = '';
551         } elsif (/$group_start_re/) { # start of an explicit group
552             warn "Encountered explicit group start\n" if $self->debug;
553
554             my ($substruct, $subremainder) = $self->decompose( $', $current_class, $recursing + 1 );
555             $struct->add_node( $substruct );
556             $_ = $subremainder;
557
558             $last_type = '';
559         } elsif (/$and_re/) { # ANDed expression
560             $_ = $';
561             next if ($last_type eq 'AND');
562             next if ($last_type eq 'OR');
563             warn "Encountered AND\n" if $self->debug;
564
565             $struct->joiner( '&' );
566
567             $last_type = 'AND';
568         } elsif (/$or_re/) { # ORed expression
569             $_ = $';
570             next if ($last_type eq 'AND');
571             next if ($last_type eq 'OR');
572             warn "Encountered OR\n" if $self->debug;
573
574             $struct->joiner( '|' );
575
576             $last_type = 'OR';
577         } elsif ($self->facet_class_count && /$facet_re/) { # changing current class
578             warn "Encountered facet: $1 => $2\n" if $self->debug;
579
580             my $facet = $1;
581             my $facet_value = [ split '\s*#\s*', $2 ];
582             $struct->new_facet( $facet => $facet_value );
583             $_ = $';
584
585             $last_type = '';
586         } elsif ($self->search_class_count && /$search_class_re/) { # changing current class
587             warn "Encountered class change: $1\n" if $self->debug;
588
589             $current_class = $1;
590             $struct->classed_node( $current_class );
591             $_ = $';
592
593             $last_type = '';
594         } elsif (/^\s*"([^"]+)"/) { # phrase, always anded
595             warn "Encountered phrase: $1\n" if $self->debug;
596
597             $struct->joiner( '&' );
598             my $phrase = $1;
599
600             my $class_node = $struct->classed_node($current_class);
601             $class_node->add_phrase( $phrase );
602             $_ = $phrase . $';
603
604             $last_type = '';
605         } elsif (/$required_re([^\s)]+)/) { # phrase, always anded
606             warn "Encountered required atom (mini phrase): $1\n" if $self->debug;
607
608             my $phrase = $1;
609
610             my $class_node = $struct->classed_node($current_class);
611             $class_node->add_phrase( $phrase );
612             $_ = $phrase . $';
613             $struct->joiner( '&' );
614
615             $last_type = '';
616         } elsif (/^\s*([^$group_end\s]+)/o) { # atom
617             warn "Encountered atom: $1\n" if $self->debug;
618             warn "Remainder: $'\n" if $self->debug;
619
620             my $atom = $1;
621             my $after = $';
622
623             my $class_node = $struct->classed_node($current_class);
624             my $negator = ($atom =~ s/^-//o) ? '!' : '';
625             my $truncate = ($atom =~ s/\*$//o) ? '*' : '';
626
627             $class_node->add_fts_atom( $atom, suffix => $truncate, prefix => $negator, node => $class_node );
628             $struct->joiner( '&' );
629
630             $_ = $after;
631             $last_type = '';
632         } 
633
634         last unless ($_);
635
636     }
637
638     return $struct if !wantarray;
639     return ($struct, $remainder);
640 }
641
642 sub find_class_index {
643     my $class = shift;
644     my $query = shift;
645
646     my ($class_part, @field_parts) = split '\|', $class;
647     $class_part ||= $class;
648
649     for my $idx ( 0 .. scalar(@$query) - 1 ) {
650         next unless ref($$query[$idx]);
651         return $idx if ( $$query[$idx]{requested_class} && $class eq $$query[$idx]{requested_class} );
652     }
653
654     push(@$query, { classname => $class_part, (@field_parts ? (fields => \@field_parts) : ()), requested_class => $class, ftsquery => [], phrases => [] });
655     return -1;
656 }
657
658 sub core_limit {
659     my $self = shift;
660     my $l = shift;
661     $self->{core_limit} = $l if ($l);
662     return $self->{core_limit};
663 }
664
665 sub superpage {
666     my $self = shift;
667     my $l = shift;
668     $self->{superpage} = $l if ($l);
669     return $self->{superpage};
670 }
671
672 sub superpage_size {
673     my $self = shift;
674     my $l = shift;
675     $self->{superpage_size} = $l if ($l);
676     return $self->{superpage_size};
677 }
678
679
680 #-------------------------------
681 package QueryParser::query_plan;
682
683 sub QueryParser {
684     my $self = shift;
685     return undef unless ref($self);
686     return $self->{QueryParser};
687 }
688
689 sub new {
690     my $pkg = shift;
691     $pkg = ref($pkg) || $pkg;
692     my %args = (joiner => '&', @_);
693
694     return bless \%args => $pkg;
695 }
696
697 sub new_node {
698     my $self = shift;
699     my $pkg = ref($self) || $self;
700     my $node = do{$pkg.'::node'}->new( plan => $self, @_ );
701     $self->add_node( $node );
702     return $node;
703 }
704
705 sub new_facet {
706     my $self = shift;
707     my $pkg = ref($self) || $self;
708     my $name = shift;
709     my $args = shift;
710
711     my $node = do{$pkg.'::facet'}->new( plan => $self, name => $name, 'values' => $args );
712     $self->add_node( $node );
713
714     return $node;
715 }
716
717 sub new_filter {
718     my $self = shift;
719     my $pkg = ref($self) || $self;
720     my $name = shift;
721     my $args = shift;
722
723     my $node = do{$pkg.'::filter'}->new( plan => $self, name => $name, args => $args );
724     $self->add_filter( $node );
725
726     return $node;
727 }
728
729 sub find_filter {
730     my $self = shift;
731     my $needle = shift;;
732     return undef unless ($needle);
733     return grep { $_->name eq $needle } @{ $self->filters };
734 }
735
736 sub find_modifier {
737     my $self = shift;
738     my $needle = shift;;
739     return undef unless ($needle);
740     return grep { $_->name eq $needle } @{ $self->modifiers };
741 }
742
743 sub new_modifier {
744     my $self = shift;
745     my $pkg = ref($self) || $self;
746     my $name = shift;
747
748     my $node = do{$pkg.'::modifier'}->new( $name );
749     $self->add_modifier( $node );
750
751     return $node;
752 }
753
754 sub classed_node {
755     my $self = shift;
756     my $requested_class = shift;
757
758     my $node;
759     for my $n (@{$self->{query}}) {
760         next unless (ref($n) && $n->isa( 'QueryParser::query_plan::node' ));
761         if ($n->requested_class eq $requested_class) {
762             $node = $n;
763             last;
764         }
765     }
766
767     if (!$node) {
768         $node = $self->new_node;
769         $node->requested_class( $requested_class );
770     }
771
772     return $node;
773 }
774
775 sub query_nodes {
776     my $self = shift;
777     return $self->{query};
778 }
779
780 sub add_node {
781     my $self = shift;
782     my $node = shift;
783
784     $self->{query} ||= [];
785     push(@{$self->{query}}, $self->joiner) if (@{$self->{query}});
786     push(@{$self->{query}}, $node);
787
788     return $self;
789 }
790
791 sub top_plan {
792     my $self = shift;
793
794     return $self->{level} ? 0 : 1;
795 }
796
797 sub plan_level {
798     my $self = shift;
799     return $self->{level};
800 }
801
802 sub joiner {
803     my $self = shift;
804     my $joiner = shift;
805
806     $self->{joiner} = $joiner if ($joiner);
807     return $self->{joiner};
808 }
809
810 sub modifiers {
811     my $self = shift;
812     $self->{modifiers} ||= [];
813     return $self->{modifiers};
814 }
815
816 sub add_modifier {
817     my $self = shift;
818     my $modifier = shift;
819
820     $self->{modifiers} ||= [];
821     return $self if (grep {$$_ eq $$modifier} @{$self->{modifiers}});
822
823     push(@{$self->{modifiers}}, $modifier);
824
825     return $self;
826 }
827
828 sub facets {
829     my $self = shift;
830     $self->{facets} ||= [];
831     return $self->{facets};
832 }
833
834 sub add_facet {
835     my $self = shift;
836     my $facet = shift;
837
838     $self->{facets} ||= [];
839     return $self if (grep {$_->name eq $facet->name} @{$self->{facets}});
840
841     push(@{$self->{facets}}, $facet);
842
843     return $self;
844 }
845
846 sub filters {
847     my $self = shift;
848     $self->{filters} ||= [];
849     return $self->{filters};
850 }
851
852 sub add_filter {
853     my $self = shift;
854     my $filter = shift;
855
856     $self->{filters} ||= [];
857     return $self if (grep {$_->name eq $filter->name} @{$self->{filters}});
858
859     push(@{$self->{filters}}, $filter);
860
861     return $self;
862 }
863
864
865 #-------------------------------
866 package QueryParser::query_plan::node;
867
868 sub new {
869     my $pkg = shift;
870     $pkg = ref($pkg) || $pkg;
871     my %args = @_;
872
873     return bless \%args => $pkg;
874 }
875
876 sub new_atom {
877     my $self = shift;
878     my $pkg = ref($self) || $self;
879     return do{$pkg.'::atom'}->new( @_ );
880 }
881
882 sub requested_class { # also split into classname and fields
883     my $self = shift;
884     my $class = shift;
885
886     if ($class) {
887         my ($class_part, @field_parts) = split '\|', $class;
888         $class_part ||= $class;
889
890         $self->{requested_class} = $class;
891         $self->{classname} = $class_part;
892         $self->{fields} = \@field_parts;
893     }
894
895     return $self->{requested_class};
896 }
897
898 sub plan {
899     my $self = shift;
900     my $plan = shift;
901
902     $self->{plan} = $plan if ($plan);
903     return $self->{plan};
904 }
905
906 sub classname {
907     my $self = shift;
908     my $class = shift;
909
910     $self->{classname} = $class if ($class);
911     return $self->{classname};
912 }
913
914 sub fields {
915     my $self = shift;
916     my @fields = @_;
917
918     $self->{fields} ||= [];
919     $self->{fields} = \@fields if (@fields);
920     return $self->{fields};
921 }
922
923 sub phrases {
924     my $self = shift;
925     my @phrases = @_;
926
927     $self->{phrases} ||= [];
928     $self->{phrases} = \@phrases if (@phrases);
929     return $self->{phrases};
930 }
931
932 sub add_phrase {
933     my $self = shift;
934     my $phrase = shift;
935
936     push(@{$self->phrases}, $phrase);
937
938     return $self;
939 }
940
941 sub query_atoms {
942     my $self = shift;
943     my @query_atoms = @_;
944
945     $self->{query_atoms} ||= [];
946     $self->{query_atoms} = \@query_atoms if (@query_atoms);
947     return $self->{query_atoms};
948 }
949
950 sub add_fts_atom {
951     my $self = shift;
952     my $atom = shift;
953
954     if (!ref($atom)) {
955         my $content = $atom;
956         my @parts = @_;
957
958         $atom = $self->new_atom( content => $content, @parts );
959     }
960
961     push(@{$self->query_atoms}, $self->plan->joiner) if (@{$self->query_atoms});
962     push(@{$self->query_atoms}, $atom);
963
964     return $self;
965 }
966
967 #-------------------------------
968 package QueryParser::query_plan::node::atom;
969
970 sub new {
971     my $pkg = shift;
972     $pkg = ref($pkg) || $pkg;
973     my %args = @_;
974
975     return bless \%args => $pkg;
976 }
977
978 sub node {
979     my $self = shift;
980     return undef unless (ref $self);
981     return $self->{node};
982 }
983
984 sub content {
985     my $self = shift;
986     return undef unless (ref $self);
987     return $self->{content};
988 }
989
990 sub prefix {
991     my $self = shift;
992     return undef unless (ref $self);
993     return $self->{prefix};
994 }
995
996 sub suffix {
997     my $self = shift;
998     return undef unless (ref $self);
999     return $self->{suffix};
1000 }
1001
1002 #-------------------------------
1003 package QueryParser::query_plan::filter;
1004
1005 sub new {
1006     my $pkg = shift;
1007     $pkg = ref($pkg) || $pkg;
1008     my %args = @_;
1009
1010     return bless \%args => $pkg;
1011 }
1012
1013 sub plan {
1014     my $self = shift;
1015     return $self->{plan};
1016 }
1017
1018 sub name {
1019     my $self = shift;
1020     return $self->{name};
1021 }
1022
1023 sub args {
1024     my $self = shift;
1025     return $self->{args};
1026 }
1027
1028 #-------------------------------
1029 package QueryParser::query_plan::facet;
1030
1031 sub new {
1032     my $pkg = shift;
1033     $pkg = ref($pkg) || $pkg;
1034     my %args = @_;
1035
1036     return bless \%args => $pkg;
1037 }
1038
1039 sub plan {
1040     my $self = shift;
1041     return $self->{plan};
1042 }
1043
1044 sub name {
1045     my $self = shift;
1046     return $self->{name};
1047 }
1048
1049 sub values {
1050     my $self = shift;
1051     return $self->{'values'};
1052 }
1053
1054 #-------------------------------
1055 package QueryParser::query_plan::modifier;
1056
1057 sub new {
1058     my $pkg = shift;
1059     $pkg = ref($pkg) || $pkg;
1060     my $modifier = shift;
1061
1062     return bless \$modifier => $pkg;
1063 }
1064
1065 sub name {
1066     my $self = shift;
1067     return $$self;
1068 }
1069
1070 1;
1071