Open-ILS/src/perlmods/lib/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/(^|\s+)$alias[:=]/$1$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 (/^\s*$/) { # end of an explicit group
 507             last;
 508         } elsif (/$group_end_re/) { # end of an explicit group
 509             warn "Encountered explicit group end\n" if $self->debug;
 510
 511             $_ = $';
 512             $remainder = $';
 513
 514             $last_type = '';
 515         } elsif ($self->filter_count && /$filter_re/) { # found a filter
 516             warn "Encountered search filter: $1 set to $2\n" if $self->debug;
 517
 518             $_ = $';
 519             $struct->new_filter( $1 => [ split '[, ]+', $2 ] );
 520
 521             $last_type = '';
 522         } elsif ($self->filter_count && /$filter_as_class_re/) { # found a filter
 523             warn "Encountered search filter: $1 set to $2\n" if $self->debug;
 524
 525             $_ = $';
 526             $struct->new_filter( $1 => [ split '[, ]+', $2 ] );
 527
 528             $last_type = '';
 529         } elsif ($self->modifier_count && /$modifier_re/) { # found a modifier
 530             warn "Encountered search modifier: $1\n" if $self->debug;
 531
 532             $_ = $';
 533             if (!$struct->top_plan) {
 534                 warn "  Search modifiers only allowed at the top level of the query\n" if $self->debug;
 535             } else {
 536                 $struct->new_modifier($1);
 537             }
 538
 539             $last_type = '';
 540         } elsif ($self->modifier_count && /$modifier_as_class_re/) { # found a modifier
 541             warn "Encountered search modifier: $1\n" if $self->debug;
 542
 543             my $mod = $1;
 544
 545             $_ = $';
 546             if (!$struct->top_plan) {
 547                 warn "  Search modifiers only allowed at the top level of the query\n" if $self->debug;
 548             } elsif ($2 =~ /^[ty1]/i) {
 549                 $struct->new_modifier($mod);
 550             }
 551
 552             $last_type = '';
 553         } elsif (/$group_start_re/) { # start of an explicit group
 554             warn "Encountered explicit group start\n" if $self->debug;
 555
 556             my ($substruct, $subremainder) = $self->decompose( $', $current_class, $recursing + 1 );
 557             $struct->add_node( $substruct );
 558             $_ = $subremainder;
 559
 560             $last_type = '';
 561         } elsif (/$and_re/) { # ANDed expression
 562             $_ = $';
 563             next if ($last_type eq 'AND');
 564             next if ($last_type eq 'OR');
 565             warn "Encountered AND\n" if $self->debug;
 566
 567             $struct->joiner( '&' );
 568
 569             $last_type = 'AND';
 570         } elsif (/$or_re/) { # ORed expression
 571             $_ = $';
 572             next if ($last_type eq 'AND');
 573             next if ($last_type eq 'OR');
 574             warn "Encountered OR\n" if $self->debug;
 575
 576             $struct->joiner( '|' );
 577
 578             $last_type = 'OR';
 579         } elsif ($self->facet_class_count && /$facet_re/) { # changing current class
 580             warn "Encountered facet: $1 => $2\n" if $self->debug;
 581
 582             my $facet = $1;
 583             my $facet_value = [ split '\s*#\s*', $2 ];
 584             $struct->new_facet( $facet => $facet_value );
 585             $_ = $';
 586
 587             $last_type = '';
 588         } elsif ($self->search_class_count && /$search_class_re/) { # changing current class
 589
 590             if ($last_type eq 'CLASS') {
 591                 $struct->remove_last_node( $current_class );
 592                 warn "Encountered class change with no searches!\n" if $self->debug;
 593             }
 594
 595             warn "Encountered class change: $1\n" if $self->debug;
 596
 597             $current_class = $1;
 598             $struct->classed_node( $current_class );
 599             $_ = $';
 600
 601             $last_type = 'CLASS';
 602         } elsif (/^\s*"([^"]+)"/) { # phrase, always anded
 603             warn "Encountered phrase: $1\n" if $self->debug;
 604
 605             $struct->joiner( '&' );
 606             my $phrase = $1;
 607
 608             my $class_node = $struct->classed_node($current_class);
 609             $class_node->add_phrase( $phrase );
 610             $_ = $phrase . $';
 611
 612             $last_type = '';
 613         } elsif (/$required_re([^\s)]+)/) { # phrase, always anded
 614             warn "Encountered required atom (mini phrase): $1\n" if $self->debug;
 615
 616             my $phrase = $1;
 617
 618             my $class_node = $struct->classed_node($current_class);
 619             $class_node->add_phrase( $phrase );
 620             $_ = $phrase . $';
 621             $struct->joiner( '&' );
 622
 623             $last_type = '';
 624         } elsif (/^\s*([^$group_end\s]+)/o) { # atom
 625             warn "Encountered atom: $1\n" if $self->debug;
 626             warn "Remainder: $'\n" if $self->debug;
 627
 628             my $atom = $1;
 629             my $after = $';
 630
 631             $_ = $after;
 632             $last_type = '';
 633
 634             my $negator = ($atom =~ s/^-//o) ? '!' : '';
 635             my $truncate = ($atom =~ s/\*$//o) ? '*' : '';
 636
 637             if (!grep { $atom eq $_ } ('&','|')) { # throw away & and |, not allowed in tsquery, and not really useful anyway
 638                 my $class_node = $struct->classed_node($current_class);
 639                 $class_node->add_fts_atom( $atom, suffix => $truncate, prefix => $negator, node => $class_node );
 640                 $struct->joiner( '&' );
 641             }
 642         }
 643
 644         last unless ($_);
 645
 646     }
 647
 648     return $struct if !wantarray;
 649     return ($struct, $remainder);
 650 }
 651
 652 sub find_class_index {
 653     my $class = shift;
 654     my $query = shift;
 655
 656     my ($class_part, @field_parts) = split '\|', $class;
 657     $class_part ||= $class;
 658
 659     for my $idx ( 0 .. scalar(@$query) - 1 ) {
 660         next unless ref($$query[$idx]);
 661         return $idx if ( $$query[$idx]{requested_class} && $class eq $$query[$idx]{requested_class} );
 662     }
 663
 664     push(@$query, { classname => $class_part, (@field_parts ? (fields => \@field_parts) : ()), requested_class => $class, ftsquery => [], phrases => [] });
 665     return -1;
 666 }
 667
 668 sub core_limit {
 669     my $self = shift;
 670     my $l = shift;
 671     $self->{core_limit} = $l if ($l);
 672     return $self->{core_limit};
 673 }
 674
 675 sub superpage {
 676     my $self = shift;
 677     my $l = shift;
 678     $self->{superpage} = $l if ($l);
 679     return $self->{superpage};
 680 }
 681
 682 sub superpage_size {
 683     my $self = shift;
 684     my $l = shift;
 685     $self->{superpage_size} = $l if ($l);
 686     return $self->{superpage_size};
 687 }
 688
 689
 690 #-------------------------------
 691 package QueryParser::query_plan;
 692
 693 sub QueryParser {
 694     my $self = shift;
 695     return undef unless ref($self);
 696     return $self->{QueryParser};
 697 }
 698
 699 sub new {
 700     my $pkg = shift;
 701     $pkg = ref($pkg) || $pkg;
 702     my %args = (query => [], joiner => '&', @_);
 703
 704     return bless \%args => $pkg;
 705 }
 706
 707 sub new_node {
 708     my $self = shift;
 709     my $pkg = ref($self) || $self;
 710     my $node = do{$pkg.'::node'}->new( plan => $self, @_ );
 711     $self->add_node( $node );
 712     return $node;
 713 }
 714
 715 sub new_facet {
 716     my $self = shift;
 717     my $pkg = ref($self) || $self;
 718     my $name = shift;
 719     my $args = shift;
 720
 721     my $node = do{$pkg.'::facet'}->new( plan => $self, name => $name, 'values' => $args );
 722     $self->add_node( $node );
 723
 724     return $node;
 725 }
 726
 727 sub new_filter {
 728     my $self = shift;
 729     my $pkg = ref($self) || $self;
 730     my $name = shift;
 731     my $args = shift;
 732
 733     my $node = do{$pkg.'::filter'}->new( plan => $self, name => $name, args => $args );
 734     $self->add_filter( $node );
 735
 736     return $node;
 737 }
 738
 739 sub find_filter {
 740     my $self = shift;
 741     my $needle = shift;;
 742     return undef unless ($needle);
 743     return grep { $_->name eq $needle } @{ $self->filters };
 744 }
 745
 746 sub find_modifier {
 747     my $self = shift;
 748     my $needle = shift;;
 749     return undef unless ($needle);
 750     return grep { $_->name eq $needle } @{ $self->modifiers };
 751 }
 752
 753 sub new_modifier {
 754     my $self = shift;
 755     my $pkg = ref($self) || $self;
 756     my $name = shift;
 757
 758     my $node = do{$pkg.'::modifier'}->new( $name );
 759     $self->add_modifier( $node );
 760
 761     return $node;
 762 }
 763
 764 sub classed_node {
 765     my $self = shift;
 766     my $requested_class = shift;
 767
 768     my $node;
 769     for my $n (@{$self->{query}}) {
 770         next unless (ref($n) && $n->isa( 'QueryParser::query_plan::node' ));
 771         if ($n->requested_class eq $requested_class) {
 772             $node = $n;
 773             last;
 774         }
 775     }
 776
 777     if (!$node) {
 778         $node = $self->new_node;
 779         $node->requested_class( $requested_class );
 780     }
 781
 782     return $node;
 783 }
 784
 785 sub remove_last_node {
 786     my $self = shift;
 787     my $requested_class = shift;
 788
 789     my $old = pop(@{$self->query_nodes});
 790     pop(@{$self->query_nodes}) if (@{$self->query_nodes});
 791
 792     return $old;
 793 }
 794
 795 sub query_nodes {
 796     my $self = shift;
 797     return $self->{query};
 798 }
 799
 800 sub add_node {
 801     my $self = shift;
 802     my $node = shift;
 803
 804     $self->{query} ||= [];
 805     push(@{$self->{query}}, $self->joiner) if (@{$self->{query}});
 806     push(@{$self->{query}}, $node);
 807
 808     return $self;
 809 }
 810
 811 sub top_plan {
 812     my $self = shift;
 813
 814     return $self->{level} ? 0 : 1;
 815 }
 816
 817 sub plan_level {
 818     my $self = shift;
 819     return $self->{level};
 820 }
 821
 822 sub joiner {
 823     my $self = shift;
 824     my $joiner = shift;
 825
 826     $self->{joiner} = $joiner if ($joiner);
 827     return $self->{joiner};
 828 }
 829
 830 sub modifiers {
 831     my $self = shift;
 832     $self->{modifiers} ||= [];
 833     return $self->{modifiers};
 834 }
 835
 836 sub add_modifier {
 837     my $self = shift;
 838     my $modifier = shift;
 839
 840     $self->{modifiers} ||= [];
 841     return $self if (grep {$$_ eq $$modifier} @{$self->{modifiers}});
 842
 843     push(@{$self->{modifiers}}, $modifier);
 844
 845     return $self;
 846 }
 847
 848 sub facets {
 849     my $self = shift;
 850     $self->{facets} ||= [];
 851     return $self->{facets};
 852 }
 853
 854 sub add_facet {
 855     my $self = shift;
 856     my $facet = shift;
 857
 858     $self->{facets} ||= [];
 859     return $self if (grep {$_->name eq $facet->name} @{$self->{facets}});
 860
 861     push(@{$self->{facets}}, $facet);
 862
 863     return $self;
 864 }
 865
 866 sub filters {
 867     my $self = shift;
 868     $self->{filters} ||= [];
 869     return $self->{filters};
 870 }
 871
 872 sub add_filter {
 873     my $self = shift;
 874     my $filter = shift;
 875
 876     $self->{filters} ||= [];
 877     return $self if (grep {$_->name eq $filter->name} @{$self->{filters}});
 878
 879     push(@{$self->{filters}}, $filter);
 880
 881     return $self;
 882 }
 883
 884
 885 #-------------------------------
 886 package QueryParser::query_plan::node;
 887
 888 sub new {
 889     my $pkg = shift;
 890     $pkg = ref($pkg) || $pkg;
 891     my %args = @_;
 892
 893     return bless \%args => $pkg;
 894 }
 895
 896 sub new_atom {
 897     my $self = shift;
 898     my $pkg = ref($self) || $self;
 899     return do{$pkg.'::atom'}->new( @_ );
 900 }
 901
 902 sub requested_class { # also split into classname and fields
 903     my $self = shift;
 904     my $class = shift;
 905
 906     if ($class) {
 907         my ($class_part, @field_parts) = split '\|', $class;
 908         $class_part ||= $class;
 909
 910         $self->{requested_class} = $class;
 911         $self->{classname} = $class_part;
 912         $self->{fields} = \@field_parts;
 913     }
 914
 915     return $self->{requested_class};
 916 }
 917
 918 sub plan {
 919     my $self = shift;
 920     my $plan = shift;
 921
 922     $self->{plan} = $plan if ($plan);
 923     return $self->{plan};
 924 }
 925
 926 sub classname {
 927     my $self = shift;
 928     my $class = shift;
 929
 930     $self->{classname} = $class if ($class);
 931     return $self->{classname};
 932 }
 933
 934 sub fields {
 935     my $self = shift;
 936     my @fields = @_;
 937
 938     $self->{fields} ||= [];
 939     $self->{fields} = \@fields if (@fields);
 940     return $self->{fields};
 941 }
 942
 943 sub phrases {
 944     my $self = shift;
 945     my @phrases = @_;
 946
 947     $self->{phrases} ||= [];
 948     $self->{phrases} = \@phrases if (@phrases);
 949     return $self->{phrases};
 950 }
 951
 952 sub add_phrase {
 953     my $self = shift;
 954     my $phrase = shift;
 955
 956     push(@{$self->phrases}, $phrase);
 957
 958     return $self;
 959 }
 960
 961 sub query_atoms {
 962     my $self = shift;
 963     my @query_atoms = @_;
 964
 965     $self->{query_atoms} ||= [];
 966     $self->{query_atoms} = \@query_atoms if (@query_atoms);
 967     return $self->{query_atoms};
 968 }
 969
 970 sub add_fts_atom {
 971     my $self = shift;
 972     my $atom = shift;
 973
 974     if (!ref($atom)) {
 975         my $content = $atom;
 976         my @parts = @_;
 977
 978         $atom = $self->new_atom( content => $content, @parts );
 979     }
 980
 981     push(@{$self->query_atoms}, $self->plan->joiner) if (@{$self->query_atoms});
 982     push(@{$self->query_atoms}, $atom);
 983
 984     return $self;
 985 }
 986
 987 #-------------------------------
 988 package QueryParser::query_plan::node::atom;
 989
 990 sub new {
 991     my $pkg = shift;
 992     $pkg = ref($pkg) || $pkg;
 993     my %args = @_;
 994
 995     return bless \%args => $pkg;
 996 }
 997
 998 sub node {
 999     my $self = shift;
1000     return undef unless (ref $self);
1001     return $self->{node};
1002 }
1003
1004 sub content {
1005     my $self = shift;
1006     return undef unless (ref $self);
1007     return $self->{content};
1008 }
1009
1010 sub prefix {
1011     my $self = shift;
1012     return undef unless (ref $self);
1013     return $self->{prefix};
1014 }
1015
1016 sub suffix {
1017     my $self = shift;
1018     return undef unless (ref $self);
1019     return $self->{suffix};
1020 }
1021
1022 #-------------------------------
1023 package QueryParser::query_plan::filter;
1024
1025 sub new {
1026     my $pkg = shift;
1027     $pkg = ref($pkg) || $pkg;
1028     my %args = @_;
1029
1030     return bless \%args => $pkg;
1031 }
1032
1033 sub plan {
1034     my $self = shift;
1035     return $self->{plan};
1036 }
1037
1038 sub name {
1039     my $self = shift;
1040     return $self->{name};
1041 }
1042
1043 sub args {
1044     my $self = shift;
1045     return $self->{args};
1046 }
1047
1048 #-------------------------------
1049 package QueryParser::query_plan::facet;
1050
1051 sub new {
1052     my $pkg = shift;
1053     $pkg = ref($pkg) || $pkg;
1054     my %args = @_;
1055
1056     return bless \%args => $pkg;
1057 }
1058
1059 sub plan {
1060     my $self = shift;
1061     return $self->{plan};
1062 }
1063
1064 sub name {
1065     my $self = shift;
1066     return $self->{name};
1067 }
1068
1069 sub values {
1070     my $self = shift;
1071     return $self->{'values'};
1072 }
1073
1074 #-------------------------------
1075 package QueryParser::query_plan::modifier;
1076
1077 sub new {
1078     my $pkg = shift;
1079     $pkg = ref($pkg) || $pkg;
1080     my $modifier = shift;
1081
1082     return bless \$modifier => $pkg;
1083 }
1084
1085 sub name {
1086     my $self = shift;
1087     return $$self;
1088 }
1089
1090 1;
1091