Koha/Authority/ControlledIndicators.pm

   1 package Koha::Authority::ControlledIndicators;
   2
   3 # Copyright 2018 Rijksmuseum
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 3 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 use Modern::Perl;
  21 use C4::Context;
  22
  23 our $cached_indicators;
  24
  25 =head1 NAME
  26
  27 Koha::Authority::ControlledIndicators - Obtain biblio indicators, controlled by authority record
  28
  29 =head1 API
  30
  31 =head2 METHODS
  32
  33 =head3 new
  34
  35     Instantiate new object.
  36
  37 =cut
  38
  39 sub new {
  40     my ( $class, $params ) = @_;
  41     $params = {} if ref($params) ne 'HASH';
  42     $cached_indicators = undef;
  43     return bless $params, $class;
  44 }
  45
  46 =head3 get
  47
  48     Obtain biblio indicators for given authority record and biblio field tag
  49
  50     $self->get({
  51         auth_record => $record,
  52         report_tag  => $authtype->auth_tag_to_report,
  53         biblio_tag  => $tag,
  54         flavour     => $flavour,
  55     });
  56
  57 =cut
  58
  59 sub get {
  60     my ( $self, $params ) = @_;
  61     my $flavour = $params->{flavour} // q{};
  62     my $tag = $params->{biblio_tag} // q{};
  63     my $record = $params->{auth_record};
  64     my $report_tag = $params->{report_tag} // q{};
  65
  66     $flavour = uc($flavour);
  67     $flavour = 'UNIMARC' if $flavour eq 'UNIMARCAUTH';
  68
  69     $cached_indicators //= _load_pref();
  70     my $result = {};
  71     return $result if !exists $cached_indicators->{$flavour};
  72     my $rule = $cached_indicators->{$flavour}->{$tag} //
  73         $cached_indicators->{$flavour}->{'*'} //
  74         {};
  75     my $report_fld = $record ? $record->field( $report_tag ) : undef;
  76
  77     foreach my $ind ( 'ind1', 'ind2' ) {
  78         if( exists $rule->{$ind} ) {
  79             if( !$rule->{$ind} ) {
  80                 $result->{$ind} = $rule->{$ind}; # undef or empty string
  81             } elsif( $rule->{$ind} eq 'auth1' ) {
  82                 $result->{$ind} = $report_fld->indicator(1) if $report_fld;
  83             } elsif( $rule->{$ind} eq 'auth2' ) {
  84                 $result->{$ind} = $report_fld->indicator(2) if $report_fld;
  85             } elsif( $rule->{$ind} eq 'thesaurus' ) {
  86             } else {
  87                 $result->{$ind} = substr( $rule->{$ind}, 0, 1);
  88             }
  89         }
  90     }
  91
  92     return $result;
  93 }
  94
  95 sub _load_pref {
  96     my $pref = C4::Context->preference('AuthorityControlledIndicators') // q{};
  97     my @lines = split /\r?\n/, $pref;
  98
  99     my $res = {};
 100     foreach my $line (@lines) {
 101         $line =~ s/^\s*|\s*$//g;
 102         next if $line =~ /^#/;
 103         # line should be of the form: marcflavour,fld,ind1:val,ind2:val
 104         my @temp = split /\s*,\s*/, $line;
 105         next if @temp < 3;
 106         my $flavour = uc($temp[0]);
 107         $flavour = 'UNIMARC' if $flavour eq 'UNIMARCAUTH';
 108         next if $temp[1] !~ /(\d{3}|\*)/;
 109         my $tag = $1;
 110         if( $temp[2] =~ /ind1\s*:\s*(.*)/ ) {
 111             $res->{$flavour}->{$tag}->{ind1} = $1;
 112         }
 113         if( $temp[3] && $temp[3] =~ /ind2\s*:\s*(.*)/ ) {
 114             $res->{$flavour}->{$tag}->{ind2} = $1;
 115         }
 116     }
 117     return $res;
 118 }
 119
 120 =head3 clear
 121
 122     Clear internal cache.
 123
 124 =cut
 125
 126 sub clear {
 127     my ( $self, $params ) = @_;
 128     $cached_indicators = undef;
 129 }
 130
 131 =head1 AUTHOR
 132
 133     Marcel de Rooy, Rijksmuseum Amsterdam, The Netherlands
 134     Janusz Kaczmarek
 135     Koha Development Team
 136
 137 =cut
 138
 139 1;