Attachment #48766 for bug #15870

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




package Koha::Filter::MARC::ViewPolicy;

# Copyright 2015 Mark Tompsett
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.

=head1 NAME

Koha::Filter::MARC::ViewPolicy - this filters a MARC record.

=head1 VERSION

version 1.0

=head1 SYNOPSIS

my $processor = Koha::RecordProcessor->new( { filters => ('ViewPolicy') } );

=head1 DESCRIPTION

Filter to remove fields based on the 'Advance constraints'
settings found when editing a particular subfield definition of
a MARC bibliographic framework found under the Koha administration
menu.

=cut

use Modern::Perl;
use Carp;
use C4::Biblio;

use base qw(Koha::RecordProcessor::Base);
our $NAME    = 'MARC_ViewPolicy';
our $VERSION = '3.23'; # Master version I hope it gets in.

=head1 SUBROUTINES/METHODS

=head2 filter

    my $processor = Koha::RecordProcessor->new( { filters => ('ViewPolicy') } );
...
    my $newrecord = $processor->filter($record);
    my $newrecords = $processor->filter(\@records);

This returns a filtered copy of the record based on the Advanced constraints
visibility settings.

=cut

sub filter {
    my $self    = shift;
    my $precord = shift;
    my @records;

    if ( !$precord ) {
        return $precord;
    }

    if ( ref($precord) eq 'ARRAY' ) {
        @records = @{$precord};
    }
    else {
        push @records, $precord;
    }

    my @results;
    foreach my $current_record (@records) {
        my $result        = $current_record->clone();
        my $interface     = $self->{options}->{interface} // 'opac';
        my $frameworkcode = $self->{options}->{frameworkcode} // q{};
        my $display       = _should_display_on_interface();

        my $marcsubfieldstructure = GetMarcStructure( 0, $frameworkcode );

        #if ($marcsubfieldstructure->{'000'}->{'@'}->{hidden}>0) {
        # LDR field is excluded from $current_record->fields().
        # if we hide it here, the MARCXML->MARC::Record->MARCXML
        # transformation blows up.
        #}
        foreach my $field ( $result->fields() ) {
            _filter_field(
                {
                    field                 => $field,
                    marcsubfieldstructure => $marcsubfieldstructure,
                    display               => $display,
                    interface             => $interface,
                    result                => $result
                }
            );
        }
        push @results, $result;
    }

    if ( scalar @results == 1 ) {
        return $results[0];
    }
    else {
        return \@results;
    }
}

sub _filter_field {
    my ($parameter) = @_;

    my $field                 = $parameter->{field};
    my $marcsubfieldstructure = $parameter->{marcsubfieldstructure};
    my $display               = $parameter->{display};
    my $interface             = $parameter->{interface};
    my $result                = $parameter->{result};

    my $tag = $field->tag();
    if ( $tag >= 10 ) {
        foreach my $subpairs ( $field->subfields() ) {
            my ( $subtag, $value ) = @{$subpairs};

            # visibility is a "level" (-7 to +7), default to 0
            my $visibility =
              $marcsubfieldstructure->{$tag}->{$subtag}->{hidden};
            $visibility //= 0;
            my $hidden;
            if ( $display->{$interface}->{$visibility} ) {
                $hidden = 0;
            }
            else {
                # deleting last subfield doesn't delete field, so
                # this detects that case to delete the field.
                if ( scalar $field->subfields() <= 1 ) {
                    $result->delete_fields($field);
                }
                else {
                    $field->delete_subfield( code => $subtag );
                }
            }
        }
    }

    # tags less than 10 don't have subfields, use @ trick.
    else {
        # visibility is a "level" (-7 to +7), default to 0
        my $visibility = $marcsubfieldstructure->{$tag}->{q{@}}->{hidden};
        $visibility //= 0;
        my $hidden;
        if ( $display->{$interface}->{$visibility} ) {
            $hidden = 0;
        }
        else {
            $hidden = 1;
            $result->delete_fields($field);
        }
    }
    return;
}

sub initialize {
    my $self  = shift;
    my $param = shift;

    my $options = $param->{options};
    $self->{options} = $options;
    $self->Koha::RecordProcessor::Base::initialize($param);
    return;
}

sub _should_display_on_interface {
    my $display = {
        opac => {
            0  => 1,
            -1 => 1,
            -2 => 1,
            -3 => 1,
            -4 => 1,
            -5 => 1,
            -6 => 1,
            -7 => 1,
        },
        intranet => {
            -6 => 1,
            -5 => 1,
            -1 => 1,
            0  => 1,
            1  => 1,
            4  => 1,
            6  => 1,
            7  => 1,
        },
    };
    return $display;
}

=head1 DIAGNOSTICS

 $ prove -v t/RecordProcessor.t
 $ prove -v t/db_dependent/RecordProcessor_ViewPolicy.t

=head1 CONFIGURATION AND ENVIRONMENT

Install Koha. This filter will be used appropriately by the OPAC or Staff client.

=head1 INCOMPATIBILITIES

This is designed for MARC::Record filtering currently. It will not handle MARC::MARCXML.

=head1 DEPENDENCIES

The following Perl libraries are required: Modern::Perl and Carp.
The following Koha libraries are required: C4::Biblio, Koha::RecordProcessor, and Koha::RecordProcessor::Base.
These should all be installed if the koha-common package is installed or Koha is otherwise installed.

=head1 BUGS AND LIMITATIONS

This is the initial version. Please feel free to report bugs
at http://bugs.koha-community.org/.

=head1 AUTHOR

Mark Tompsett

=head1 LICENSE AND COPYRIGHT

Copyright 2015 Mark Tompsett

This file is part of Koha.

Koha is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3 of the License, or
(at your option) any later version.

Koha is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with Koha; if not, see <http://www.gnu.org/licenses>.

=cut

1;




#!/usr/bin/perl

# This file is part of Koha.
#
# Copyright 2015 Mark Tompsett
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.

use Modern::Perl;
use MARC::Record;
use MARC::Field;
use Test::More;
use C4::Context;
use Koha::Database;
use Data::Dumper;

BEGIN {
    use_ok('Koha::RecordProcessor');
}

our $VERSION = '3.23';    # Master version that I hope it gets in.

my $dbh = C4::Context->dbh;

my $database = Koha::Database->new();
my $schema   = $database->schema();
$schema->storage->txn_begin();

$dbh->{RaiseError} = 1;

$dbh->do(q{UPDATE marc_subfield_structure SET hidden=2 WHERE tagfield='020';});

my $isbn        = '0590353403';
my $title       = 'Foundation';
my $marc_record = MARC::Record->new;
my $field       = MARC::Field->new( '020', q{}, q{}, 'a' => $isbn );
$marc_record->append_fields($field);
$field = MARC::Field->new( '245', q{}, q{}, 'a' => $title );
$marc_record->append_fields($field);

my $processor = Koha::RecordProcessor->new(
    { filters => ('ViewPolicy'), options => { 'test' => 'value1' } } );
is(
    ref( $processor->filters->[0] ),
    'Koha::Filter::MARC::ViewPolicy',
    'Created record processor with implicitly scoped ViewPolicy filter'
);
my $after_record    = $processor->process($marc_record);
my $modified_record = $marc_record->clone;
my @isbn            = $modified_record->field('020');
$modified_record->delete_fields(@isbn);
is_deeply( $modified_record, $after_record,
    'Filtered and modified MARC record match' );

$schema->storage->txn_rollback();

done_testing();

Return to bug 15870

Line 0 Link Here

(-)a/Koha/Filter/MARC/ViewPolicy.pm (+252 lines)
		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;

Line 0 Link Here

(-)a/t/db_dependent/RecordProcessor_ViewPolicy.t (-1 / +68 lines)
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();