From 3fd7433c0ae8cddfcc86712c9310ce28e5b8f7ba Mon Sep 17 00:00:00 2001
From: Olli-Antti Kivilahti <olli-antti.kivilahti@jns.fi>
Date: Wed, 15 Nov 2017 19:48:47 +0200
Subject: [PATCH 4/4] Bug 9525: Add support for regexps in conditional floating
 clauses

itype =~ ^(KI|DV) or location eq 'SHELF'
---
 Koha/FloatingMatrix.pm                        |  25 +----
 Koha/FloatingMatrix/BranchRule.pm             |  46 ++++----
 .../prog/en/modules/admin/floating-matrix.tt  |   3 +-
 t/Koha/FloatingMatrix.t                       | 105 ++++++++++++++++++
 4 files changed, 133 insertions(+), 46 deletions(-)
 create mode 100644 t/Koha/FloatingMatrix.t

diff --git a/Koha/FloatingMatrix.pm b/Koha/FloatingMatrix.pm
index 6bcf62c703..5b47f6d0d3 100644
--- a/Koha/FloatingMatrix.pm
+++ b/Koha/FloatingMatrix.pm
@@ -235,27 +235,12 @@ Static method
 sub _CheckConditionalFloat {
     my ($item, $branchRule) = @_;
 
-    my $conditionRules = $branchRule->getConditionRules();
-
-    my $evalCondition = '';
-    if (my @conds = $conditionRules =~ /(\w+)\s+(ne|eq|gt|lt|<|>|==|!=)\s+(\w+)\s*(and|or|xor|&&|\|\|)?/ig) {
-        #Iterate the condition quads, with the fourth index being the logical join operator.
-        for (my $i=0 ; $i<scalar(@conds) ; $i+=4) {
-            my $column = $conds[$i];
-            my $operator = $conds[$i+1];
-            my $value = $conds[$i+2];
-            my $join = $conds[$i+3] || '';
-
-            $evalCondition .= join(' ',"\$item->$column",$operator,"'$value'",$join,'');
-        }
-    }
-    else {
-        warn "Koha::FloatingMatrix::_CheckConditionalFloat():> Bad condition rules '$conditionRules' couldn't be parsed\n";
-        return undef;
-    }
+    my $evalCondition = $branchRule->getConditionRulesParsed();
+
+    # $item must be in the current scope, as it is hard-coded into the eval'ld condition
     my $ok = eval("return 1 if($evalCondition);");
     if ($@) {
-        warn "Koha::FloatingMatrix::_CheckConditionalFloat():> Something bad hapened when trying to evaluate the dynamic conditional:\n$@\n";
+        warn "Koha::FloatingMatrix::_CheckConditionalFloat():> Something bad hapened when trying to evaluate the dynamic conditional: '$evalCondition'\n\n$@\n";
         return undef;
     }
     return $ok;
@@ -476,4 +461,4 @@ sub _createModificationBuffer {
     return undef;
 }
 
-1; #Satisfy the compiler
\ No newline at end of file
+1; #Satisfy the compiler
diff --git a/Koha/FloatingMatrix/BranchRule.pm b/Koha/FloatingMatrix/BranchRule.pm
index c597739b5a..b5962242a0 100644
--- a/Koha/FloatingMatrix/BranchRule.pm
+++ b/Koha/FloatingMatrix/BranchRule.pm
@@ -44,7 +44,7 @@ use Koha::Exceptions::BadParameter;
                                     fromBranch => 'CPL',
                                     toBranch => 'FFL',
                                     floating => ['ALWAYS'|'POSSIBLE'|'CONDITIONAL'],
-                                    conditionRules => "items->{itype} eq 'BK' && $items->{permanent_location} eq 'CART'"
+                                    conditionRules => "items->{itype} eq 'BK' && $items->{permanent_location} =~ 'CART'"
                                 });
 
 BranchRule defines the floating rule for one transfer route.
@@ -59,9 +59,9 @@ We check if there is a floating rule for that fromBranch-toBranch -combination a
 sub new {
     my ($class, $params) = @_;
 
+    bless $params, $class;
     ValidateParams($params);
 
-    bless $params, $class;
     return $params;
 }
 
@@ -124,7 +124,7 @@ sub ValidateParams {
         $errorMsg = "'conditionRules' text is too long. Maximum length is '$maximumConditionRulesDatabaseLength' characters";
     }
     elsif ($params->{conditionRules}) {
-        ParseConditionRules(undef, $params->{conditionRules});
+        $params->setConditionRules($params->{conditionRules});
     }
 
     if ($errorMsg) {
@@ -138,27 +138,21 @@ sub ValidateParams {
 
 =head parseConditionRules, Static method
 
-    my $evalCondition = ParseConditionRules($item, $conditionRules);
-    my $evalCondition = ParseConditionRules(undef, $conditionRules);
+    my $evalCondition = ParseConditionRules($conditionRules);
+    my $evalCondition = ParseConditionRules($conditionRules);
 
 Parses the given Perl boolean expression into an eval()-able expression.
 If Item is given, uses the Item's columns to create a executable expression to check for
 conditional floating for this specific Item.
 
-@PARAM1 {Reference to HASH of koha.items-row} Item to check for conditional floating.
-@PARAM2 {String koha.floating_matrix.condition_rules} The boolean expression to turn
+@PARAM1 {String koha.floating_matrix.condition_rules} The boolean expression to turn
                     into a Perl code to check the floating condition.
 @THROWS Koha::Exceptions::BadParameter, if the conditionRules couldn't be parsed.
 =cut
 sub ParseConditionRules {
-    my ($item, $conditionRulesString) = @_;
+    my ($conditionRulesString) = @_;
     my $evalCondition = '';
-    if (my @conds = $conditionRulesString =~ /(\w+)\s+(ne|eq|gt|lt|<|>|==|!=)\s+(\w+)\s*(and|or|xor|&&|\|\|)?/ig) {
-
-        #If we haven't got no Item, simply stop here to aknowledge that the given condition logic is valid (atleast parseable)
-        return undef unless $item;
-
-        #If we have an Item, then prepare and return an eval-expression to test if the Item should float.
+    if (my @conds = $conditionRulesString =~ /(\w+)\s+(ne|eq|gt|lt|=~|<|>|==|!=)\s+(\S+)\s*(and|or|xor|&&|\|\|)?/ig) {
         #Iterate the condition quads, with the fourth index being the logical join operator.
         for (my $i=0 ; $i<scalar(@conds) ; $i+=4) {
             my $column = $conds[$i];
@@ -166,16 +160,20 @@ sub ParseConditionRules {
             my $value = $conds[$i+2];
             my $join = $conds[$i+3] || '';
 
-            $evalCondition .= join(' ',"\$item->{'$column'}",$operator,"'$value'",$join,'');
+            if ($operator eq '=~') {
+                $value = qr($value);
+                $evalCondition .= "\$item->$column $operator /$value/ $join ";
+            } else {
+                $evalCondition .= "\$item->$column $operator '$value' $join ";
+            }
         }
-
-        return $evalCondition;
     }
     else {
         Koha::Exceptions::BadParameter->throw(error =>
-                    "Koha::FloatingMatrix::parseConditionRules():> Bad condition rules '$conditionRulesString' couldn't be parsed\n".
-                    "See 'Help' for more info");
+                    "Koha::FloatingMatrix::BranchRule::ParseConditionRules():> Bad condition rules '$conditionRulesString' couldn't be parsed.\n"
+        );
     }
+    return $evalCondition;
 }
 
 =head replace
@@ -301,13 +299,11 @@ See parseConditionRules()
 sub setConditionRules {
     my ($self, $val) = @_;
     #Validate the conditinal rules.
-    ParseConditionRules(undef, $val);
+    $self->{conditionRulesParsed} = ParseConditionRules($val);
     $self->{conditionRules} = $val;
 }
-sub getConditionRules {
-    my ($self) = @_;
-    return $self->{conditionRules};
-}
+sub getConditionRules { return shift->{conditionRules}; }
+sub getConditionRulesParsed { return shift->{conditionRulesParsed}; }
 
 =head toString
 
@@ -339,4 +335,4 @@ sub TO_JSON {
     return $json;
 }
 
-1; #Satisfy the compiler
\ No newline at end of file
+1; #Satisfy the compiler
diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/floating-matrix.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/floating-matrix.tt
index 7929db0251..ea28969e13 100644
--- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/floating-matrix.tt
+++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/floating-matrix.tt
@@ -35,6 +35,7 @@
                                     itype eq BK or itype eq CR - this will always float all Items with item type 'BK' or 'CR'<br/>
                                     ccode eq FLOAT - this will float all Items with a collection code 'FLOAT'<br/>
                                     itype ne CR and permanent_location eq CART  - this will float all Items not of item type CR and whose permanent location (set when the Item's location is set) is 'CART'<br/>
+                                    itype =~ (CR|DV|BK) - Using a regular expression to match against the Item attribute. Floats item types CR or DV or BK. Refraing from using complex regexps as those can smash the system.<br/>
                                     <i>These boolean statements are actually evaluable Perl boolean expressions and target the columns in the koha.items-table. See <a href="http://schema.koha-community.org/tables/items.html">here</a> for available data columns.</i>
                                 </p>
                             </li>
@@ -125,4 +126,4 @@
 
 
 [% Asset.js("js/floating-matrix.js") | $raw %]
-[% INCLUDE 'intranet-bottom.inc' %]
\ No newline at end of file
+[% INCLUDE 'intranet-bottom.inc' %]
diff --git a/t/Koha/FloatingMatrix.t b/t/Koha/FloatingMatrix.t
new file mode 100644
index 0000000000..0bc2c88858
--- /dev/null
+++ b/t/Koha/FloatingMatrix.t
@@ -0,0 +1,105 @@
+# Copyright 2017 KohaSuomi
+#
+# This file is part of Koha.
+#
+
+use Modern::Perl;
+use Scalar::Util qw(blessed);
+use Try::Tiny;
+
+use Test::More;
+
+use Koha::FloatingMatrix;
+use Koha::FloatingMatrix::BranchRule;
+
+
+
+subtest "Feature: Conditional float statement", \&_CheckConditionalFloat;
+sub _CheckConditionalFloat {
+  my ($item, $branchRule);
+  $branchRule = {
+      fromBranch => 'CPL',
+      toBranch => 'FFL',
+      floating => 'CONDITIONAL',
+  };
+
+  eval {
+
+    ok($branchRule->{conditionRules} =
+        "itype ne LEHTI and ccode ne PILA and location ne VIM and location ne MVIM and location ne NWN",
+      "Given a basic BranchRule with lots of exclusion");
+    ok($item = {
+                itype => 'KOIRA',
+                ccode => 'CODE',
+                location => 'SHELF',
+               },
+      "And a simple Item");
+
+    ok(Koha::FloatingMatrix::_CheckConditionalFloat(
+           $item,
+           Koha::FloatingMatrix::BranchRule->new($branchRule)),
+      "Then the Item does float");
+
+
+
+    ok($branchRule->{conditionRules} =
+        "itype ne LEHTI xor itype ne KIRJA",
+      "Given a basic BranchRule with xor");
+
+    ok(! Koha::FloatingMatrix::_CheckConditionalFloat(
+           $item,
+           Koha::FloatingMatrix::BranchRule->new($branchRule)),
+      "Then the Item doesn't float");
+
+
+
+    ok($branchRule->{conditionRules} =
+        'itype =~ LEHTI$ or itype =~ ^KOIRA',
+      "Given a BranchRule using a regexp");
+
+    ok(Koha::FloatingMatrix::_CheckConditionalFloat(
+           $item,
+           Koha::FloatingMatrix::BranchRule->new($branchRule)),
+      "Then the Item does float");
+
+
+
+    ok($branchRule->{conditionRules} =
+        'itype =~ KOIRA$ or itype =~ ^KISSA',
+      "Given a BranchRule using a regexp with a \$");
+
+    ok(Koha::FloatingMatrix::_CheckConditionalFloat(
+           $item,
+           Koha::FloatingMatrix::BranchRule->new($branchRule)),
+      "Then the Item does float");
+
+
+
+    ok($branchRule->{conditionRules} =
+        'itype =~ KOIRA or itype =~ ^KISSA and ccode eq CODE',
+      "Given a BranchRule using a regexp and simple matching");
+
+    ok(Koha::FloatingMatrix::_CheckConditionalFloat(
+           $item,
+           Koha::FloatingMatrix::BranchRule->new($branchRule)),
+      "Then the Item does float");
+
+
+
+    ok($branchRule->{conditionRules} =
+        'itype =~ (KOIRA|KISSA|HAUVA) or location ne RAMPA',
+      "Given a BranchRule using a regexp with round brackets");
+
+    ok(Koha::FloatingMatrix::_CheckConditionalFloat(
+           $item,
+           Koha::FloatingMatrix::BranchRule->new($branchRule)),
+      "Then the Item does float");
+
+
+
+  };
+  if ($@) { ok (0, $@); }
+}
+
+
+done_testing();
-- 
2.17.1