Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/QueryParser.pm

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