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

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