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