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
 727         scalar(@{$struct->query_nodes}) == 0 &&
 728         scalar(@{$struct->filters}) == 0 &&
 729         !$struct->top_plan;
 730
 731     return $struct if !wantarray;
 732     return ($struct, $remainder);
 733 }
 734
 735 sub find_class_index {
 736     my $class = shift;
 737     my $query = shift;
 738
 739     my ($class_part, @field_parts) = split '\|', $class;
 740     $class_part ||= $class;
 741
 742     for my $idx ( 0 .. scalar(@$query) - 1 ) {
 743         next unless ref($$query[$idx]);
 744         return $idx if ( $$query[$idx]{requested_class} && $class eq $$query[$idx]{requested_class} );
 745     }
 746
 747     push(@$query, { classname => $class_part, (@field_parts ? (fields => \@field_parts) : ()), requested_class => $class, ftsquery => [], phrases => [] });
 748     return -1;
 749 }
 750
 751 sub core_limit {
 752     my $self = shift;
 753     my $l = shift;
 754     $self->{core_limit} = $l if ($l);
 755     return $self->{core_limit};
 756 }
 757
 758 sub superpage {
 759     my $self = shift;
 760     my $l = shift;
 761     $self->{superpage} = $l if ($l);
 762     return $self->{superpage};
 763 }
 764
 765 sub superpage_size {
 766     my $self = shift;
 767     my $l = shift;
 768     $self->{superpage_size} = $l if ($l);
 769     return $self->{superpage_size};
 770 }
 771
 772
 773 #-------------------------------
 774 package QueryParser::_util;
 775
 776 # At this level, joiners are always & or |.  This is not
 777 # the external, configurable representation of joiners that
 778 # defaults to # && and ||.
 779 sub is_joiner {
 780     my $str = shift;
 781
 782     return (not ref $str and ($str eq '&' or $str eq '|'));
 783 }
 784
 785 sub default_joiner { '&' }
 786
 787 # 0 for different, 1 for the same.
 788 sub compare_abstract_atoms {
 789     my ($left, $right) = @_;
 790
 791     foreach (qw/prefix suffix content/) {
 792         no warnings;    # undef can stand in for '' here
 793         return 0 unless $left->{$_} eq $right->{$_};
 794     }
 795
 796     return 1;
 797 }
 798
 799 sub fake_abstract_atom_from_phrase {
 800     my ($phrase, $neg) = @_;
 801
 802     my $prefix = '"';
 803     if ($neg) {
 804         $prefix =
 805             $QueryParser::parser_config{QueryParser}{operators}{disallowed} .
 806             $prefix;
 807     }
 808
 809     return {
 810         "type" => "atom", "prefix" => $prefix, "suffix" => '"',
 811         "content" => $phrase
 812     }
 813 }
 814
 815 sub find_arrays_in_abstract {
 816     my ($hash) = @_;
 817
 818     my @arrays;
 819     foreach my $key (keys %$hash) {
 820         if (ref $hash->{$key} eq "ARRAY") {
 821             push @arrays, $hash->{$key};
 822             foreach (@{$hash->{$key}}) {
 823                 push @arrays, find_arrays_in_abstract($_);
 824             }
 825         }
 826     }
 827
 828     return @arrays;
 829 }
 830
 831 #-------------------------------
 832 package QueryParser::Canonicalize;  # not OO
 833
 834 sub _abstract_query2str_filter {
 835     my $f = shift;
 836     my $qpconfig = $parser_config{QueryParser};
 837
 838     return sprintf(
 839         "%s%s(%s)",
 840         $f->{negate} ? $qpconfig->{operators}{disallowed} : "",
 841         $f->{name},
 842         join(",", @{$f->{args}})
 843     );
 844 }
 845
 846 sub _abstract_query2str_modifier {
 847     my $f = shift;
 848     my $qpconfig = $parser_config{QueryParser};
 849
 850     return $qpconfig->{operators}{modifier} . $f;
 851 }
 852
 853 # This should produce an equivalent query to the original, given an
 854 # abstract_query.
 855 sub abstract_query2str_impl {
 856     my ($abstract_query, $depth) = @_;
 857
 858     my $qpconfig = $parser_config{QueryParser};
 859
 860     my $gs = $qpconfig->{operators}{group_start};
 861     my $ge = $qpconfig->{operators}{group_end};
 862     my $and = $qpconfig->{operators}{and};
 863     my $or = $qpconfig->{operators}{or};
 864
 865     my $q = "";
 866     $q .= $gs if $abstract_query->{type} and $abstract_query->{type} eq "query_plan" and $depth;
 867
 868     if (exists $abstract_query->{type}) {
 869         if ($abstract_query->{type} eq 'query_plan') {
 870             $q .= join(" ", map { _abstract_query2str_filter($_) } @{$abstract_query->{filters}}) if
 871                 exists $abstract_query->{filters};
 872             $q .= " ";
 873
 874             $q .= join(" ", map { _abstract_query2str_modifier($_) } @{$abstract_query->{modifiers}}) if
 875                 exists $abstract_query->{modifiers};
 876         } elsif ($abstract_query->{type} eq 'node') {
 877             if ($abstract_query->{alias}) {
 878                 $q .= " " . $abstract_query->{alias};
 879                 $q .= "|$_" foreach @{$abstract_query->{alias_fields}};
 880             } else {
 881                 $q .= " " . $abstract_query->{class};
 882                 $q .= "|$_" foreach @{$abstract_query->{fields}};
 883             }
 884             $q .= ":";
 885         } elsif ($abstract_query->{type} eq 'atom') {
 886             my $prefix = $abstract_query->{prefix} || '';
 887             $prefix = $qpconfig->{operators}{disallowed} if $prefix eq '!';
 888             $q .= $prefix .
 889                 ($abstract_query->{content} || '') .
 890                 ($abstract_query->{suffix} || '');
 891         } elsif ($abstract_query->{type} eq 'facet') {
 892             # facet syntax [ # ] is hardcoded I guess?
 893             my $prefix = $abstract_query->{negate} ? $qpconfig->{operators}{disallowed} : '';
 894             $q .= $prefix . $abstract_query->{name} . "[" .
 895                 join(" # ", @{$abstract_query->{values}}) . "]";
 896         }
 897     }
 898
 899     if (exists $abstract_query->{children}) {
 900         my $op = (keys(%{$abstract_query->{children}}))[0];
 901         $q .= join(
 902             " " . ($op eq '&' ? $and : $or) . " ",
 903             map {
 904                 abstract_query2str_impl($_, $depth + 1)
 905             } @{$abstract_query->{children}{$op}}
 906         );
 907     } elsif ($abstract_query->{'&'} or $abstract_query->{'|'}) {
 908         my $op = (keys(%{$abstract_query}))[0];
 909         $q .= join(
 910             " " . ($op eq '&' ? $and : $or) . " ",
 911             map {
 912                 abstract_query2str_impl($_, $depth + 1)
 913             } @{$abstract_query->{$op}}
 914         );
 915     }
 916     $q .= " ";
 917
 918     $q .= $ge if $abstract_query->{type} and $abstract_query->{type} eq "query_plan" and $depth;
 919
 920     return $q;
 921 }
 922
 923 #-------------------------------
 924 package QueryParser::query_plan;
 925
 926 sub QueryParser {
 927     my $self = shift;
 928     return undef unless ref($self);
 929     return $self->{QueryParser};
 930 }
 931
 932 sub new {
 933     my $pkg = shift;
 934     $pkg = ref($pkg) || $pkg;
 935     my %args = (query => [], joiner => '&', @_);
 936
 937     return bless \%args => $pkg;
 938 }
 939
 940 sub new_node {
 941     my $self = shift;
 942     my $pkg = ref($self) || $self;
 943     my $node = do{$pkg.'::node'}->new( plan => $self, @_ );
 944     $self->add_node( $node );
 945     return $node;
 946 }
 947
 948 sub new_facet {
 949     my $self = shift;
 950     my $pkg = ref($self) || $self;
 951     my $name = shift;
 952     my $args = shift;
 953     my $negate = shift;
 954
 955     my $node = do{$pkg.'::facet'}->new( plan => $self, name => $name, 'values' => $args, negate => $negate );
 956     $self->add_node( $node );
 957
 958     return $node;
 959 }
 960
 961 sub new_filter {
 962     my $self = shift;
 963     my $pkg = ref($self) || $self;
 964     my $name = shift;
 965     my $args = shift;
 966     my $negate = shift;
 967
 968     my $node = do{$pkg.'::filter'}->new( plan => $self, name => $name, args => $args, negate => $negate );
 969     $self->add_filter( $node );
 970
 971     return $node;
 972 }
 973
 974 sub find_filter {
 975     my $self = shift;
 976     my $needle = shift;;
 977     return undef unless ($needle);
 978     return grep { $_->name eq $needle } @{ $self->filters };
 979 }
 980
 981 sub find_modifier {
 982     my $self = shift;
 983     my $needle = shift;;
 984     return undef unless ($needle);
 985     return grep { $_->name eq $needle } @{ $self->modifiers };
 986 }
 987
 988 sub new_modifier {
 989     my $self = shift;
 990     my $pkg = ref($self) || $self;
 991     my $name = shift;
 992
 993     my $node = do{$pkg.'::modifier'}->new( $name );
 994     $self->add_modifier( $node );
 995
 996     return $node;
 997 }
 998
 999 sub classed_node {
1000     my $self = shift;
1001     my $requested_class = shift;
1002
1003     my $node;
1004     for my $n (@{$self->{query}}) {
1005         next unless (ref($n) && $n->isa( 'QueryParser::query_plan::node' ));
1006         if ($n->requested_class eq $requested_class) {
1007             $node = $n;
1008             last;
1009         }
1010     }
1011
1012     if (!$node) {
1013         $node = $self->new_node;
1014         $node->requested_class( $requested_class );
1015     }
1016
1017     return $node;
1018 }
1019
1020 sub remove_last_node {
1021     my $self = shift;
1022     my $requested_class = shift;
1023
1024     my $old = pop(@{$self->query_nodes});
1025     pop(@{$self->query_nodes}) if (@{$self->query_nodes});
1026
1027     return $old;
1028 }
1029
1030 sub query_nodes {
1031     my $self = shift;
1032     return $self->{query};
1033 }
1034
1035 sub add_node {
1036     my $self = shift;
1037     my $node = shift;
1038
1039     $self->{query} ||= [];
1040     push(@{$self->{query}}, $self->joiner) if (@{$self->{query}});
1041     push(@{$self->{query}}, $node);
1042
1043     return $self;
1044 }
1045
1046 sub top_plan {
1047     my $self = shift;
1048
1049     return $self->{level} ? 0 : 1;
1050 }
1051
1052 sub plan_level {
1053     my $self = shift;
1054     return $self->{level};
1055 }
1056
1057 sub joiner {
1058     my $self = shift;
1059     my $joiner = shift;
1060
1061     $self->{joiner} = $joiner if ($joiner);
1062     return $self->{joiner};
1063 }
1064
1065 sub modifiers {
1066     my $self = shift;
1067     $self->{modifiers} ||= [];
1068     return $self->{modifiers};
1069 }
1070
1071 sub add_modifier {
1072     my $self = shift;
1073     my $modifier = shift;
1074
1075     $self->{modifiers} ||= [];
1076     $self->{modifiers} = [ grep {$_->name ne $modifier->name} @{$self->{modifiers}} ];
1077
1078     push(@{$self->{modifiers}}, $modifier);
1079
1080     return $self;
1081 }
1082
1083 sub facets {
1084     my $self = shift;
1085     $self->{facets} ||= [];
1086     return $self->{facets};
1087 }
1088
1089 sub add_facet {
1090     my $self = shift;
1091     my $facet = shift;
1092
1093     $self->{facets} ||= [];
1094     $self->{facets} = [ grep {$_->name ne $facet->name} @{$self->{facets}} ];
1095
1096     push(@{$self->{facets}}, $facet);
1097
1098     return $self;
1099 }
1100
1101 sub filters {
1102     my $self = shift;
1103     $self->{filters} ||= [];
1104     return $self->{filters};
1105 }
1106
1107 sub add_filter {
1108     my $self = shift;
1109     my $filter = shift;
1110
1111     $self->{filters} ||= [];
1112     $self->{filters} = [ grep {$_->name ne $filter->name} @{$self->{filters}} ];
1113
1114     push(@{$self->{filters}}, $filter);
1115
1116     return $self;
1117 }
1118
1119 # %opts supports two options at this time:
1120 #   no_phrases :
1121 #       If true, do not do anything to the phrases and unphrases
1122 #       fields on any discovered nodes.
1123 #   with_config :
1124 #       If true, also return the query parser config as part of the blob.
1125 #       This will get set back to 0 before recursion to avoid repetition.
1126 sub to_abstract_query {
1127     my $self = shift;
1128     my %opts = @_;
1129
1130     my $pkg = ref $self->QueryParser || $self->QueryParser;
1131
1132     my $abstract_query = {
1133         type => "query_plan",
1134         filters => [map { $_->to_abstract_query } @{$self->filters}],
1135         modifiers => [map { $_->to_abstract_query } @{$self->modifiers}]
1136     };
1137
1138     if ($opts{with_config}) {
1139         $opts{with_config} = 0;
1140         $abstract_query->{config} = $QueryParser::parser_config{$pkg};
1141     }
1142
1143     my $kids = [];
1144
1145     for my $qnode (@{$self->query_nodes}) {
1146         # Remember: qnode can be a joiner string, a node, or another query_plan
1147
1148         if (QueryParser::_util::is_joiner($qnode)) {
1149             if ($abstract_query->{children}) {
1150                 my $open_joiner = (keys(%{$abstract_query->{children}}))[0];
1151                 next if $open_joiner eq $qnode;
1152
1153                 my $oldroot = $abstract_query->{children};
1154                 $kids = [$oldroot];
1155                 $abstract_query->{children} = {$qnode => $kids};
1156             } else {
1157                 $abstract_query->{children} = {$qnode => $kids};
1158             }
1159         } else {
1160             push @$kids, $qnode->to_abstract_query(%opts);
1161         }
1162     }
1163
1164     $abstract_query->{children} ||= { QueryParser::_util::default_joiner() => $kids };
1165     return $abstract_query;
1166 }
1167
1168
1169 #-------------------------------
1170 package QueryParser::query_plan::node;
1171 use Data::Dumper;
1172 $Data::Dumper::Indent = 0;
1173
1174 sub new {
1175     my $pkg = shift;
1176     $pkg = ref($pkg) || $pkg;
1177     my %args = @_;
1178
1179     return bless \%args => $pkg;
1180 }
1181
1182 sub new_atom {
1183     my $self = shift;
1184     my $pkg = ref($self) || $self;
1185     return do{$pkg.'::atom'}->new( @_ );
1186 }
1187
1188 sub requested_class { # also split into classname, fields and alias
1189     my $self = shift;
1190     my $class = shift;
1191
1192     if ($class) {
1193         my @afields;
1194         my (undef, $alias) = split '#', $class;
1195         if ($alias) {
1196             $class =~ s/#[^|]+//;
1197             ($alias, @afields) = split '\|', $alias;
1198         }
1199
1200         my @fields = @afields;
1201         my ($class_part, @field_parts) = split '\|', $class;
1202         for my $f (@field_parts) {
1203              push(@fields, $f) unless (grep { $f eq $_ } @fields);
1204         }
1205
1206         $class_part ||= $class;
1207
1208         $self->{requested_class} = $class;
1209         $self->{alias} = $alias if $alias;
1210         $self->{alias_fields} = \@afields if $alias;
1211         $self->{classname} = $class_part;
1212         $self->{fields} = \@fields;
1213     }
1214
1215     return $self->{requested_class};
1216 }
1217
1218 sub plan {
1219     my $self = shift;
1220     my $plan = shift;
1221
1222     $self->{plan} = $plan if ($plan);
1223     return $self->{plan};
1224 }
1225
1226 sub alias {
1227     my $self = shift;
1228     my $alias = shift;
1229
1230     $self->{alias} = $alias if ($alias);
1231     return $self->{alias};
1232 }
1233
1234 sub alias_fields {
1235     my $self = shift;
1236     my $alias = shift;
1237
1238     $self->{alias_fields} = $alias if ($alias);
1239     return $self->{alias_fields};
1240 }
1241
1242 sub classname {
1243     my $self = shift;
1244     my $class = shift;
1245
1246     $self->{classname} = $class if ($class);
1247     return $self->{classname};
1248 }
1249
1250 sub fields {
1251     my $self = shift;
1252     my @fields = @_;
1253
1254     $self->{fields} ||= [];
1255     $self->{fields} = \@fields if (@fields);
1256     return $self->{fields};
1257 }
1258
1259 sub phrases {
1260     my $self = shift;
1261     my @phrases = @_;
1262
1263     $self->{phrases} ||= [];
1264     $self->{phrases} = \@phrases if (@phrases);
1265     return $self->{phrases};
1266 }
1267
1268 sub unphrases {
1269     my $self = shift;
1270     my @phrases = @_;
1271
1272     $self->{unphrases} ||= [];
1273     $self->{unphrases} = \@phrases if (@phrases);
1274     return $self->{unphrases};
1275 }
1276
1277 sub add_phrase {
1278     my $self = shift;
1279     my $phrase = shift;
1280
1281     push(@{$self->phrases}, $phrase);
1282
1283     return $self;
1284 }
1285
1286 sub add_unphrase {
1287     my $self = shift;
1288     my $phrase = shift;
1289
1290     push(@{$self->unphrases}, $phrase);
1291
1292     return $self;
1293 }
1294
1295 sub query_atoms {
1296     my $self = shift;
1297     my @query_atoms = @_;
1298
1299     $self->{query_atoms} ||= [];
1300     $self->{query_atoms} = \@query_atoms if (@query_atoms);
1301     return $self->{query_atoms};
1302 }
1303
1304 sub add_fts_atom {
1305     my $self = shift;
1306     my $atom = shift;
1307
1308     if (!ref($atom)) {
1309         my $content = $atom;
1310         my @parts = @_;
1311
1312         $atom = $self->new_atom( content => $content, @parts );
1313     }
1314
1315     push(@{$self->query_atoms}, $self->plan->joiner) if (@{$self->query_atoms});
1316     push(@{$self->query_atoms}, $atom);
1317
1318     return $self;
1319 }
1320
1321 sub add_dummy_atom {
1322     my $self = shift;
1323     my @parts = @_;
1324
1325     my $atom = $self->new_atom( @parts, dummy => 1 );
1326
1327     push(@{$self->query_atoms}, $self->plan->joiner) if (@{$self->query_atoms});
1328     push(@{$self->query_atoms}, $atom);
1329
1330     return $self;
1331 }
1332
1333 # This will find up to one occurence of @$short_list within @$long_list, and
1334 # replace it with the single atom $replacement.
1335 sub replace_phrase_in_abstract_query {
1336     my ($self, $short_list, $long_list, $replacement) = @_;
1337
1338     my $success = 0;
1339     my @already = ();
1340     my $goal = scalar @$short_list;
1341
1342     for (my $i = 0; $i < scalar (@$long_list); $i++) {
1343         my $right = $long_list->[$i];
1344
1345         if (QueryParser::_util::compare_abstract_atoms(
1346             $short_list->[scalar @already], $right
1347         )) {
1348             push @already, $i;
1349         } elsif (scalar @already) {
1350             @already = ();
1351             next;
1352         }
1353
1354         if (scalar @already == $goal) {
1355             splice @$long_list, $already[0], scalar(@already), $replacement;
1356             $success = 1;
1357             last;
1358         }
1359     }
1360
1361     return $success;
1362 }
1363
1364 sub to_abstract_query {
1365     my $self = shift;
1366     my %opts = @_;
1367
1368     my $pkg = ref $self->plan->QueryParser || $self->plan->QueryParser;
1369
1370     my $abstract_query = {
1371         "type" => "node",
1372         "alias" => $self->alias,
1373         "alias_fields" => $self->alias_fields,
1374         "class" => $self->classname,
1375         "fields" => $self->fields
1376     };
1377
1378     my $kids = [];
1379
1380     for my $qatom (@{$self->query_atoms}) {
1381         if (QueryParser::_util::is_joiner($qatom)) {
1382             if ($abstract_query->{children}) {
1383                 my $open_joiner = (keys(%{$abstract_query->{children}}))[0];
1384                 next if $open_joiner eq $qatom;
1385
1386                 my $oldroot = $abstract_query->{children};
1387                 $kids = [$oldroot];
1388                 $abstract_query->{children} = {$qatom => $kids};
1389             } else {
1390                 $abstract_query->{children} = {$qatom => $kids};
1391             }
1392         } else {
1393             push @$kids, $qatom->to_abstract_query;
1394         }
1395     }
1396
1397     if ($self->{phrases} and not $opts{no_phrases}) {
1398         for my $phrase (@{$self->{phrases}}) {
1399             # Phrases appear duplication in a real QP tree, and we don't want
1400             # that duplication in our abstract query.  So for all our phrases,
1401             # break them into atoms as QP would, and remove any matching
1402             # sequences of atoms from our abstract query.
1403
1404             my $tmptree = $self->{plan}->{QueryParser}->new(query => '"'.$phrase.'"')->parse->parse_tree;
1405             if ($tmptree) {
1406                 # For a well-behaved phrase, we should now have only one node
1407                 # in the $tmptree query plan, and that node should have an
1408                 # orderly list of atoms and joiners.
1409
1410                 if ($tmptree->{query} and scalar(@{$tmptree->{query}}) == 1) {
1411                     my $tmplist;
1412
1413                     eval {
1414                         $tmplist = $tmptree->{query}->[0]->to_abstract_query(
1415                             no_phrases => 1
1416                         )->{children}->{'&'}->[0]->{children}->{'&'};
1417                     };
1418                     next if $@;
1419
1420                     foreach (
1421                         QueryParser::_util::find_arrays_in_abstract($abstract_query->{children})
1422                     ) {
1423                         last if $self->replace_phrase_in_abstract_query(
1424                             $tmplist,
1425                             $_,
1426                             QueryParser::_util::fake_abstract_atom_from_phrase($phrase)
1427                         );
1428                     }
1429                 }
1430             }
1431         }
1432     }
1433
1434     # Do the same as the preceding block for unphrases (negated phrases).
1435     if ($self->{unphrases} and not $opts{no_phrases}) {
1436         for my $phrase (@{$self->{unphrases}}) {
1437             my $tmptree = $self->{plan}->{QueryParser}->new(
1438                 query => $QueryParser::parser_config{$pkg}{operators}{disallowed}.
1439                     '"' . $phrase . '"'
1440             )->parse->parse_tree;
1441
1442             if ($tmptree) {
1443                 if ($tmptree->{query} and scalar(@{$tmptree->{query}}) == 1) {
1444                     my $tmplist;
1445
1446                     eval {
1447                         $tmplist = $tmptree->{query}->[0]->to_abstract_query(
1448                             no_phrases => 1
1449                         )->{children}->{'&'}->[0]->{children}->{'&'};
1450                     };
1451                     next if $@;
1452
1453                     foreach (
1454                         QueryParser::_util::find_arrays_in_abstract($abstract_query->{children})
1455                     ) {
1456                         last if $self->replace_phrase_in_abstract_query(
1457                             $tmplist,
1458                             $_,
1459                             QueryParser::_util::fake_abstract_atom_from_phrase($phrase, 1)
1460                         );
1461                     }
1462                 }
1463             }
1464         }
1465     }
1466
1467     $abstract_query->{children} ||= { QueryParser::_util::default_joiner() => $kids };
1468     return $abstract_query;
1469 }
1470
1471 #-------------------------------
1472 package QueryParser::query_plan::node::atom;
1473
1474 sub new {
1475     my $pkg = shift;
1476     $pkg = ref($pkg) || $pkg;
1477     my %args = @_;
1478
1479     return bless \%args => $pkg;
1480 }
1481
1482 sub node {
1483     my $self = shift;
1484     return undef unless (ref $self);
1485     return $self->{node};
1486 }
1487
1488 sub content {
1489     my $self = shift;
1490     return undef unless (ref $self);
1491     return $self->{content};
1492 }
1493
1494 sub prefix {
1495     my $self = shift;
1496     return undef unless (ref $self);
1497     return $self->{prefix};
1498 }
1499
1500 sub suffix {
1501     my $self = shift;
1502     return undef unless (ref $self);
1503     return $self->{suffix};
1504 }
1505
1506 sub to_abstract_query {
1507     my ($self) = @_;
1508
1509     return {
1510         (map { $_ => $self->$_ } qw/prefix suffix content/),
1511         "type" => "atom"
1512     };
1513 }
1514 #-------------------------------
1515 package QueryParser::query_plan::filter;
1516
1517 sub new {
1518     my $pkg = shift;
1519     $pkg = ref($pkg) || $pkg;
1520     my %args = @_;
1521
1522     return bless \%args => $pkg;
1523 }
1524
1525 sub plan {
1526     my $self = shift;
1527     return $self->{plan};
1528 }
1529
1530 sub name {
1531     my $self = shift;
1532     return $self->{name};
1533 }
1534
1535 sub negate {
1536     my $self = shift;
1537     return $self->{negate};
1538 }
1539
1540 sub args {
1541     my $self = shift;
1542     return $self->{args};
1543 }
1544
1545 sub to_abstract_query {
1546     my ($self) = @_;
1547
1548     return {
1549         map { $_ => $self->$_ } qw/name negate args/
1550     };
1551 }
1552
1553 #-------------------------------
1554 package QueryParser::query_plan::facet;
1555
1556 sub new {
1557     my $pkg = shift;
1558     $pkg = ref($pkg) || $pkg;
1559     my %args = @_;
1560
1561     return bless \%args => $pkg;
1562 }
1563
1564 sub plan {
1565     my $self = shift;
1566     return $self->{plan};
1567 }
1568
1569 sub name {
1570     my $self = shift;
1571     return $self->{name};
1572 }
1573
1574 sub negate {
1575     my $self = shift;
1576     return $self->{negate};
1577 }
1578
1579 sub values {
1580     my $self = shift;
1581     return $self->{'values'};
1582 }
1583
1584 sub to_abstract_query {
1585     my ($self) = @_;
1586
1587     return {
1588         (map { $_ => $self->$_ } qw/name negate values/),
1589         "type" => "facet"
1590     };
1591 }
1592
1593 #-------------------------------
1594 package QueryParser::query_plan::modifier;
1595
1596 sub new {
1597     my $pkg = shift;
1598     $pkg = ref($pkg) || $pkg;
1599     my $modifier = shift;
1600     my $negate = shift;
1601
1602     return bless { name => $modifier, negate => $negate } => $pkg;
1603 }
1604
1605 sub name {
1606     my $self = shift;
1607     return $self->{name};
1608 }
1609
1610 sub negate {
1611     my $self = shift;
1612     return $self->{negate};
1613 }
1614
1615 sub to_abstract_query {
1616     my ($self) = @_;
1617
1618     return $self->name;
1619 }
1620 1;
1621