[Koha-patches] [PATCH] kohabug 2020 - fix infinite loop in NoZebra on Perl 5.10

[Galen Charlton]

When running Koha in NoZebra mode under Perl 5.10, a search
containing a operator (e.g., "mice and men") could cause
a bib search to enter into an infinite loop in NZanalyse.

This possibility arises from the fact that NZanalyse used
to use capture variables from regular expressions without
verifying whether the regular expressions actually matched.
It was compounded by the fact that NZanalyse is recursive;
however, because $1, $2, etc. are dynamically scoped,
*they are not automatically cleared when NZanalyse calls
itself*.

Consequently, if the search string contains a boolean
operator, it would be split into

left = mice
operator = and
right = men

Then NZanalyse would be called recursively on the search
string 'mice'.  However, because $1, $2, and $3 are not
automatically cleared when the function is called again,
and because they are not cleared if a match fails, the code
would fail to recognize that 'mice' is leaf, and would
call NZanalyse('mice') repeatedly, to the promotion of
warm server rooms.

The wrinkle in this is that because of a bug in Perl 5.8, a
failing matches can sometimes alter the capture variables, thus
avoiding the infinite recursion.  However,  this bug was fixed in
Perl 5.10, leading to the NZanalyse bug becoming evident.

The Perl bug is described at http://rt.perl.org/rt3/Public/Bug/Display.html?id=19049
and the fix http://public.activestate.com/cgi-bin/perlbrowse/p/29279.

The fix to the Koha code is to check whether each regexp
that uses capture variables matches or fails, then act
accordingly.
---
 C4/Search.pm |   43 ++++++++++++++++++++++++++++---------------
 1 files changed, 28 insertions(+), 15 deletions(-)

diff --git a/C4/Search.pm b/C4/Search.pm
index 8dcfe4b..d8a7c61 100644
--- a/C4/Search.pm
+++ b/C4/Search.pm
@@ -1582,10 +1582,14 @@ sub NZanalyse {
         } 
     }
     warn "string :" . $string if $DEBUG;
-    $string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/;
-    my $left     = $1;
-    my $right    = $3;
-    my $operator = lc($2);    # FIXME: and/or/not are operators, not operands
+    my $left = "";
+    my $right = "";
+    my $operator = "";
+    if ($string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/) {
+        $left     = $1;
+        $right    = $3;
+        $operator = lc($2);    # FIXME: and/or/not are operators, not operands
+    }
     warn "no parenthesis. left : $left operator: $operator right: $right"
       if $DEBUG;
 
@@ -1631,20 +1635,29 @@ sub NZanalyse {
         warn "leaf:$string" if $DEBUG;
 
         # parse the string in in operator/operand/value again
-        $string =~ /(.*)(>=|<=)(.*)/;
-        my $left     = $1;
-        my $operator = $2;
-        my $right    = $3;
-#         warn "handling leaf... left:$left operator:$operator right:$right"
-#           if $DEBUG;
-        unless ($operator) {
-            $string =~ /(.*)(>|<|=)(.*)/;
+        my $left = "";
+        my $operator = "";
+        my $right = "";
+        if ($string =~ /(.*)(>=|<=)(.*)/) {
             $left     = $1;
             $operator = $2;
             $right    = $3;
-            warn
-"handling unless (operator)... left:$left operator:$operator right:$right"
-              if $DEBUG;
+        } else {
+            $left = $string;
+        }
+#         warn "handling leaf... left:$left operator:$operator right:$right"
+#           if $DEBUG;
+        unless ($operator) {
+            if ($string =~ /(.*)(>|<|=)(.*)/) {
+                $left     = $1;
+                $operator = $2;
+                $right    = $3;
+                warn
+    "handling unless (operator)... left:$left operator:$operator right:$right"
+                if $DEBUG;
+            } else {
+                $left = $string;
+            }
         }
         my $results;
 
-- 
1.5.5.rc0.16.g02b00