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                 my @info = _thesaurus_info( $record );
  87                 $result->{$ind} = $info[0];
  88                 $result->{sub2} = $info[1];
  89             } else {
  90                 $result->{$ind} = substr( $rule->{$ind}, 0, 1);
  91             }
  92         }
  93     }
  94
  95     return $result;
  96 }
  97
  98 sub _load_pref {
  99     my $pref = C4::Context->preference('AuthorityControlledIndicators') // q{};
 100     my @lines = split /\r?\n/, $pref;
 101
 102     my $res = {};
 103     foreach my $line (@lines) {
 104         $line =~ s/^\s*|\s*$//g;
 105         next if $line =~ /^#/;
 106         # line should be of the form: marcflavour,fld,ind1:val,ind2:val
 107         my @temp = split /\s*,\s*/, $line;
 108         next if @temp < 3;
 109         my $flavour = uc($temp[0]);
 110         $flavour = 'UNIMARC' if $flavour eq 'UNIMARCAUTH';
 111         next if $temp[1] !~ /(\d{3}|\*)/;
 112         my $tag = $1;
 113         if( $temp[2] =~ /ind1\s*:\s*(.*)/ ) {
 114             $res->{$flavour}->{$tag}->{ind1} = $1;
 115         }
 116         if( $temp[3] && $temp[3] =~ /ind2\s*:\s*(.*)/ ) {
 117             $res->{$flavour}->{$tag}->{ind2} = $1;
 118         }
 119     }
 120     return $res;
 121 }
 122
 123 sub _thesaurus_info {
 124     # This sub is triggered by the term 'thesaurus' in the controlling pref.
 125     # The indicator of some MARC21 fields (like 600 ind2) is controlled by
 126     # authority field 008/11 and 040$f. Additionally, it may also control $2.
 127     my ( $record ) = @_;
 128     my $code = $record->field('008')
 129         ? substr($record->field('008')->data, 11, 1)
 130         : q{};
 131     my %thes_mapping = ( a => 0, b => 1, c => 2, d => 3, k => 5, n => 4, r => 7, s => 7, v => 6, z => 7, '|' => 4 );
 132     my $ind = $thes_mapping{ $code } // '4';
 133
 134     # Determine optional subfield $2
 135     my $sub2;
 136     if( $ind eq '7' ) {
 137         # Important now to return a defined value
 138         $sub2 = $code eq 'r'
 139             ? 'aat'
 140             : $code eq 's'
 141             ? 'sears'
 142             : $code eq 'z' # pick from 040$f
 143             ? $record->subfield( '040', 'f' ) // q{}
 144             : q{};
 145     }
 146     return ( $ind, $sub2 );
 147 }
 148
 149 =head3 clear
 150
 151     Clear internal cache.
 152
 153 =cut
 154
 155 sub clear {
 156     my ( $self, $params ) = @_;
 157     $cached_indicators = undef;
 158 }
 159
 160 =head1 AUTHOR
 161
 162     Marcel de Rooy, Rijksmuseum Amsterdam, The Netherlands
 163     Janusz Kaczmarek
 164     Koha Development Team
 165
 166 =cut
 167
 168 1;