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

(-)a/Koha/Filter/MARC/ViewPolicy.pm (+252 lines)
Line 0 Link Here
1
package Koha::Filter::MARC::ViewPolicy;
2
3
# Copyright 2015 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::ViewPolicy - 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 => ('ViewPolicy') } );
31
32
=head1 DESCRIPTION
33
34
Filter to remove fields based on the 'Advance constraints'
35
settings found when editing a particular subfield definition of
36
a MARC bibliographic framework found under the Koha administration
37
menu.
38
39
=cut
40
41
use Modern::Perl;
42
use Carp;
43
use C4::Biblio;
44
45
use base qw(Koha::RecordProcessor::Base);
46
our $NAME    = 'MARC_ViewPolicy';
47
our $VERSION = '3.23'; # Master version I hope it gets in.
48
49
=head1 SUBROUTINES/METHODS
50
51
=head2 filter
52
53
    my $processor = Koha::RecordProcessor->new( { filters => ('ViewPolicy') } );
54
...
55
    my $newrecord = $processor->filter($record);
56
    my $newrecords = $processor->filter(\@records);
57
58
This returns a filtered copy of the record based on the Advanced constraints
59
visibility settings.
60
61
=cut
62
63
sub filter {
64
    my $self    = shift;
65
    my $precord = shift;
66
    my @records;
67
68
    if ( !$precord ) {
69
        return $precord;
70
    }
71
72
    if ( ref($precord) eq 'ARRAY' ) {
73
        @records = @{$precord};
74
    }
75
    else {
76
        push @records, $precord;
77
    }
78
79
    my @results;
80
    foreach my $current_record (@records) {
81
        my $result        = $current_record->clone();
82
        my $interface     = $self->{options}->{interface} // 'opac';
83
        my $frameworkcode = $self->{options}->{frameworkcode} // q{};
84
        my $display       = _should_display_on_interface();
85
86
        my $marcsubfieldstructure = GetMarcStructure( 0, $frameworkcode );
87
88
        #if ($marcsubfieldstructure->{'000'}->{'@'}->{hidden}>0) {
89
        # LDR field is excluded from $current_record->fields().
90
        # if we hide it here, the MARCXML->MARC::Record->MARCXML
91
        # transformation blows up.
92
        #}
93
        foreach my $field ( $result->fields() ) {
94
            _filter_field(
95
                {
96
                    field                 => $field,
97
                    marcsubfieldstructure => $marcsubfieldstructure,
98
                    display               => $display,
99
                    interface             => $interface,
100
                    result                => $result
101
                }
102
            );
103
        }
104
        push @results, $result;
105
    }
106
107
    if ( scalar @results == 1 ) {
108
        return $results[0];
109
    }
110
    else {
111
        return \@results;
112
    }
113
}
114
115
sub _filter_field {
116
    my ($parameter) = @_;
117
118
    my $field                 = $parameter->{field};
119
    my $marcsubfieldstructure = $parameter->{marcsubfieldstructure};
120
    my $display               = $parameter->{display};
121
    my $interface             = $parameter->{interface};
122
    my $result                = $parameter->{result};
123
124
    my $tag = $field->tag();
125
    if ( $tag >= 10 ) {
126
        foreach my $subpairs ( $field->subfields() ) {
127
            my ( $subtag, $value ) = @{$subpairs};
128
129
            # visibility is a "level" (-7 to +7), default to 0
130
            my $visibility =
131
              $marcsubfieldstructure->{$tag}->{$subtag}->{hidden};
132
            $visibility //= 0;
133
            my $hidden;
134
            if ( $display->{$interface}->{$visibility} ) {
135
                $hidden = 0;
136
            }
137
            else {
138
                # deleting last subfield doesn't delete field, so
139
                # this detects that case to delete the field.
140
                if ( scalar $field->subfields() <= 1 ) {
141
                    $result->delete_fields($field);
142
                }
143
                else {
144
                    $field->delete_subfield( code => $subtag );
145
                }
146
            }
147
        }
148
    }
149
150
    # tags less than 10 don't have subfields, use @ trick.
151
    else {
152
        # visibility is a "level" (-7 to +7), default to 0
153
        my $visibility = $marcsubfieldstructure->{$tag}->{q{@}}->{hidden};
154
        $visibility //= 0;
155
        my $hidden;
156
        if ( $display->{$interface}->{$visibility} ) {
157
            $hidden = 0;
158
        }
159
        else {
160
            $hidden = 1;
161
            $result->delete_fields($field);
162
        }
163
    }
164
    return;
165
}
166
167
sub initialize {
168
    my $self  = shift;
169
    my $param = shift;
170
171
    my $options = $param->{options};
172
    $self->{options} = $options;
173
    $self->Koha::RecordProcessor::Base::initialize($param);
174
    return;
175
}
176
177
sub _should_display_on_interface {
178
    my $display = {
179
        opac => {
180
            0  => 1,
181
            -1 => 1,
182
            -2 => 1,
183
            -3 => 1,
184
            -4 => 1,
185
            -5 => 1,
186
            -6 => 1,
187
            -7 => 1,
188
        },
189
        intranet => {
190
            -6 => 1,
191
            -5 => 1,
192
            -1 => 1,
193
            0  => 1,
194
            1  => 1,
195
            4  => 1,
196
            6  => 1,
197
            7  => 1,
198
        },
199
    };
200
    return $display;
201
}
202
203
=head1 DIAGNOSTICS
204
205
 $ prove -v t/RecordProcessor.t
206
 $ prove -v t/db_dependent/RecordProcessor_ViewPolicy.t
207
208
=head1 CONFIGURATION AND ENVIRONMENT
209
210
Install Koha. This filter will be used appropriately by the OPAC or Staff client.
211
212
=head1 INCOMPATIBILITIES
213
214
This is designed for MARC::Record filtering currently. It will not handle MARC::MARCXML.
215
216
=head1 DEPENDENCIES
217
218
The following Perl libraries are required: Modern::Perl and Carp.
219
The following Koha libraries are required: C4::Biblio, Koha::RecordProcessor, and Koha::RecordProcessor::Base.
220
These should all be installed if the koha-common package is installed or Koha is otherwise installed.
221
222
=head1 BUGS AND LIMITATIONS
223
224
This is the initial version. Please feel free to report bugs
225
at http://bugs.koha-community.org/.
226
227
=head1 AUTHOR
228
229
Mark Tompsett
230
231
=head1 LICENSE AND COPYRIGHT
232
233
Copyright 2015 Mark Tompsett
234
235
This file is part of Koha.
236
237
Koha is free software; you can redistribute it and/or modify it
238
under the terms of the GNU General Public License as published by
239
the Free Software Foundation; either version 3 of the License, or
240
(at your option) any later version.
241
242
Koha is distributed in the hope that it will be useful, but
243
WITHOUT ANY WARRANTY; without even the implied warranty of
244
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
245
GNU General Public License for more details.
246
247
You should have received a copy of the GNU General Public License
248
along with Koha; if not, see <http://www.gnu.org/licenses>.
249
250
=cut
251
252
1;
(-)a/t/db_dependent/RecordProcessor_ViewPolicy.t (-1 / +68 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
#
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
use Modern::Perl;
21
use MARC::Record;
22
use MARC::Field;
23
use Test::More;
24
use C4::Context;
25
use Koha::Database;
26
use Data::Dumper;
27
28
BEGIN {
29
    use_ok('Koha::RecordProcessor');
30
}
31
32
our $VERSION = '3.23';    # Master version that I hope it gets in.
33
34
my $dbh = C4::Context->dbh;
35
36
my $database = Koha::Database->new();
37
my $schema   = $database->schema();
38
$schema->storage->txn_begin();
39
40
$dbh->{RaiseError} = 1;
41
42
$dbh->do(q{UPDATE marc_subfield_structure SET hidden=2 WHERE tagfield='020';});
43
44
my $isbn        = '0590353403';
45
my $title       = 'Foundation';
46
my $marc_record = MARC::Record->new;
47
my $field       = MARC::Field->new( '020', q{}, q{}, 'a' => $isbn );
48
$marc_record->append_fields($field);
49
$field = MARC::Field->new( '245', q{}, q{}, 'a' => $title );
50
$marc_record->append_fields($field);
51
52
my $processor = Koha::RecordProcessor->new(
53
    { filters => ('ViewPolicy'), options => { 'test' => 'value1' } } );
54
is(
55
    ref( $processor->filters->[0] ),
56
    'Koha::Filter::MARC::ViewPolicy',
57
    'Created record processor with implicitly scoped ViewPolicy filter'
58
);
59
my $after_record    = $processor->process($marc_record);
60
my $modified_record = $marc_record->clone;
61
my @isbn            = $modified_record->field('020');
62
$modified_record->delete_fields(@isbn);
63
is_deeply( $modified_record, $after_record,
64
    'Filtered and modified MARC record match' );
65
66
$schema->storage->txn_rollback();
67
68
done_testing();

Return to bug 15870