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

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

Return to bug 16335