View | Details | Raw Unified | Return to bug 14769
Collapse All | Expand All

(-)a/Koha/Authority/ControlledIndicators.pm (+139 lines)
Line 0 Link Here
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;
(-)a/t/Koha/Authority/ControlledIndicators.t (-1 / +73 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
use Modern::Perl;
4
use Data::Dumper qw/Dumper/;
5
use MARC::Record;
6
use MARC::Field;
7
use Test::More tests => 1;
8
9
use t::lib::Mocks;
10
use Koha::Authority::ControlledIndicators;
11
12
subtest "Simple tests" => sub {
13
    plan tests => 10;
14
15
    t::lib::Mocks::mock_preference('AuthorityControlledIndicators', q|
16
marc21,600,ind1:auth1,ind2:x
17
marc21,700,ind1:auth2,
18
marc21,800,ind1:,
19
    |);
20
21
    my $oInd = Koha::Authority::ControlledIndicators->new;
22
23
    is_deeply( $oInd->get({}), {}, 'Empty hash for no parameters' );
24
    my $record = MARC::Record->new;
25
    $record->append_fields(
26
        MARC::Field->new( '100', '3', '4', a => 'My name' ),
27
    );
28
    my $res = $oInd->get({
29
        flavour => "MARC21",
30
        report_tag  => '100',
31
        auth_record => $record,
32
        biblio_tag  => '600',
33
    });
34
    is( $res->{ind1}, '3', 'Check 1st indicator' );
35
    is( exists $res->{ind2}, 1, 'Check existence of 2nd indicator key' );
36
    is( $res->{ind2}, 'x', 'Check 2nd indicator value' );
37
38
    $res = $oInd->get({
39
        flavour => "MARC21",
40
        report_tag  => '100',
41
        auth_record => $record,
42
        biblio_tag  => '700',
43
    });
44
    is( $res->{ind1}, '4', 'Check 1st indicator' );
45
    is( exists $res->{ind2}, '', 'Check if 2nd indicator key does not exist' );
46
47
    $res = $oInd->get({
48
        flavour => "MARC21",
49
        report_tag  => '100',
50
        auth_record => $record,
51
        biblio_tag  => '800',
52
    });
53
    is( $res->{ind1}, '', 'ind1: clears 1st indicator' );
54
    is( exists $res->{ind2}, '', 'Check if 2nd indicator key does not exist' );
55
56
    # Test caching
57
    t::lib::Mocks::mock_preference('AuthorityControlledIndicators', q{} );
58
    $res = $oInd->get({
59
        flavour => "MARC21",
60
        report_tag  => '100',
61
        auth_record => $record,
62
        biblio_tag  => '700',
63
    });
64
    is( $res->{ind1}, '4', 'Cache not cleared yet' );
65
    $oInd->clear;
66
    $res = $oInd->get({
67
        flavour => "MARC21",
68
        report_tag  => '100',
69
        auth_record => $record,
70
        biblio_tag  => '700',
71
    });
72
    is_deeply( $res, {}, 'Cache cleared' );
73
};

Return to bug 14769