From 9fb7f01f001001c12693e4538339e42f1797e77a Mon Sep 17 00:00:00 2001
From: Ere Maijala <ere.maijala@helsinki.fi>
Date: Tue, 15 Jan 2019 13:54:17 +0200
Subject: [PATCH] Bug 13937: Fix RPN conversion

Fixes handling of parenthesis and removes unused quote handling.

Signed-off-by: Stefan Berndtsson <stefan.berndtsson@ub.gu.se>
Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>
---
 Koha/Z3950Responder/RPN.pm                    | 20 +++++++++++--------
 .../Koha/Z3950Responder/GenericSession.t      |  4 ++--
 2 files changed, 14 insertions(+), 10 deletions(-)

diff --git a/Koha/Z3950Responder/RPN.pm b/Koha/Z3950Responder/RPN.pm
index 3a1158b9d4..403bb78228 100644
--- a/Koha/Z3950Responder/RPN.pm
+++ b/Koha/Z3950Responder/RPN.pm
@@ -42,7 +42,6 @@ sub to_koha {
     my $attrs = $self->{'attributes'};
     my $fields = $mappings->{use}{default} // '_all';
     my $split = 0;
-    my $quote = '';
     my $prefix = '';
     my $suffix = '';
     my $term = $self->{'term'};
@@ -54,7 +53,6 @@ sub to_koha {
                 $fields = $mappings->{use}{$use} if defined $mappings->{use}{$use};
             } elsif ($attr->{'attributeType'} == 4) { # structure
                 $split = 1 if ($attr->{'attributeValue'} == 2);
-                $quote = '"' if ($attr->{'attributeValue'} == 1);
             } elsif ($attr->{'attributeType'} == 5) { # truncation
                 my $truncation = $attr->{'attributeValue'};
                 $prefix = '*' if ($truncation == 2 || $truncation == 3);
@@ -71,6 +69,7 @@ sub to_koha {
             $word =~ s/^[\,\.;:\\\/\"\'\-\=]+//g;
             $word =~ s/[\,\.;:\\\/\"\'\-\=]+$//g;
             next if (!$word);
+            $word = $self->escape($word);
             my @words;
             foreach my $field (@{$fields}) {
                 push(@words, "$field:($prefix$word$suffix)");
@@ -81,15 +80,22 @@ sub to_koha {
     }
 
     my @terms;
+    $term = $self->escape($term);
     foreach my $field (@{$fields}) {
         push(@terms, "$field:($prefix$term$suffix)");
     }
     return '(' . join(' OR ', @terms) . ')';
 }
 
+sub escape {
+    my ($self, $term) = @_;
+
+    $term =~ s/([()])/\\$1/g;
+    return $term;
+}
+
 package Net::Z3950::RPN::And;
-sub to_koha
-{
+sub to_koha {
     my ($self, $mappings) = @_;
 
     return '(' . $self->[0]->to_koha($mappings) . ' AND ' .
@@ -97,8 +103,7 @@ sub to_koha
 }
 
 package Net::Z3950::RPN::Or;
-sub to_koha
-{
+sub to_koha {
     my ($self, $mappings) = @_;
 
     return '(' . $self->[0]->to_koha($mappings) . ' OR ' .
@@ -106,8 +111,7 @@ sub to_koha
 }
 
 package Net::Z3950::RPN::AndNot;
-sub to_koha
-{
+sub to_koha {
     my ($self, $mappings) = @_;
 
     return '(' . $self->[0]->to_koha($mappings) . ' NOT ' .
diff --git a/t/db_dependent/Koha/Z3950Responder/GenericSession.t b/t/db_dependent/Koha/Z3950Responder/GenericSession.t
index b0219109f3..ee77d0286c 100644
--- a/t/db_dependent/Koha/Z3950Responder/GenericSession.t
+++ b/t/db_dependent/Koha/Z3950Responder/GenericSession.t
@@ -68,7 +68,7 @@ subtest 'test_search' => sub {
     $search->mock('simple_search_compat', sub {
         my ( $self, $query ) = @_;
 
-        return (1, undef, 0) unless $query eq '((author:(author)) AND (title:(title)))';
+        return (1, undef, 0) unless $query eq '((author:(author)) AND ((title:(title\(s\))) OR (title:(another))))';
 
         my @records = ($marc_record_1, $marc_record_2);
         return (undef, \@records, 2);
@@ -97,7 +97,7 @@ subtest 'test_search' => sub {
     $Zconn->connect('127.0.0.1:42111', 0);
     is($Zconn->errcode(), 0, 'Connection is successful: ' . $Zconn->errmsg());
 
-    my $rs = $Zconn->search_pqf('@and @attr 1=1 author @attr 1=4 title');
+    my $rs = $Zconn->search_pqf('@and @attr 1=1 @attr 4=1 author @or @attr 1=4 title(s) @attr 1=4 another');
     is($Zconn->errcode(), 0, 'Search is successful: ' . $Zconn->errmsg());
 
     is($rs->size(), 2, 'Two results returned');
-- 
2.39.5