Koha/Z3950Responder/RPN.pm

   1 package Koha::Z3950Responder::RPN;
   2
   3 package Net::Z3950::RPN::Term;
   4
   5 # Copyright The National Library of Finland 2018
   6 #
   7 # This file is part of Koha.
   8 #
   9 # Koha is free software; you can redistribute it and/or modify it
  10 # under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation; either version 3 of the License, or
  12 # (at your option) any later version.
  13 #
  14 # Koha is distributed in the hope that it will be useful, but
  15 # WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  21
  22 use Modern::Perl;
  23
  24 =head1 NAME
  25
  26 Koha::Z3950Responder::RPN
  27
  28 =head1 SYNOPSIS
  29
  30 Overrides for the C<Net::Z3950::RPN> classes adding a C<to_koha> method that
  31 converts the query to a syntax that C<Koha::SearchEngine> understands.
  32
  33 =head1 DESCRIPTION
  34
  35 The method used here is described in C<samples/render-search.pl> of
  36 C<Net::Z3950::SimpleServer>.
  37
  38 =cut
  39
  40 sub to_koha {
  41     my ($self, $mappings) = @_;
  42
  43     my $attrs = $self->{'attributes'};
  44     my $fields = $mappings->{use}{default};
  45     my $split = 0;
  46     my $prefix = '';
  47     my $suffix = '';
  48     my $term = $self->{'term'};
  49     utf8::decode($term);
  50
  51     if ($attrs) {
  52         foreach my $attr (@$attrs) {
  53             if ($attr->{'attributeType'} == 1) { # use
  54                 my $use = $attr->{'attributeValue'};
  55                 $fields = $mappings->{use}{$use} if defined $mappings->{use}{$use};
  56             } elsif ($attr->{'attributeType'} == 4) { # structure
  57                 $split = 1 if ($attr->{'attributeValue'} == 2);
  58             } elsif ($attr->{'attributeType'} == 5) { # truncation
  59                 my $truncation = $attr->{'attributeValue'};
  60                 $prefix = '*' if ($truncation == 2 || $truncation == 3);
  61                 $suffix = '*' if ($truncation == 1 || $truncation == 3);
  62             }
  63         }
  64     }
  65
  66     $fields = [$fields] unless !defined $fields || ref($fields) eq 'ARRAY';
  67
  68     if ($split) {
  69         my @terms;
  70         foreach my $word (split(/\s/, $term)) {
  71             $word =~ s/^[\,\.;:\\\/\"\'\-\=]+//g;
  72             $word =~ s/[\,\.;:\\\/\"\'\-\=]+$//g;
  73             next if (!$word);
  74             $word = $self->escape($word);
  75             my @words;
  76             if( $fields ) {
  77                 foreach my $field (@{$fields}) {
  78                     push(@words, "$field:($prefix$word$suffix)");
  79                 }
  80             } else {
  81                 push(@words, "($prefix$word$suffix)");
  82             }
  83             push (@terms, join(' OR ', @words));
  84         }
  85         return '(' . join(' AND ', @terms) . ')';
  86     }
  87
  88     my @terms;
  89     $term = $self->escape($term);
  90     return "($prefix$term$suffix)" unless $fields;
  91     foreach my $field (@{$fields}) {
  92         push(@terms, "$field:($prefix$term$suffix)");
  93     }
  94     return '(' . join(' OR ', @terms) . ')';
  95 }
  96
  97 sub escape {
  98     my ($self, $term) = @_;
  99
 100     $term =~ s/([()])/\\$1/g;
 101     return $term;
 102 }
 103
 104 package Net::Z3950::RPN::And;
 105 sub to_koha {
 106     my ($self, $mappings) = @_;
 107
 108     return '(' . $self->[0]->to_koha($mappings) . ' AND ' .
 109                  $self->[1]->to_koha($mappings) . ')';
 110 }
 111
 112 package Net::Z3950::RPN::Or;
 113 sub to_koha {
 114     my ($self, $mappings) = @_;
 115
 116     return '(' . $self->[0]->to_koha($mappings) . ' OR ' .
 117                  $self->[1]->to_koha($mappings) . ')';
 118 }
 119
 120 package Net::Z3950::RPN::AndNot;
 121 sub to_koha {
 122     my ($self, $mappings) = @_;
 123
 124     return '(' . $self->[0]->to_koha($mappings) . ' NOT ' .
 125                  $self->[1]->to_koha($mappings) . ')';
 126 }
 127
 128 1;