From 56aff1b801655d4a18a3e823b2a918a838059063 Mon Sep 17 00:00:00 2001
From: Mike Rylander <mrylander@gmail.com>
Date: Fri, 11 Nov 2022 14:38:55 -0500
Subject: [PATCH] Allow QP tester to run without a full stack in simple situations

Signed-off-by: Mike Rylander <mrylander@gmail.com>
Signed-off-by: Jason Stephenson <jason@sigio.com>
Signed-off-by: Galen Charlton <gmc@equinoxOLI.org>
Signed-off-by: Jason Boyer <JBoyer@equinoxOLI.org>
---
 .../Application/Storage/Driver/Pg/QueryParser.pm   |    4 +-
 .../lib/OpenILS/Application/Storage/QueryParser.pm |   24 +++++++++++++------
 .../support-scripts/test-scripts/query_parser.pl   |    9 +++++--
 3 files changed, 24 insertions(+), 13 deletions(-)

diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg/QueryParser.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg/QueryParser.pm
index 7668b94..c13c021 100644
--- a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg/QueryParser.pm
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg/QueryParser.pm
@@ -2078,9 +2078,9 @@ sub tsquery {
     for my $atom (@{$self->query_atoms}) {
         if (ref($atom)) {
             $self->{tsquery} .= "\n" . ${spc} x 3;
-            $self->{tsquery} .= '(' if $atom->explicit_start;
+            $self->{tsquery} .= '(' x $atom->explicit_start if $atom->explicit_start;
             $self->{tsquery} .= $atom->sql;
-            $self->{tsquery} .= ')' if $atom->explicit_end;
+            $self->{tsquery} .= ')' x $atom->explicit_end if $atom->explicit_end;
         } else {
             $self->{tsquery} .= $atom x 2;
         }
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/QueryParser.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/QueryParser.pm
index 745fdff..fd1a225 100644
--- a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/QueryParser.pm
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/QueryParser.pm
@@ -986,8 +986,12 @@ sub decompose {
         } elsif (/$$r{group_end_re}/) { # end of an explicit group
             warn '  'x$recursing."Encountered explicit group end, remainder: $'\n" if $self->debug;
 
-            $remainder = $';
-            $_ = '';
+            if ($recursing) {
+                $remainder = $';
+                $_ = '';
+            } else {
+                $_ = $';
+            }
 
             $last_type = '';
         } elsif ($self->filter_count && /$$r{filter_re}/) { # found a filter
@@ -1466,7 +1470,7 @@ sub abstract_query2str_impl {
             my $add_space = $q ? 1 : 0;
             if ($abstract_query->{explicit_start}) {
                 $q .= ' ' if $add_space;
-                $q .= $gs;
+                $q .= $gs x $abstract_query->{explicit_start};
                 $add_space = 0;
             }
             my $prefix = $abstract_query->{prefix} || '';
@@ -1474,7 +1478,7 @@ sub abstract_query2str_impl {
             $q .= ($add_space ? ' ' : '') . $prefix .
                 ($abstract_query->{content} // '') .
                 ($abstract_query->{suffix} || '');
-            $q .= $ge if ($abstract_query->{explicit_end});
+            $q .= $ge x $abstract_query->{explicit_end} if ($abstract_query->{explicit_end});
         } elsif ($abstract_query->{type} eq 'facet') {
             my $prefix = $abstract_query->{negate} ? $qpconfig->{operators}{disallowed} : '';
             $q .= ($q ? ' ' : '') . $prefix . $abstract_query->{name} . "[" .
@@ -1647,11 +1651,15 @@ sub pullup {
             and 1 == grep { # and we have exactly one (possibly merged, above) ::node with at least one ::atom
                 ref($_) and $_->isa('QueryParser::query_plan::node')
             } @{$self->query_nodes}
+            and (my @atoms = @{$self->query_nodes->[0]->query_atoms}) > 0
         ) {
-            warn "setting explicit flags on atoms that may later be pulled up, at depth". $self->plan_level . "\n"
-                if $self->QueryParser->debug;
-            $self->query_nodes->[0]->query_atoms->[0]->explicit_start(1) if @{$self->query_nodes->[0]->query_atoms};
-            $self->query_nodes->[0]->query_atoms->[-1]->explicit_end(1) if @{$self->query_nodes->[0]->query_atoms};
+            
+                warn "setting explicit flags on atoms that may later be pulled up, at depth". $self->plan_level . "\n"
+                    if $self->QueryParser->debug;
+                my $first_atom = $atoms[0];
+                my $last_atom = $atoms[-1];
+                $first_atom->explicit_start(1 + $first_atom->explicit_start );
+                $last_atom->explicit_end(1 + $last_atom->explicit_end);
         } else { # otherwise, the explicit grouping is meaningless, toss it
             $self->explicit(0);
         }
diff --git a/Open-ILS/src/support-scripts/test-scripts/query_parser.pl b/Open-ILS/src/support-scripts/test-scripts/query_parser.pl
index ebc0777..679a233 100755
--- a/Open-ILS/src/support-scripts/test-scripts/query_parser.pl
+++ b/Open-ILS/src/support-scripts/test-scripts/query_parser.pl
@@ -105,11 +105,14 @@ if (!$noconnect) {
 }
 
 $parser->parse;
-my $sql = $parser->toSQL;
-$sql =~ s/^\s*$//gm;
 
 print "Parsed query tree:\n" . Dumper($parser) unless $quiet;
 print "Abstract query:\n" . Dumper($parser->parse_tree->to_abstract_query) unless $quiet;
+print "Canonicalized query: " . $parser->canonicalize ."\n" unless $quiet;
 
-print "SQL:\n$sql\n\n" unless $quiet;
+if (!$noconnect and !$quiet) {
+    my $sql = $parser->toSQL;
+    $sql =~ s/^\s*$//gm;
+    print "SQL:\n$sql\n\n";
+}
 
-- 
1.7.2.5