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 =head1 NAME
  24
  25 Koha::Authority::ControlledIndicators - Obtain biblio indicators, controlled by authority record
  26
  27 =head1 API
  28
  29 =head2 METHODS
  30
  31 =head3 new
  32
  33     Instantiate new object.
  34
  35 =cut
  36
  37 sub new {
  38     my ( $class, $params ) = @_;
  39     $params = {} if ref($params) ne 'HASH';
  40     return bless $params, $class;
  41 }
  42
  43 =head3 get
  44
  45     Obtain biblio indicators for given authority record and biblio field tag
  46
  47     $self->get({
  48         auth_record => $record,
  49         report_tag  => $authtype->auth_tag_to_report,
  50         biblio_tag  => $tag,
  51         flavour     => $flavour,
  52     });
  53
  54 =cut
  55
  56 sub get {
  57     my ( $self, $params ) = @_;
  58     my $flavour = $params->{flavour} // q{};
  59     my $tag = $params->{biblio_tag} // q{};
  60     my $record = $params->{auth_record};
  61     my $report_tag = $params->{report_tag} // q{};
  62
  63     $flavour = uc($flavour);
  64     $flavour = 'UNIMARC' if $flavour eq 'UNIMARCAUTH';
  65
  66     $self->{_parsed} //= _load_pref();
  67     my $result = {};
  68     return $result if !exists $self->{_parsed}->{$flavour};
  69     my $rule = $self->{_parsed}->{$flavour}->{$tag} //
  70         $self->{_parsed}->{$flavour}->{'*'} //
  71         {};
  72     my $report_fld = $record ? $record->field( $report_tag ) : undef;
  73
  74     foreach my $ind ( 'ind1', 'ind2' ) {
  75         if( exists $rule->{$ind} ) {
  76             if( !$rule->{$ind} ) {
  77                 $result->{$ind} = $rule->{$ind}; # undef or empty string
  78             } elsif( $rule->{$ind} eq 'auth1' ) {
  79                 $result->{$ind} = $report_fld->indicator(1) if $report_fld;
  80             } elsif( $rule->{$ind} eq 'auth2' ) {
  81                 $result->{$ind} = $report_fld->indicator(2) if $report_fld;
  82             } elsif( $rule->{$ind} eq 'thesaurus' ) {
  83                 my @info = _thesaurus_info( $record );
  84                 $result->{$ind} = $info[0];
  85                 $result->{sub2} = $info[1];
  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 sub _thesaurus_info {
 121     # This sub is triggered by the term 'thesaurus' in the controlling pref.
 122     # The indicator of some MARC21 fields (like 600 ind2) is controlled by
 123     # authority field 008/11 and 040$f. Additionally, it may also control $2.
 124     my ( $record ) = @_;
 125     my $code = $record->field('008')
 126         ? substr($record->field('008')->data, 11, 1)
 127         : q{};
 128     my %thes_mapping = ( a => 0, b => 1, c => 2, d => 3, k => 5, n => 4, r => 7, s => 7, v => 6, z => 7, '|' => 4 );
 129     my $ind = $thes_mapping{ $code } // '4';
 130
 131     # Determine optional subfield $2
 132     my $sub2;
 133     if( $ind eq '7' ) {
 134         # Important now to return a defined value
 135         $sub2 = $code eq 'r'
 136             ? 'aat'
 137             : $code eq 's'
 138             ? 'sears'
 139             : $code eq 'z' # pick from 040$f
 140             ? $record->subfield( '040', 'f' ) // q{}
 141             : q{};
 142     }
 143     return ( $ind, $sub2 );
 144 }
 145
 146 =head1 AUTHOR
 147
 148     Marcel de Rooy, Rijksmuseum Amsterdam, The Netherlands
 149     Janusz Kaczmarek
 150     Koha Development Team
 151
 152 =cut
 153
 154 1;