1b7ef7468c4df2c6c52afdf88101ca8f6fa714d5
[srvgit] / Koha / Filter / MARC / ViewPolicy.pm
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 use constant FIRST_NONCONTROL_TAG => 10;    # tags < 10 are control tags.
50
51 =head1 SUBROUTINES/METHODS
52
53 =head2 filter
54
55     my $processor = Koha::RecordProcessor->new( { filters => ('ViewPolicy') } );
56 ...
57     my $newrecord = $processor->filter($record);
58     my $newrecords = $processor->filter(\@records);
59
60 This returns a filtered copy of the record based on the Advanced constraints
61 visibility settings.
62
63 =cut
64
65 sub filter {
66     my $self    = shift;
67     my $precord = shift;
68     my @records;
69
70     if ( !$precord ) {
71         return $precord;
72     }
73
74     if ( ref($precord) eq 'ARRAY' ) {
75         @records = @{$precord};
76     }
77     else {
78         push @records, $precord;
79     }
80
81     my $params = $self->params;
82     my $interface     = $params->{options}->{interface} // 'opac';
83     my $frameworkcode = $params->{options}->{frameworkcode} // q{};
84
85     foreach my $current_record (@records) {
86         my $result        = $current_record;
87         my $hide          = _should_hide_on_interface();
88
89         my $marcsubfieldstructure = GetMarcStructure( 0, $frameworkcode, { unsafe => 1 } );
90
91         #if ($marcsubfieldstructure->{'000'}->{'@'}->{hidden}>0) {
92         # LDR field is excluded from $current_record->fields().
93         # if we hide it here, the MARCXML->MARC::Record->MARCXML
94         # transformation blows up.
95         #}
96         foreach my $field ( $result->fields() ) {
97             _filter_field(
98                 {
99                     field                 => $field,
100                     marcsubfieldstructure => $marcsubfieldstructure,
101                     hide                  => $hide,
102                     interface             => $interface,
103                     result                => $result
104                 }
105             );
106         }
107     }
108     return;
109 }
110
111 sub _filter_field {
112     my ($parameter) = @_;
113
114     my $field                 = $parameter->{field};
115     my $marcsubfieldstructure = $parameter->{marcsubfieldstructure};
116     my $hide                  = $parameter->{hide};
117     my $interface             = $parameter->{interface};
118     my $result                = $parameter->{result};
119
120     my $tag = $field->tag();
121     if ( $tag >= FIRST_NONCONTROL_TAG ) {
122         foreach my $subpairs ( $field->subfields() ) {
123             my ( $subtag, $value ) = @{$subpairs};
124
125             # visibility is a "level" (-9 to +9), default to 0
126             # -8 is flagged, and 9/-9 are not implemented.
127             my $visibility =
128               $marcsubfieldstructure->{$tag}->{$subtag}->{hidden};
129             $visibility //= 0;
130             if ( $hide->{$interface}->{$visibility} ) {
131
132                 # deleting last subfield doesn't delete field, so
133                 # this detects that case to delete the field.
134                 if ( scalar $field->subfields() <= 1 ) {
135                     $result->delete_fields($field);
136                 }
137                 else {
138                     $field->delete_subfield( code => $subtag );
139                 }
140             }
141         }
142     }
143
144     # control tags don't have subfields, use @ trick.
145     else {
146         # visibility is a "level" (-9 to +9), default to 0
147         # -8 is flagged, and 9/-9 are not implemented.
148         my $visibility = $marcsubfieldstructure->{$tag}->{q{@}}->{hidden};
149         $visibility //= 0;
150         if ( $hide->{$interface}->{$visibility} ) {
151             $result->delete_fields($field);
152         }
153
154     }
155     return;
156 }
157
158 # Copied and modified from 3.10.x help file
159 # marc_subfields_structure.hidden
160 # allows you to select from 19 possible visibility conditions, 17 of which are implemented. They are the following:
161 # -9 => Future use
162 # -8 => Flag
163 # -7 => OPAC !Intranet !Editor Collapsed
164 # -6 => OPAC Intranet !Editor !Collapsed
165 # -5 => OPAC Intranet !Editor Collapsed
166 # -4 => OPAC !Intranet !Editor !Collapsed
167 # -3 => OPAC !Intranet Editor Collapsed
168 # -2 => OPAC !Intranet Editor !Collapsed
169 # -1 => OPAC Intranet Editor Collapsed
170 # 0 => OPAC Intranet Editor !Collapsed
171 # 1 => !OPAC Intranet Editor Collapsed
172 # 2 => !OPAC !Intranet Editor !Collapsed
173 # 3 => !OPAC !Intranet Editor Collapsed
174 # 4 => !OPAC Intranet Editor !Collapsed
175 # 5 => !OPAC !Intranet !Editor Collapsed
176 # 6 => !OPAC Intranet !Editor !Collapsed
177 # 7 => !OPAC Intranet !Editor Collapsed
178 # 8 => !OPAC !Intranet !Editor !Collapsed
179 # 9 => Future use
180 # ( ! means 'not visible' or in the case of Collapsed 'not Collapsed')
181
182 sub _should_hide_on_interface {
183     my $hide = {
184         opac => {
185             '-8' => 1,
186             '1'  => 1,
187             '2'  => 1,
188             '3'  => 1,
189             '4'  => 1,
190             '5'  => 1,
191             '6'  => 1,
192             '7'  => 1,
193             '8'  => 1,
194         },
195         intranet => {
196             '-8' => 1,
197             '-7' => 1,
198             '-4' => 1,
199             '-3' => 1,
200             '-2' => 1,
201             '2'  => 1,
202             '3'  => 1,
203             '5'  => 1,
204             '8'  => 1,
205         },
206     };
207     return $hide;
208 }
209
210 =head2 should_hide_marc
211
212 Return a hash reference of whether a field, built from
213 kohafield and tag, is hidden (1) or not (0) for a given
214 interface
215
216   my $OpacHideMARC =
217     should_hide_marc( {
218                         frameworkcode => $frameworkcode,
219                         interface     => 'opac',
220                       } );
221
222   if ($OpacHideMARC->{'stocknumber'}==1) {
223        print "Hidden!\n";
224   }
225
226 C<$OpacHideMARC> is a ref to a hash which contains a series
227 of key value pairs indicating if that field (key) is
228 hidden (value == 1) or not (value == 0).
229
230 C<$frameworkcode> is the framework code.
231
232 C<$interface> is the interface. It defaults to 'opac' if
233 nothing is passed. Valid values include 'opac' or 'intranet'.
234
235 =cut
236
237 sub should_hide_marc {
238     my ( $self, $parms ) = @_;
239     my $frameworkcode = $parms->{frameworkcode} // q{};
240     my $interface     = $parms->{interface}     // 'opac';
241     my $hide          = _should_hide_on_interface();
242
243     my %shouldhidemarc;
244     my $marc_subfield_structure = GetMarcStructure( 0, $frameworkcode );
245     foreach my $tag ( keys %{$marc_subfield_structure} ) {
246         foreach my $subtag ( keys %{ $marc_subfield_structure->{$tag} } ) {
247             my $subfield_record = $marc_subfield_structure->{$tag}->{$subtag};
248             if ( ref $subfield_record eq 'HASH' ) {
249                 my $kohafield = $subfield_record->{'kohafield'};
250                 if ($kohafield) {
251                     my @tmpsplit   = split /[.]/xsm, $kohafield;
252                     my $field      = $tmpsplit[-1];
253                     my $hidden     = $subfield_record->{'hidden'};
254                     my $shouldhide = $hide->{$interface}->{$hidden};
255                     if ($shouldhide) {
256                         $shouldhidemarc{$field} = 1;
257                     }
258                     elsif ( !exists $shouldhidemarc{$field} ) {
259                         $shouldhidemarc{$field} = 0;
260                     }
261                 }
262             }
263         }
264     }
265
266     return \%shouldhidemarc;
267 }
268
269 =head1 DIAGNOSTICS
270
271  $ prove -v t/RecordProcessor.t
272  $ prove -v t/db_dependent/Filter_MARC_ViewPolicy.t
273
274 =head1 CONFIGURATION AND ENVIRONMENT
275
276 Install Koha. This filter will be used appropriately by the OPAC or staff interface.
277
278 =head1 INCOMPATIBILITIES
279
280 This is designed for MARC::Record filtering currently. It will not handle MARC::MARCXML.
281
282 =head1 DEPENDENCIES
283
284 The following Perl libraries are required: Modern::Perl and Carp.
285 The following Koha libraries are required: C4::Biblio, Koha::RecordProcessor, and Koha::RecordProcessor::Base.
286 These should all be installed if the koha-common package is installed or Koha is otherwise installed.
287
288 =head1 BUGS AND LIMITATIONS
289
290 This is the initial version. Please feel free to report bugs
291 at http://bugs.koha-community.org/.
292
293 =head1 AUTHOR
294
295 Mark Tompsett
296
297 =head1 LICENSE AND COPYRIGHT
298
299 Copyright 2015 Mark Tompsett
300
301 This file is part of Koha.
302
303 Koha is free software; you can redistribute it and/or modify it
304 under the terms of the GNU General Public License as published by
305 the Free Software Foundation; either version 3 of the License, or
306 (at your option) any later version.
307
308 Koha is distributed in the hope that it will be useful, but
309 WITHOUT ANY WARRANTY; without even the implied warranty of
310 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
311 GNU General Public License for more details.
312
313 You should have received a copy of the GNU General Public License
314 along with Koha; if not, see <http://www.gnu.org/licenses>.
315
316 =cut
317
318 1;