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 =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;