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

(-)a/Koha/Exceptions/MarcMergeRule.pm (+55 lines)
Line 0 Link Here
1
package Koha::Exceptions::MarcMergeRule;
2
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it under the
6
# terms of the GNU General Public License as published by the Free Software
7
# Foundation; either version 3 of the License, or (at your option) any later
8
# version.
9
#
10
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
11
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13
#
14
# You should have received a copy of the GNU General Public License along
15
# with Koha; if not, write to the Free Software Foundation, Inc.,
16
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
17
18
use Modern::Perl;
19
20
use Exception::Class (
21
22
    'Koha::Exceptions::MarcMergeRule' => {
23
        description => 'Something went wrong!',
24
    },
25
    'Koha::Exceptions::MarcMergeRule::InvalidTagRegExp' => {
26
        isa => 'Koha::Exceptions::MarcMergeRule',
27
        description => 'Invalid regular expression for tag'
28
    },
29
    'Koha::Exceptions::MarcMergeRule::InvalidControlFieldActions' => {
30
        isa => 'Koha::Exceptions::MarcMergeRule',
31
        description => 'Invalid control field actions'
32
    }
33
);
34
35
=head1 NAME
36
37
Koha::Exceptions::MarcMergeRule - Base class for MarcMergeRule exceptions
38
39
=head1 Exceptions
40
41
=head2 Koha::Exceptions::MarcMergeRule
42
43
Generic MarcMergeRule exception
44
45
=head2 Koha::Exceptions::MarcMergeRule::InvalidTagRegExp
46
47
Exception for rule validation when rule tag is an invalid regular expression
48
49
=head2 Koha::Exceptions::MarcMergeRule::InvalidControlFieldActions
50
51
Exception for rule validation for control field rules with invalid combination of actions
52
53
=cut
54
55
1;
(-)a/Koha/MarcMergeRule.pm (+27 lines)
Lines 16-21 package Koha::MarcMergeRule; Link Here
16
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
16
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
17
17
18
use Modern::Perl;
18
use Modern::Perl;
19
use Koha::Exceptions::MarcMergeRule;
20
use Try::Tiny;
19
21
20
use parent qw(Koha::Object);
22
use parent qw(Koha::Object);
21
23
Lines 27-32 Koha::MarcMergeRule - Koha SearchField Object class Link Here
27
29
28
=cut
30
=cut
29
31
32
sub set {
33
    my $self = shift @_;
34
    my ($rule_data) =  @_;
35
36
    if ($rule_data->{tag} ne '*') {
37
        eval { qr/$rule_data->{tag}/ };
38
        if ($@) {
39
            Koha::Exceptions::MarcMergeRule::InvalidTagRegExp->throw(
40
                "Invalid tag regular expression"
41
            );
42
        }
43
    }
44
    if (
45
        $rule_data->{tag} < 10 &&
46
        $rule_data->{append} &&
47
        !$rule_data->{remove}
48
    ) {
49
        Koha::Exceptions::MarcMergeRule::InvalidControlFieldActions->throw(
50
            "Combination of allow append and skip remove not permitted for control fields"
51
        );
52
    }
53
54
    $self->SUPER::set(@_);
55
}
56
30
sub store {
57
sub store {
31
    my $self = shift @_;
58
    my $self = shift @_;
32
    $cache->clear_from_cache('marc_merge_rules');
59
    $cache->clear_from_cache('marc_merge_rules');
(-)a/Koha/MarcMergeRules.pm (-30 / +51 lines)
Lines 18-23 package Koha::MarcMergeRules; Link Here
18
use Modern::Perl;
18
use Modern::Perl;
19
use List::Util qw(first);
19
use List::Util qw(first);
20
use Koha::MarcMergeRule;
20
use Koha::MarcMergeRule;
21
use Carp;
21
22
22
use parent qw(Koha::Objects);
23
use parent qw(Koha::Objects);
23
24
Lines 50-56 sub context_rules { Link Here
50
51
51
    my $rules = $cache->get_from_cache('marc_merge_rules', { unsafe => 1 });
52
    my $rules = $cache->get_from_cache('marc_merge_rules', { unsafe => 1 });
52
53
53
    if (!$rules || 1) {
54
    if (!$rules) {
54
        $rules = {};
55
        $rules = {};
55
        my @rules_rows = $self->_resultset()->search(
56
        my @rules_rows = $self->_resultset()->search(
56
            undef,
57
            undef,
Lines 206-248 sub merge_records { Link Here
206
        }
207
        }
207
    }
208
    }
208
209
209
    # Then we get the intersection of control fields, present both in
210
    # Then we get the intersection of fields, present both in
210
    # current and incoming record (possibly to be overwritten)
211
    # current and incoming record (possibly to be overwritten)
211
    my @common_field_tags = grep { exists $incoming_fields->{$_} } keys %{$current_fields};
212
    my @common_field_tags = grep { exists $incoming_fields->{$_} } keys %{$current_fields};
212
    foreach my $tag (@common_field_tags) {
213
    foreach my $tag (@common_field_tags) {
213
        my $rule = $get_matching_field_rule->($tag);
214
        my $rule = $get_matching_field_rule->($tag);
214
        # Compute intersection and diff using field data
215
        my $sort_weight = 0;
216
        my %current_fields_by_data = map { $hash_field_data->($_) => [$sort_weight++, $_] } @{$current_fields->{$tag}};
217
215
218
        # Always put incoming fields after current fields
216
        # Special handling for control fields
219
        my %incoming_fields_by_data = map { $hash_field_data->($_) => [$sort_weight++, $_] } @{$incoming_fields->{$tag}};
217
        if ($tag < 10) {
220
218
			if (
221
        my ($current_fields_only, $common_fields, $incoming_fields_only) = $diff_by_key->(\%current_fields_by_data, \%incoming_fields_by_data);
219
				$rule->{append}->{allow} &&
222
220
				!$rule->{remove}->{allow}
223
        my @merged_fields;
221
			) {
224
222
                # This should be highly unlikely since we have input validation to protect against this case
225
        # First add common fields (intersection)
223
				carp "Allowing \"append\" and skipping \"remove\" is not permitted for control fields, falling back to skipping both \"append\" and \"remove\"";
226
        # Unchanged
224
				push @{$merged_record_fields{$tag}}, @{$current_fields->{$tag}};
227
        if (@{$common_fields}) {
225
			}
228
            push @merged_fields, @{$common_fields};
226
			elsif ($rule->{append}->{allow}) {
229
        }
227
				push @{$merged_record_fields{$tag}}, @{$incoming_fields->{$tag}};
230
        # Removed
228
			}
231
        if (@{$current_fields_only}) {
229
			else {
232
            if (!$rule->{remove}->{allow}) {
230
				push @{$merged_record_fields{$tag}}, @{$current_fields->{$tag}};
233
                push @merged_fields, @{$current_fields_only};
231
			}
232
		}
233
        else {
234
            # Compute intersection and diff using field data
235
            my $sort_weight = 0;
236
            my %current_fields_by_data = map { $hash_field_data->($_) => [$sort_weight++, $_] } @{$current_fields->{$tag}};
237
238
            # Always put incoming fields after current fields
239
            my %incoming_fields_by_data = map { $hash_field_data->($_) => [$sort_weight++, $_] } @{$incoming_fields->{$tag}};
240
241
            my ($current_fields_only, $common_fields, $incoming_fields_only) = $diff_by_key->(\%current_fields_by_data, \%incoming_fields_by_data);
242
243
            my @merged_fields;
244
245
            # First add common fields (intersection)
246
            # Unchanged
247
            if (@{$common_fields}) {
248
                push @merged_fields, @{$common_fields};
234
            }
249
            }
235
        }
250
            # Removed
236
        # Appended
251
            if (@{$current_fields_only}) {
237
        if (@{$incoming_fields_only}) {
252
                if (!$rule->{remove}->{allow}) {
238
            if ($rule->{append}->{allow}) {
253
                    push @merged_fields, @{$current_fields_only};
239
                push @merged_fields, @{$incoming_fields_only};
254
                }
240
            }
255
            }
241
        }
256
            # Appended
242
        $merged_record_fields{$tag} //= [];
257
            if (@{$incoming_fields_only}) {
258
                if ($rule->{append}->{allow}) {
259
                    push @merged_fields, @{$incoming_fields_only};
260
                }
261
            }
262
            $merged_record_fields{$tag} //= [];
243
263
244
        # Sort ascending according to weight (original order)
264
            # Sort ascending according to weight (original order)
245
        push @{$merged_record_fields{$tag}}, map { $_->[1] } sort { $a->[0] <=> $b->[0] } @merged_fields;
265
            push @{$merged_record_fields{$tag}}, map { $_->[1] } sort { $a->[0] <=> $b->[0] } @merged_fields;
266
        }
246
    }
267
    }
247
268
248
    my $merged_record = MARC::Record->new();
269
    my $merged_record = MARC::Record->new();
(-)a/admin/marc-merge-rules.pl (-13 / +26 lines)
Lines 22-27 use warnings; Link Here
22
use CGI qw ( -utf8 );
22
use CGI qw ( -utf8 );
23
use CGI::Cookie;
23
use CGI::Cookie;
24
use MARC::File::USMARC;
24
use MARC::File::USMARC;
25
use Try::Tiny;
25
26
26
# Koha modules used
27
# Koha modules used
27
use C4::Context;
28
use C4::Context;
Lines 116-136 elsif ($op eq 'edit') { Link Here
116
}
117
}
117
elsif ($op eq 'doedit' || $op eq 'add') {
118
elsif ($op eq 'doedit' || $op eq 'add') {
118
    my $rule_data = $rule_from_cgi->($input);
119
    my $rule_data = $rule_from_cgi->($input);
119
    if ($rule_data->{tag} ne '*') {
120
        eval { qr/$rule_data->{tag}/ };
121
        if ($@) {
122
            push @{$errors}, {
123
                type => 'error',
124
                code => 'invalid_tag_regexp',
125
                tag => $rule_data->{tag},
126
                message => $@
127
            };
128
        }
129
    }
130
    if (!@{$errors}) {
120
    if (!@{$errors}) {
131
        my $rule = Koha::MarcMergeRules->find_or_create($rule_data);
121
        my $rule = Koha::MarcMergeRules->find_or_create($rule_data);
132
        $rule->set($rule_data);
122
        try {
133
        $rule->store();
123
            $rule->set($rule_data);
124
            $rule->store();
125
        }
126
        catch {
127
            die $_ unless blessed $_ && $_->can('rethrow');
128
129
            if ($_->isa('Koha::Exceptions::MarcMergeRule::InvalidTagRegExp')) {
130
                push @{$errors}, {
131
                    type => 'error',
132
                    code => 'invalid_tag_regexp',
133
                    tag => $rule_data->{tag},
134
                };
135
            }
136
            elsif ($_->isa('Koha::Exceptions::MarcMergeRule::InvalidControlFieldActions')) {
137
                push @{$errors}, {
138
                    type => 'error',
139
                    code => 'invalid_control_field_actions',
140
                    tag => $rule_data->{tag},
141
                };
142
            }
143
            else {
144
                $_->rethrow;
145
            }
146
        };
134
        $rules = $get_rules->();
147
        $rules = $get_rules->();
135
    }
148
    }
136
}
149
}
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/marc-merge-rules.tt (-1 / +13 lines)
Lines 208-213 $(document).ready(function(){ Link Here
208
208
209
<h1>Manage MARC merge rules</h1>
209
<h1>Manage MARC merge rules</h1>
210
210
211
[% FOR m IN messages %]
212
  <div class="dialog [% m.type | html %]">
213
    [% SWITCH m.code %]
214
    [% CASE 'invalid_tag_regexp' %]
215
      Invalid regular expression "[% m.tag | html %]".
216
    [% CASE 'invalid_control_field_actions' %]
217
      Invalid combination of actions for tag [% m.tag | html %]. Control field rules do not allow "Appended: Append" and "Removed: Skip".
218
    [% CASE %]
219
      [% m.code | html %]
220
    [% END %]
221
  </div>
222
[% END %]
223
211
[% UNLESS Koha.Preference( 'MARCMergeRules' ) %]
224
[% UNLESS Koha.Preference( 'MARCMergeRules' ) %]
212
    <div class="dialog message">
225
    <div class="dialog message">
213
        The <b>MARCMergeRules</b> preference is not set, don't forget to enable it for rules to take effect.
226
        The <b>MARCMergeRules</b> preference is not set, don't forget to enable it for rules to take effect.
214
- 

Return to bug 14957