koha-dev.rot13.org Git - koha_ffzg/blob - 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 @results;
  82     foreach my $current_record (@records) {
  83         my $result        = $current_record->clone();
  84         my $interface     = $self->{options}->{interface} // 'opac';
  85         my $frameworkcode = $self->{options}->{frameworkcode} // q{};
  86         my $hide          = _should_hide_on_interface();
  87
  88         my $marcsubfieldstructure = GetMarcStructure( 0, $frameworkcode );
  89
  90         #if ($marcsubfieldstructure->{'000'}->{'@'}->{hidden}>0) {
  91         # LDR field is excluded from $current_record->fields().
  92         # if we hide it here, the MARCXML->MARC::Record->MARCXML
  93         # transformation blows up.
  94         #}
  95         foreach my $field ( $result->fields() ) {
  96             _filter_field(
  97                 {
  98                     field                 => $field,
  99                     marcsubfieldstructure => $marcsubfieldstructure,
 100                     hide                  => $hide,
 101                     interface             => $interface,
 102                     result                => $result
 103                 }
 104             );
 105         }
 106         push @results, $result;
 107     }
 108
 109     if ( scalar @results == 1 ) {
 110         return $results[0];
 111     }
 112     else {
 113         return \@results;
 114     }
 115 }
 116
 117 sub _filter_field {
 118     my ($parameter) = @_;
 119
 120     my $field                 = $parameter->{field};
 121     my $marcsubfieldstructure = $parameter->{marcsubfieldstructure};
 122     my $hide                  = $parameter->{hide};
 123     my $interface             = $parameter->{interface};
 124     my $result                = $parameter->{result};
 125
 126     my $tag = $field->tag();
 127     if ( $tag >= FIRST_NONCONTROL_TAG ) {
 128         foreach my $subpairs ( $field->subfields() ) {
 129             my ( $subtag, $value ) = @{$subpairs};
 130
 131             # visibility is a "level" (-9 to +9), default to 0
 132             # -8 is flagged, and 9/-9 are not implemented.
 133             my $visibility =
 134               $marcsubfieldstructure->{$tag}->{$subtag}->{hidden};
 135             $visibility //= 0;
 136             if ( $hide->{$interface}->{$visibility} ) {
 137
 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     # control tags don't have subfields, use @ trick.
 151     else {
 152         # visibility is a "level" (-9 to +9), default to 0
 153         # -8 is flagged, and 9/-9 are not implemented.
 154         my $visibility = $marcsubfieldstructure->{$tag}->{q{@}}->{hidden};
 155         $visibility //= 0;
 156         if ( $hide->{$interface}->{$visibility} ) {
 157             $result->delete_fields($field);
 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 # Copied and modified from 3.10.x help file
 175 # marc_subfields_structure.hidden
 176 # allows you to select from 19 possible visibility conditions, 17 of which are implemented. They are the following:
 177 # -9 => Future use
 178 # -8 => Flag
 179 # -7 => OPAC !Intranet !Editor Collapsed
 180 # -6 => OPAC Intranet !Editor !Collapsed
 181 # -5 => OPAC Intranet !Editor Collapsed
 182 # -4 => OPAC !Intranet !Editor !Collapsed
 183 # -3 => OPAC !Intranet Editor Collapsed
 184 # -2 => OPAC !Intranet Editor !Collapsed
 185 # -1 => OPAC Intranet Editor Collapsed
 186 # 0 => OPAC Intranet Editor !Collapsed
 187 # 1 => !OPAC Intranet Editor Collapsed
 188 # 2 => !OPAC !Intranet Editor !Collapsed
 189 # 3 => !OPAC !Intranet Editor Collapsed
 190 # 4 => !OPAC Intranet Editor !Collapsed
 191 # 5 => !OPAC !Intranet !Editor Collapsed
 192 # 6 => !OPAC Intranet !Editor !Collapsed
 193 # 7 => !OPAC Intranet !Editor Collapsed
 194 # 8 => !OPAC !Intranet !Editor !Collapsed
 195 # 9 => Future use
 196 # ( ! means 'not visible' or in the case of Collapsed 'not Collapsed')
 197
 198 sub _should_hide_on_interface {
 199     my $hide = {
 200         opac => {
 201             '-8' => 1,
 202             '1'  => 1,
 203             '2'  => 1,
 204             '3'  => 1,
 205             '4'  => 1,
 206             '5'  => 1,
 207             '6'  => 1,
 208             '7'  => 1,
 209             '8'  => 1,
 210         },
 211         intranet => {
 212             '-8' => 1,
 213             '-7' => 1,
 214             '-4' => 1,
 215             '-3' => 1,
 216             '-2' => 1,
 217             '2'  => 1,
 218             '3'  => 1,
 219             '5'  => 1,
 220             '8'  => 1,
 221         },
 222     };
 223     return $hide;
 224 }
 225
 226 =head1 DIAGNOSTICS
 227
 228  $ prove -v t/RecordProcessor.t
 229  $ prove -v t/db_dependent/Filter_MARC_ViewPolicy.t
 230
 231 =head1 CONFIGURATION AND ENVIRONMENT
 232
 233 Install Koha. This filter will be used appropriately by the OPAC or Staff client.
 234
 235 =head1 INCOMPATIBILITIES
 236
 237 This is designed for MARC::Record filtering currently. It will not handle MARC::MARCXML.
 238
 239 =head1 DEPENDENCIES
 240
 241 The following Perl libraries are required: Modern::Perl and Carp.
 242 The following Koha libraries are required: C4::Biblio, Koha::RecordProcessor, and Koha::RecordProcessor::Base.
 243 These should all be installed if the koha-common package is installed or Koha is otherwise installed.
 244
 245 =head1 BUGS AND LIMITATIONS
 246
 247 This is the initial version. Please feel free to report bugs
 248 at http://bugs.koha-community.org/.
 249
 250 =head1 AUTHOR
 251
 252 Mark Tompsett
 253
 254 =head1 LICENSE AND COPYRIGHT
 255
 256 Copyright 2015 Mark Tompsett
 257
 258 This file is part of Koha.
 259
 260 Koha is free software; you can redistribute it and/or modify it
 261 under the terms of the GNU General Public License as published by
 262 the Free Software Foundation; either version 3 of the License, or
 263 (at your option) any later version.
 264
 265 Koha is distributed in the hope that it will be useful, but
 266 WITHOUT ANY WARRANTY; without even the implied warranty of
 267 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
 268 GNU General Public License for more details.
 269
 270 You should have received a copy of the GNU General Public License
 271 along with Koha; if not, see <http://www.gnu.org/licenses>.
 272
 273 =cut
 274
 275 1;