Attachment #48768 for bug #15870

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

Lines 44-50 use C4::Biblio; Link Here

(-)a/Koha/Filter/MARC/ViewPolicy.pm (-39 / +62 lines)
44		44
45	use base qw(Koha::RecordProcessor::Base);	45	use base qw(Koha::RecordProcessor::Base);
46	our $NAME = 'MARC_ViewPolicy';	46	our $NAME = 'MARC_ViewPolicy';
47	our $VERSION = '3.23'; # Master version I hope it gets in.	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.
48		50
49	=head1 SUBROUTINES/METHODS	51	=head1 SUBROUTINES/METHODS
50		52
Lines 81-87 sub filter { Link Here
81	my $result = $current_record->clone();	83	my $result = $current_record->clone();
82	my $interface = $self->{options}->{interface} // 'opac';	84	my $interface = $self->{options}->{interface} // 'opac';
83	my $frameworkcode = $self->{options}->{frameworkcode} // q{};	85	my $frameworkcode = $self->{options}->{frameworkcode} // q{};
84	my $display = _should_display_on_interface();	86	my $hide = _should_hide_on_interface();
85		87
86	my $marcsubfieldstructure = GetMarcStructure( 0, $frameworkcode );	88	my $marcsubfieldstructure = GetMarcStructure( 0, $frameworkcode );
87		89
Lines 95-101 sub filter { Link Here
95	{	97	{
96	field => $field,	98	field => $field,
97	marcsubfieldstructure => $marcsubfieldstructure,	99	marcsubfieldstructure => $marcsubfieldstructure,
98	display => $display,	100	hide => $hide,
99	interface => $interface,	101	interface => $interface,
100	result => $result	102	result => $result
101	}	103	}
Lines 117-140 sub _filter_field { Link Here
117		119
118	my $field = $parameter->{field};	120	my $field = $parameter->{field};
119	my $marcsubfieldstructure = $parameter->{marcsubfieldstructure};	121	my $marcsubfieldstructure = $parameter->{marcsubfieldstructure};
120	my $display = $parameter->{display};	122	my $hide = $parameter->{hide};
121	my $interface = $parameter->{interface};	123	my $interface = $parameter->{interface};
122	my $result = $parameter->{result};	124	my $result = $parameter->{result};
123		125
124	my $tag = $field->tag();	126	my $tag = $field->tag();
125	if ( $tag >= 10 ) {	127	if ( $tag >= FIRST_NONCONTROL_TAG ) {
126	foreach my $subpairs ( $field->subfields() ) {	128	foreach my $subpairs ( $field->subfields() ) {
127	my ( $subtag, $value ) = @{$subpairs};	129	my ( $subtag, $value ) = @{$subpairs};
128		130
129	# visibility is a "level" (-7 to +7), default to 0	131	# visibility is a "level" (-9 to +9), default to 0
		132	# -8 is flagged, and 9/-9 are not implemented.
130	my $visibility =	133	my $visibility =
131	$marcsubfieldstructure->{$tag}->{$subtag}->{hidden};	134	$marcsubfieldstructure->{$tag}->{$subtag}->{hidden};
132	$visibility //= 0;	135	$visibility //= 0;
133	my $hidden;	136	if ( $hide->{$interface}->{$visibility} ) {
134	if ( $display->{$interface}->{$visibility} ) {	137
135	$hidden = 0;
136	}
137	else {
138	# deleting last subfield doesn't delete field, so	138	# deleting last subfield doesn't delete field, so
139	# this detects that case to delete the field.	139	# this detects that case to delete the field.
140	if ( scalar $field->subfields() <= 1 ) {	140	if ( scalar $field->subfields() <= 1 ) {
Lines 147-165 sub _filter_field { Link Here
147	}	147	}
148	}	148	}
149		149
150	# tags less than 10 don't have subfields, use @ trick.	150	# control tags don't have subfields, use @ trick.
151	else {	151	else {
152	# visibility is a "level" (-7 to +7), default to 0	152	# visibility is a "level" (-9 to +9), default to 0
		153	# -8 is flagged, and 9/-9 are not implemented.
153	my $visibility = $marcsubfieldstructure->{$tag}->{q{@}}->{hidden};	154	my $visibility = $marcsubfieldstructure->{$tag}->{q{@}}->{hidden};
154	$visibility //= 0;	155	$visibility //= 0;
155	my $hidden;	156	if ( $hide->{$interface}->{$visibility} ) {
156	if ( $display->{$interface}->{$visibility} ) {
157	$hidden = 0;
158	}
159	else {
160	$hidden = 1;
161	$result->delete_fields($field);	157	$result->delete_fields($field);
162	}	158	}
		159
163	}	160	}
164	return;	161	return;
165	}	162	}
Lines 174-209 sub initialize { Link Here
174	return;	171	return;
175	}	172	}
176		173
177	sub _should_display_on_interface {	174	# Copied and modified from 3.10.x help file
178	my $display = {	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 = {
179	opac => {	200	opac => {
180	0 => 1,	201	'-8' => 1,
181	-1 => 1,	202	'1' => 1,
182	-2 => 1,	203	'2' => 1,
183	-3 => 1,	204	'3' => 1,
184	-4 => 1,	205	'4' => 1,
185	-5 => 1,	206	'5' => 1,
186	-6 => 1,	207	'6' => 1,
187	-7 => 1,	208	'7' => 1,
		209	'8' => 1,
188	},	210	},
189	intranet => {	211	intranet => {
190	-6 => 1,	212	'-8' => 1,
191	-5 => 1,	213	'-7' => 1,
192	-1 => 1,	214	'-4' => 1,
193	0 => 1,	215	'-3' => 1,
194	1 => 1,	216	'-2' => 1,
195	4 => 1,	217	'2' => 1,
196	6 => 1,	218	'3' => 1,
197	7 => 1,	219	'5' => 1,
		220	'8' => 1,
198	},	221	},
199	};	222	};
200	return $display;	223	return $hide;
201	}	224	}
202		225
203	=head1 DIAGNOSTICS	226	=head1 DIAGNOSTICS
204		227
205	$ prove -v t/RecordProcessor.t	228	$ prove -v t/RecordProcessor.t
206	$ prove -v t/db_dependent/RecordProcessor_ViewPolicy.t	229	$ prove -v t/db_dependent/Filter_MARC_ViewPolicy.t
207		230
208	=head1 CONFIGURATION AND ENVIRONMENT	231	=head1 CONFIGURATION AND ENVIRONMENT
209		232

Lines 3-8 Link Here

(-)a/t/db_dependent/Filter_MARC_ViewPolicy.t (-62 / +90 lines)
3	# This file is part of Koha.	3	# This file is part of Koha.
4	#	4	#
5	# Copyright 2015 Mark Tompsett	5	# Copyright 2015 Mark Tompsett
		6	# - Initial commit, perlcritic clean-up, and
		7	# debugging
		8	# Copyright 2016 Tomas Cohen Arazi
		9	# - Expansion of test cases to be comprehensive
6	#	10	#
7	# Koha is free software; you can redistribute it and/or modify it	11	# 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	12	# under the terms of the GNU General Public License as published by
Lines 25-73 use List::MoreUtils qw/any/; Link Here
25	use MARC::Record;	29	use MARC::Record;
26	use MARC::Field;	30	use MARC::Field;
27	use C4::Context;	31	use C4::Context;
		32	use Koha::Cache qw/flush_all/;
28	use Koha::Database;	33	use Koha::Database;
		34	use English qw/-no_match_vars/;
		35
		36	$OUTPUT_AUTOFLUSH = 1;
29		37
30	BEGIN {	38	BEGIN {
31	use_ok('Koha::RecordProcessor');	39	use_ok('Koha::RecordProcessor');
32	}	40	}
33		41
34	my $dbh = C4::Context->dbh;	42	sub run_hiding_tests {
35		43
36	my $database = Koha::Database->new();	44	my $interface = shift;
37	my $schema = $database->schema();
38	$dbh->{RaiseError} = 1;
39		45
40	my @valid_hidden_values = (	46	# TODO: -8 is Flagged, which doesn't seem used.
41	'-7', '-6', '-5', '-4', '-3', '-2', '-1', '0',	47	# -9 and +9 are supposedly valid future values
42	'1', '2', '3', '4', '5', '6', '7', '8'	48	# according to older documentation in 3.10.x
43	);	49	my @valid_hidden_values =
		50	( -8, -7, -6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8 );
44		51
45	my $hidden = {	52	my $hidden = {
46	opac => [ '1', '2', '3', '4', '5', '6', '7', '8' ],	53	'opac' => [ -8, 1, 2, 3, 4, 5, 6, 7, 8 ],
47	intranet => [ '-7', '-4', '-3', '-2', '2', '3', '5', '8' ]	54	'intranet' => [ -8, -7, -4, -3, -2, 2, 3, 5, 8 ]
48	};	55	};
49		56
50	sub run_hiding_tests {	57	my $dbh = C4::Context->dbh;
51		58
52	my $interface = shift;	59	my $database = Koha::Database->new();
		60	my $schema = $database->schema();
		61	$dbh->{RaiseError} = 1;
53		62
54	# foreach my $hidden_value ( @{ $hidden->{ $interface } } ) {	63	#$ENV{'DEBUG'} = '1'; # Turn on debugging.
55	foreach my $hidden_value ( @valid_hidden_values ) {
56		64
57	$schema->storage->txn_begin();	65	foreach my $hidden_value (@valid_hidden_values) {
58		66
59	my $sth = $dbh->prepare("	67	$schema->storage->txn_begin();
60	UPDATE marc_subfield_structure SET hidden=?
61	WHERE tagfield='020' OR
62	tagfield='008';
63	");
64	$sth->execute( $hidden_value );
65		68
66	my $processor = Koha::RecordProcessor->new({	69	my $update_sql =
67	schema => 'MARC',	70	q{UPDATE marc_subfield_structure SET hidden=? }
68	filters => ( 'ViewPolicy' ),	71	. q{WHERE tagfield='020' OR }
69	options => { interface => $interface }	72	. q{ tagfield='008';};
70	});	73	my $sth = $dbh->prepare($update_sql);
		74	$sth->execute($hidden_value);
		75
		76	my $cache = Koha::Cache->get_instance();
		77	$cache->flush_all(); # easy way to ensure DB is queried again.
		78
		79	my $processor = Koha::RecordProcessor->new(
		80	{
		81	schema => 'MARC',
		82	filters => ('ViewPolicy'),
		83	options => { interface => $interface }
		84	}
		85	);
71		86
72	is(	87	is(
73	ref( $processor->filters->[0] ),	88	ref( $processor->filters->[0] ),
Lines 76-149 sub run_hiding_tests { Link Here
76	);	91	);
77		92
78	# Create a fresh record	93	# Create a fresh record
79	my $record = create_marc_record();	94	my $sample_record = create_marc_record();
		95	my $unfiltered_record = $sample_record->clone();
		96
80	# Apply filters	97	# Apply filters
81	my $filtered_record = $processor->process( $record );	98	my $filtered_record = $processor->process($sample_record);
		99
82	# Data fields	100	# Data fields
		101	if ( any { $_ == $hidden_value } @{ $hidden->{$interface} } ) {
83		102
84	if ( any { $_ eq $hidden_value } @{ $hidden->{ $interface } }) {
85	# Subfield and controlfield are set to be hidden	103	# Subfield and controlfield are set to be hidden
86		104	is( $filtered_record->field('020'),
87	is( $filtered_record->field('020'), undef,	105	undef,
88	"Data field has been deleted because of hidden=$hidden_value" );	106	"Data field has been deleted because of hidden=$hidden_value" );
89	is( $record->field('020'), undef,	107	isnt( $unfiltered_record->field('020'), undef,
90	"Data field has been deleted in the original record because of hidden=$hidden_value" );	108	"Data field has been deleted in the original record because of hidden=$hidden_value"
		109	);
		110
91	# Control fields have a different behaviour in code	111	# Control fields have a different behaviour in code
92	is( $filtered_record->field('008'), undef,	112	is( $filtered_record->field('008'), undef,
93	"Control field has been deleted because of hidden=$hidden_value" );	113	"Control field has been deleted because of hidden=$hidden_value"
94	is( $record->field('008'), undef,	114	);
95	"Control field has been deleted in the original record because of hidden=$hidden_value" );	115	isnt( $unfiltered_record->field('008'), undef,
		116	"Control field has been deleted in the original record because of hidden=$hidden_value"
		117	);
96		118
97	} else {	119	ok( $filtered_record && $unfiltered_record, 'Records exist' );
98		120
		121	}
		122	else {
99	isnt( $filtered_record->field('020'), undef,	123	isnt( $filtered_record->field('020'), undef,
100	"Data field hasn't been deleted because of hidden=$hidden_value" );	124	"Data field hasn't been deleted because of hidden=$hidden_value"
101	isnt( $record->field('020'), undef,	125	);
102	"Data field hasn't been deleted in the original record because of hidden=$hidden_value" );	126	isnt( $unfiltered_record->field('020'), undef,
		127	"Data field hasn't been deleted in the original record because of hidden=$hidden_value"
		128	);
		129
103	# Control fields have a different behaviour in code	130	# Control fields have a different behaviour in code
104	isnt( $filtered_record->field('008'), undef,	131	isnt( $filtered_record->field('008'), undef,
105	"Control field hasn't been deleted because of hidden=$hidden_value" );	132	"Control field hasn't been deleted because of hidden=$hidden_value"
106	isnt( $record->field('008'), undef,	133	);
107	"Control field hasn't been deleted in the original record because of hidden=$hidden_value" );	134	isnt( $unfiltered_record->field('008'), undef,
		135	"Control field hasn't been deleted in the original record because of hidden=$hidden_value"
		136	);
		137
		138	is_deeply( $filtered_record, $unfiltered_record,
		139	'Records are the same' );
108	}	140	}
109		141
110	is_deeply( $filtered_record, $record,
111	"Records are the same" );
112
113	$schema->storage->txn_rollback();	142	$schema->storage->txn_rollback();
114	}	143	}
		144	return;
115	}	145	}
116		146
117	sub create_marc_record {	147	sub create_marc_record {
118		148
119	my $isbn = '0590353403';	149	my $isbn = '0590353403';
120	my $title = 'Foundation';	150	my $title = 'Foundation';
121	my $record = MARC::Record->new;	151	my $marc_record = MARC::Record->new;
122	my @fields = (	152	my @fields = (
123	MARC::Field->new( '003', 'AR-CdUBM'),	153	MARC::Field->new( '003', 'AR-CdUBM' ),
124	MARC::Field->new( '008', '######suuuu####ag_\|\|\|\|__\|\|\|\|_0\|\|_\|_uuu\|d'),	154	MARC::Field->new( '008', '######suuuu####ag_\|\|\|\|__\|\|\|\|_0\|\|_\|_uuu\|d' ),
125	MARC::Field->new( '020', q{}, q{}, 'a' => $isbn ),	155	MARC::Field->new( '020', q{}, q{}, 'a' => $isbn ),
126	MARC::Field->new( '245', q{}, q{}, 'a' => $title )	156	MARC::Field->new( '245', q{}, q{}, 'a' => $title ),
127	);	157	);
128		158
129	$record->insert_fields_ordered( @fields );	159	$marc_record->insert_fields_ordered(@fields);
130		160
131	return $record;	161	return $marc_record;
132	}	162	}
133		163
134	subtest 'Koha::Filter::MARC::ViewPolicy opac tests' => sub {	164	subtest 'Koha::Filter::MARC::ViewPolicy opac tests' => sub {
135		165
136	plan tests => 96;	166	plan tests => 102;
137		167
138	run_hiding_tests('opac');	168	run_hiding_tests('opac');
139	};	169	};
140		170
141	subtest 'Koha::Filter::MARC::ViewPolicy intranet tests' => sub {	171	subtest 'Koha::Filter::MARC::ViewPolicy intranet tests' => sub {
142		172
143	plan tests => 96;	173	plan tests => 102;
144		174
145	run_hiding_tests('intranet');	175	run_hiding_tests('intranet');
146	};	176	};
147		177
148
149	1;	178	1;
150	-

Return to bug 15870