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

(-)a/Koha/Filter/MARC/ViewPolicy.pm (-39 / +62 lines)
Lines 44-50 use C4::Biblio; Link Here
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
(-)a/t/db_dependent/Filter_MARC_ViewPolicy.t (-62 / +90 lines)
Lines 3-8 Link Here
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