@@ -, +, @@ --- Koha/Authority/ControlledIndicators.pm | 139 ++++++++++++++++++++++++++++++++ t/Koha/Authority/ControlledIndicators.t | 63 +++++++++++++++ 2 files changed, 202 insertions(+) create mode 100644 Koha/Authority/ControlledIndicators.pm create mode 100644 t/Koha/Authority/ControlledIndicators.t --- a/Koha/Authority/ControlledIndicators.pm +++ a/Koha/Authority/ControlledIndicators.pm @@ -0,0 +1,139 @@ +package Koha::Authority::ControlledIndicators; + +# Copyright 2018 Rijksmuseum +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use Modern::Perl; +use C4::Context; + +our $cached_indicators; + +=head1 NAME + +Koha::Authority::ControlledIndicators - Obtain biblio indicators, controlled by authority record + +=head1 API + +=head2 METHODS + +=head3 new + + Instantiate new object. + +=cut + +sub new { + my ( $class, $params ) = @_; + $params = {} if ref($params) ne 'HASH'; + $cached_indicators = undef; + return bless $params, $class; +} + +=head3 get + + Obtain biblio indicators for given authority record and biblio field tag + + $self->get({ + auth_record => $record, + report_tag => $authtype->auth_tag_to_report, + biblio_tag => $tag, + flavour => $flavour, + }); + +=cut + +sub get { + my ( $self, $params ) = @_; + my $flavour = $params->{flavour} // q{}; + my $tag = $params->{biblio_tag} // q{}; + my $record = $params->{auth_record}; + my $report_tag = $params->{report_tag} // q{}; + + $flavour = uc($flavour); + $flavour = 'UNIMARC' if $flavour eq 'UNIMARCAUTH'; + + $cached_indicators //= _load_pref(); + my $result = {}; + return $result if !exists $cached_indicators->{$flavour}; + my $rule = $cached_indicators->{$flavour}->{$tag} // + $cached_indicators->{$flavour}->{'*'} // + {}; + my $report_fld = $record ? $record->field( $report_tag ) : undef; + + foreach my $ind ( 'ind1', 'ind2' ) { + if( exists $rule->{$ind} ) { + if( !$rule->{$ind} ) { + $result->{$ind} = $rule->{$ind}; # undef or empty string + } elsif( $rule->{$ind} eq 'auth1' ) { + $result->{$ind} = $report_fld->indicator(1) if $report_fld; + } elsif( $rule->{$ind} eq 'auth2' ) { + $result->{$ind} = $report_fld->indicator(2) if $report_fld; + } elsif( $rule->{$ind} eq 'thesaurus' ) { + } else { + $result->{$ind} = substr( $rule->{$ind}, 0, 1); + } + } + } + + return $result; +} + +sub _load_pref { + my $pref = C4::Context->preference('AuthorityControlledIndicators') // q{}; + my @lines = split /\r?\n/, $pref; + + my $res = {}; + foreach my $line (@lines) { + $line =~ s/^\s*|\s*$//g; + next if $line =~ /^#/; + # line should be of the form: marcflavour,fld,ind1:val,ind2:val + my @temp = split /\s*,\s*/, $line; + next if @temp < 3; + my $flavour = uc($temp[0]); + $flavour = 'UNIMARC' if $flavour eq 'UNIMARCAUTH'; + next if $temp[1] !~ /(\d{3}|\*)/; + my $tag = $1; + if( $temp[2] =~ /ind1\s*:\s*(.*)/ ) { + $res->{$flavour}->{$tag}->{ind1} = $1; + } + if( $temp[3] && $temp[3] =~ /ind2\s*:\s*(.*)/ ) { + $res->{$flavour}->{$tag}->{ind2} = $1; + } + } + return $res; +} + +=head3 clear + + Clear internal cache. + +=cut + +sub clear { + my ( $self, $params ) = @_; + $cached_indicators = undef; +} + +=head1 AUTHOR + + Marcel de Rooy, Rijksmuseum Amsterdam, The Netherlands + Janusz Kaczmarek + Koha Development Team + +=cut + +1; --- a/t/Koha/Authority/ControlledIndicators.t +++ a/t/Koha/Authority/ControlledIndicators.t @@ -0,0 +1,63 @@ +#!/usr/bin/perl + +use Modern::Perl; +use Data::Dumper qw/Dumper/; +use MARC::Record; +use MARC::Field; +use Test::More tests => 1; + +use t::lib::Mocks; +use Koha::Authority::ControlledIndicators; + +subtest "Simple tests" => sub { + plan tests => 8; + + t::lib::Mocks::mock_preference('AuthorityControlledIndicators', q| +marc21,600,ind1:auth1,ind2:x +marc21,700,ind1:auth2 + |); + + my $oInd = Koha::Authority::ControlledIndicators->new; + + is_deeply( $oInd->get({}), {}, 'Empty hash for no parameters' ); + my $record = MARC::Record->new; + $record->append_fields( + MARC::Field->new( '100', '3', '4', a => 'My name' ), + ); + my $res = $oInd->get({ + flavour => "MARC21", + report_tag => '100', + auth_record => $record, + biblio_tag => '600', + }); + is( $res->{ind1}, '3', 'Check 1st indicator' ); + is( exists $res->{ind2}, 1, 'Check existence of 2nd indicator key' ); + is( $res->{ind2}, 'x', 'Check 2nd indicator value' ); + + $res = $oInd->get({ + flavour => "MARC21", + report_tag => '100', + auth_record => $record, + biblio_tag => '700', + }); + is( $res->{ind1}, '4', 'Check 1st indicator' ); + is( exists $res->{ind2}, '', 'Check if 2nd indicator key does not exist' ); + + # Test caching + t::lib::Mocks::mock_preference('AuthorityControlledIndicators', q{} ); + $res = $oInd->get({ + flavour => "MARC21", + report_tag => '100', + auth_record => $record, + biblio_tag => '700', + }); + is( $res->{ind1}, '4', 'Cache not cleared yet' ); + $oInd->clear; + $res = $oInd->get({ + flavour => "MARC21", + report_tag => '100', + auth_record => $record, + biblio_tag => '700', + }); + is_deeply( $res, {}, 'Cache cleared' ); +}; --