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

(-)a/Koha/Filter/MARC/OpacHiddenItems.pm (+223 lines)
Line 0 Link Here
1
package Koha::Filter::MARC::OpacHiddenItems;
2
3
# Copyright 2016 Mark Tompsett
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
=head1 NAME
21
22
Koha::Filter::MARC::OpacHiddenItems - this filters a MARC record.
23
24
=head1 VERSION
25
26
version 1.0
27
28
=head1 SYNOPSIS
29
30
my $processor = Koha::RecordProcessor->new( { filters => ('OpacHiddenItems') } );
31
32
=head1 DESCRIPTION
33
34
Filter to remove fields based on the OPAC system preference OpacHiddenItems.
35
36
=cut
37
38
use C4::Biblio;
39
use Carp;
40
use Const::Fast;
41
use English qw( -no_match_vars );
42
use List::Util qw/any/;
43
use Modern::Perl;
44
use YAML;
45
46
use base qw(Koha::RecordProcessor::Base);
47
48
our $NAME    = 'MARC_OpacHiddenItems';
49
our $VERSION = '3.25';                   # Master version I hope it gets in.
50
51
const my $FIRST_NONCONTROL_TAG => 10;    # tags < 10 are control tags.
52
53
=head1 SUBROUTINES/METHODS
54
55
=head2 filter
56
57
    my $processor = Koha::RecordProcessor->new( { filters => ('OpacHiddenItems') } );
58
...
59
    my $newrecord = $processor->filter($record);
60
    my $newrecords = $processor->filter(\@records);
61
62
This returns a filtered copy of the record based on the Advanced constraints
63
visibility settings.
64
65
=cut
66
67
sub filter {
68
    my $self    = shift;
69
    my $precord = shift;
70
    my @records;
71
72
    if ( !$precord ) {
73
        return $precord;
74
    }
75
76
    if ( ref($precord) eq 'ARRAY' ) {
77
        @records = @{$precord};
78
    }
79
    else {
80
        push @records, $precord;
81
    }
82
83
    my $yaml = C4::Context->preference('OpacHiddenItems');
84
    return () if ( !$yaml =~ /\S/xsm );
85
    $yaml = "$yaml\n\n";    # YAML is anal on ending \n. Surplus does not hurt
86
    my $hidingrules;
87
    my $return_value = eval { $hidingrules = YAML::Load($yaml); };
88
    if ( $EVAL_ERROR || !$return_value ) {
89
        carp
90
"Unable to parse OpacHiddenItems syspref : $EVAL_ERROR ($return_value)";
91
        return;
92
    }
93
    my $dbh = C4::Context->dbh;
94
95
    foreach my $current_record (@records) {
96
        my $biblionumber =
97
          C4::Biblio::get_koha_field_from_marc( 'biblio', 'biblionumber',
98
            $current_record, q{} );
99
        my $frameworkcode = q{};
100
        if ( defined $biblionumber ) {
101
            my $biblio = GetBiblio($biblionumber);
102
            $frameworkcode = $biblio->{'frameworkcode'} // q{};
103
        }
104
        _filter_record( $hidingrules, $current_record, $frameworkcode );
105
    }
106
    return;
107
}
108
109
sub _filter_record {
110
    my ( $hidingrules, $current_record, $frameworkcode ) = @_;
111
112
    my $dbh = C4::Context->dbh;
113
114
    # Run through the MARC record's subfields...
115
    my @fields = $current_record->fields();
116
    foreach my $field (@fields) {
117
118
        my $tag = $field->tag();
119
        if ( int($tag) < $FIRST_NONCONTROL_TAG ) {
120
            next;
121
        }
122
123
        # Purposely put into array variable, so as not
124
        # to potentially re-evaluate a mixed up array in the
125
        # midst of subfield deletes.
126
        my @subfields = $field->subfields();
127
        foreach my $subfield (@subfields) {
128
129
            # determine it's tag, subtag, and value.
130
            my $subtag = $subfield->[0];
131
            my $value  = $subfield->[1];
132
133
            # find the matching kohafield, if it is in items
134
            my @params = ( $tag, $subtag );
135
            my $kohafield = $dbh->selectrow_array(
136
                'SELECT kohafield FROM marc_subfield_structure '
137
                  . q{WHERE kohafield LIKE 'items.%' AND }
138
                  . 'tagfield=? and tagsubfield=?',
139
                undef, @params
140
            );
141
142
            # if there is a corresponding items kohafield...
143
            if ( defined $kohafield ) {
144
                $kohafield =~ s/items.//xsmg;
145
146
                # Check it against what is supposed to be hidden.
147
                if ( any { $value eq $_ } @{ $hidingrules->{$kohafield} } ) {
148
149
                    # When it's the last subfield.
150
                    if ( scalar $field->subfields() == 1 ) {
151
                        $current_record->delete_field($field);
152
                    }
153
                    else {
154
                        # Otherwise, just delete the subfield.
155
                        $field->delete_subfield( code => $subtag );
156
                    }
157
                }
158
            }
159
        }
160
    }
161
    return;
162
}
163
164
sub initialize {
165
    my $self  = shift;
166
    my $param = shift;
167
168
    my $options = $param->{options};
169
    $self->{options} = $options;
170
    $self->Koha::RecordProcessor::Base::initialize($param);
171
    return;
172
}
173
174
=head1 DIAGNOSTICS
175
176
 $ prove -v t/RecordProcessor.t
177
 $ prove -v t/db_dependent/Filter_MARC_OpacHiddenItems.t
178
179
=head1 CONFIGURATION AND ENVIRONMENT
180
181
Install Koha. This filter will be used appropriately by the OPAC or Staff client.
182
183
=head1 INCOMPATIBILITIES
184
185
This is designed for MARC::Record filtering currently. It will not handle MARC::MARCXML.
186
187
=head1 DEPENDENCIES
188
189
The following Perl libraries are required: Modern::Perl and Carp.
190
The following Koha libraries are required: C4::Biblio, Koha::RecordProcessor, and Koha::RecordProcessor::Base.
191
These should all be installed if the koha-common package is installed or Koha is otherwise installed.
192
193
=head1 BUGS AND LIMITATIONS
194
195
This is the initial version. Please feel free to report bugs
196
at http://bugs.koha-community.org/.
197
198
=head1 AUTHOR
199
200
Mark Tompsett
201
202
=head1 LICENSE AND COPYRIGHT
203
204
Copyright 2016 Mark Tompsett
205
206
This file is part of Koha.
207
208
Koha is free software; you can redistribute it and/or modify it
209
under the terms of the GNU General Public License as published by
210
the Free Software Foundation; either version 3 of the License, or
211
(at your option) any later version.
212
213
Koha is distributed in the hope that it will be useful, but
214
WITHOUT ANY WARRANTY; without even the implied warranty of
215
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
216
GNU General Public License for more details.
217
218
You should have received a copy of the GNU General Public License
219
along with Koha; if not, see <http://www.gnu.org/licenses>.
220
221
=cut
222
223
1;
(-)a/t/db_dependent/Filter_MARC_OpacHiddenItems.t (-1 / +141 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# This file is part of Koha.
4
#
5
# Copyright 2015 Mark Tompsett
6
#                - Initial commit, perlcritic clean-up, and
7
#                  debugging
8
# Copyright 2016 Tomas Cohen Arazi
9
#                - Expansion of test cases to be comprehensive
10
#
11
# Koha is free software; you can redistribute it and/or modify it
12
# under the terms of the GNU General Public License as published by
13
# the Free Software Foundation; either version 3 of the License, or
14
# (at your option) any later version.
15
#
16
# Koha is distributed in the hope that it will be useful, but
17
# WITHOUT ANY WARRANTY; without even the implied warranty of
18
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19
# GNU General Public License for more details.
20
#
21
# You should have received a copy of the GNU General Public License
22
# along with Koha; if not, see <http://www.gnu.org/licenses>.
23
24
use Modern::Perl;
25
26
use Test::More tests => 4;
27
28
use List::MoreUtils qw/any/;
29
use MARC::Record;
30
use MARC::Field;
31
use C4::Context;
32
use C4::Biblio;
33
use Koha::Cache qw/flush_all/;
34
use Koha::Database;
35
36
BEGIN {
37
    use_ok('Koha::RecordProcessor');
38
}
39
40
my $dbh = C4::Context->dbh;
41
42
my $database = Koha::Database->new();
43
my $schema   = $database->schema();
44
$dbh->{RaiseError} = 1;
45
46
sub run_hiding_tests {
47
48
    my $cache = Koha::Cache->get_instance();
49
    $cache->flush_all();    # easy way to ensure DB is queried again.
50
51
    my $processor = Koha::RecordProcessor->new(
52
        {
53
            schema  => 'MARC',
54
            filters => ('OpacHiddenItems')
55
        }
56
    );
57
58
    is(
59
        ref( $processor->filters->[0] ),
60
        'Koha::Filter::MARC::OpacHiddenItems',
61
        'Created record processor with OpacHiddenItems filter'
62
    );
63
64
    # Create a fresh record
65
    my $sample_record     = create_marc_record();
66
    my $unfiltered_record = $sample_record->clone();
67
68
    # Apply filters
69
    my $filtered_record = $processor->process($sample_record);
70
71
    # Data fields
72
    my $opac_hidden_items = C4::Context->preference('OpacHiddenItems');
73
    if ( $opac_hidden_items eq q{} ) {
74
        is_deeply( $unfiltered_record, $filtered_record,
75
            'No filtering is unfiltered.' );
76
    }
77
    elsif ( $opac_hidden_items =~ /BARCODE2/xsm ) {
78
        is_deeply( $unfiltered_record, $filtered_record,
79
            'Mismatched filtering is unfiltered.' );
80
    }
81
    else {
82
        my ( $barcode_tag, $barcode_subtag ) =
83
          GetMarcFromKohaField( 'items.barcode', q{} );
84
        my $value = $filtered_record->subfield( $barcode_tag, $barcode_subtag );
85
        ok( !defined $value, 'Filtered subfield is hidden.' );
86
    }
87
    return;
88
}
89
90
sub create_marc_record {
91
92
    my ( $title_field, $title_subfield ) =
93
      GetMarcFromKohaField( 'biblio.title', q{} );
94
    my ( $isbn_field, $isbn_subfield ) =
95
      GetMarcFromKohaField( 'biblioitems.isbn', q{} );
96
    my ( $bc_tag, $bc_subtag ) = GetMarcFromKohaField( 'items.barcode', q{} );
97
    my $isbn        = '0590353403';
98
    my $title       = 'Foundation';
99
    my $barcode     = 'BARCODE1';
100
    my $marc_record = MARC::Record->new;
101
    my @fields      = (
102
        MARC::Field->new( '003', 'AR-CdUBM' ),
103
        MARC::Field->new( '008', '######suuuu####ag_||||__||||_0||_|_uuu|d' ),
104
        MARC::Field->new( $isbn_field,  q{}, q{}, $isbn_subfield  => $isbn ),
105
        MARC::Field->new( $title_field, q{}, q{}, $title_subfield => $title ),
106
        MARC::Field->new( $bc_tag,      q{}, q{}, $bc_subtag      => $barcode ),
107
    );
108
109
    $marc_record->insert_fields_ordered(@fields);
110
111
    return $marc_record;
112
}
113
114
subtest 'Koha::Filter::MARC::OpacHiddenItem hide rules match' => sub {
115
    plan tests => 2;
116
117
    $schema->storage->txn_begin();
118
    C4::Context->set_preference( 'OpacHiddenItems', "barcode: [BARCODE1]\n\n" );
119
    run_hiding_tests;
120
    $schema->storage->txn_rollback();
121
};
122
123
subtest 'Koha::Filter::MARC::OpacHiddenItem show with rules' => sub {
124
    plan tests => 2;
125
126
    $schema->storage->txn_begin();
127
    C4::Context->set_preference( 'OpacHiddenItems', "barcode: [BARCODE2]\n\n" );
128
    run_hiding_tests;
129
    $schema->storage->txn_rollback();
130
};
131
132
subtest 'Koha::Filter::MARC::OpacHiddenItem show with no rules' => sub {
133
    plan tests => 2;
134
135
    $schema->storage->txn_begin();
136
    C4::Context->set_preference( 'OpacHiddenItems', q{} );
137
    run_hiding_tests;
138
    $schema->storage->txn_rollback();
139
};
140
141
1;

Return to bug 16335