@@ -, +, @@ validation --- Koha/Exceptions/MarcMergeRule.pm | 55 ++++++++++++++++ Koha/MarcMergeRule.pm | 27 ++++++++ Koha/MarcMergeRules.pm | 75 ++++++++++++++-------- admin/marc-merge-rules.pl | 39 +++++++---- .../prog/en/modules/admin/marc-merge-rules.tt | 13 ++++ 5 files changed, 169 insertions(+), 40 deletions(-) create mode 100644 Koha/Exceptions/MarcMergeRule.pm --- a/Koha/Exceptions/MarcMergeRule.pm +++ a/Koha/Exceptions/MarcMergeRule.pm @@ -0,0 +1,55 @@ +package Koha::Exceptions::MarcMergeRule; + +# 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, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use Modern::Perl; + +use Exception::Class ( + + 'Koha::Exceptions::MarcMergeRule' => { + description => 'Something went wrong!', + }, + 'Koha::Exceptions::MarcMergeRule::InvalidTagRegExp' => { + isa => 'Koha::Exceptions::MarcMergeRule', + description => 'Invalid regular expression for tag' + }, + 'Koha::Exceptions::MarcMergeRule::InvalidControlFieldActions' => { + isa => 'Koha::Exceptions::MarcMergeRule', + description => 'Invalid control field actions' + } +); + +=head1 NAME + +Koha::Exceptions::MarcMergeRule - Base class for MarcMergeRule exceptions + +=head1 Exceptions + +=head2 Koha::Exceptions::MarcMergeRule + +Generic MarcMergeRule exception + +=head2 Koha::Exceptions::MarcMergeRule::InvalidTagRegExp + +Exception for rule validation when rule tag is an invalid regular expression + +=head2 Koha::Exceptions::MarcMergeRule::InvalidControlFieldActions + +Exception for rule validation for control field rules with invalid combination of actions + +=cut + +1; --- a/Koha/MarcMergeRule.pm +++ a/Koha/MarcMergeRule.pm @@ -16,6 +16,8 @@ package Koha::MarcMergeRule; # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. use Modern::Perl; +use Koha::Exceptions::MarcMergeRule; +use Try::Tiny; use parent qw(Koha::Object); @@ -27,6 +29,31 @@ Koha::MarcMergeRule - Koha SearchField Object class =cut +sub set { + my $self = shift @_; + my ($rule_data) = @_; + + if ($rule_data->{tag} ne '*') { + eval { qr/$rule_data->{tag}/ }; + if ($@) { + Koha::Exceptions::MarcMergeRule::InvalidTagRegExp->throw( + "Invalid tag regular expression" + ); + } + } + if ( + $rule_data->{tag} < 10 && + $rule_data->{append} && + !$rule_data->{remove} + ) { + Koha::Exceptions::MarcMergeRule::InvalidControlFieldActions->throw( + "Combination of allow append and skip remove not permitted for control fields" + ); + } + + $self->SUPER::set(@_); +} + sub store { my $self = shift @_; $cache->clear_from_cache('marc_merge_rules'); --- a/Koha/MarcMergeRules.pm +++ a/Koha/MarcMergeRules.pm @@ -18,6 +18,7 @@ package Koha::MarcMergeRules; use Modern::Perl; use List::Util qw(first); use Koha::MarcMergeRule; +use Carp; use parent qw(Koha::Objects); @@ -50,7 +51,7 @@ sub context_rules { my $rules = $cache->get_from_cache('marc_merge_rules', { unsafe => 1 }); - if (!$rules || 1) { + if (!$rules) { $rules = {}; my @rules_rows = $self->_resultset()->search( undef, @@ -206,43 +207,63 @@ sub merge_records { } } - # Then we get the intersection of control fields, present both in + # Then we get the intersection of fields, present both in # current and incoming record (possibly to be overwritten) my @common_field_tags = grep { exists $incoming_fields->{$_} } keys %{$current_fields}; foreach my $tag (@common_field_tags) { my $rule = $get_matching_field_rule->($tag); - # Compute intersection and diff using field data - my $sort_weight = 0; - my %current_fields_by_data = map { $hash_field_data->($_) => [$sort_weight++, $_] } @{$current_fields->{$tag}}; - # Always put incoming fields after current fields - my %incoming_fields_by_data = map { $hash_field_data->($_) => [$sort_weight++, $_] } @{$incoming_fields->{$tag}}; + # Special handling for control fields + if ($tag < 10) { + if ( + $rule->{append}->{allow} && + !$rule->{remove}->{allow} + ) { + # This should be highly unlikely since we have input validation to protect against this case + carp "Allowing \"append\" and skipping \"remove\" is not permitted for control fields, falling back to skipping both \"append\" and \"remove\""; + push @{$merged_record_fields{$tag}}, @{$current_fields->{$tag}}; + } + elsif ($rule->{append}->{allow}) { + push @{$merged_record_fields{$tag}}, @{$incoming_fields->{$tag}}; + } + else { + push @{$merged_record_fields{$tag}}, @{$current_fields->{$tag}}; + } + } + else { + # Compute intersection and diff using field data + my $sort_weight = 0; + my %current_fields_by_data = map { $hash_field_data->($_) => [$sort_weight++, $_] } @{$current_fields->{$tag}}; - my ($current_fields_only, $common_fields, $incoming_fields_only) = $diff_by_key->(\%current_fields_by_data, \%incoming_fields_by_data); + # Always put incoming fields after current fields + my %incoming_fields_by_data = map { $hash_field_data->($_) => [$sort_weight++, $_] } @{$incoming_fields->{$tag}}; - my @merged_fields; + my ($current_fields_only, $common_fields, $incoming_fields_only) = $diff_by_key->(\%current_fields_by_data, \%incoming_fields_by_data); - # First add common fields (intersection) - # Unchanged - if (@{$common_fields}) { - push @merged_fields, @{$common_fields}; - } - # Removed - if (@{$current_fields_only}) { - if (!$rule->{remove}->{allow}) { - push @merged_fields, @{$current_fields_only}; + my @merged_fields; + + # First add common fields (intersection) + # Unchanged + if (@{$common_fields}) { + push @merged_fields, @{$common_fields}; } - } - # Appended - if (@{$incoming_fields_only}) { - if ($rule->{append}->{allow}) { - push @merged_fields, @{$incoming_fields_only}; + # Removed + if (@{$current_fields_only}) { + if (!$rule->{remove}->{allow}) { + push @merged_fields, @{$current_fields_only}; + } } - } - $merged_record_fields{$tag} //= []; + # Appended + if (@{$incoming_fields_only}) { + if ($rule->{append}->{allow}) { + push @merged_fields, @{$incoming_fields_only}; + } + } + $merged_record_fields{$tag} //= []; - # Sort ascending according to weight (original order) - push @{$merged_record_fields{$tag}}, map { $_->[1] } sort { $a->[0] <=> $b->[0] } @merged_fields; + # Sort ascending according to weight (original order) + push @{$merged_record_fields{$tag}}, map { $_->[1] } sort { $a->[0] <=> $b->[0] } @merged_fields; + } } my $merged_record = MARC::Record->new(); --- a/admin/marc-merge-rules.pl +++ a/admin/marc-merge-rules.pl @@ -22,6 +22,7 @@ use warnings; use CGI qw ( -utf8 ); use CGI::Cookie; use MARC::File::USMARC; +use Try::Tiny; # Koha modules used use C4::Context; @@ -116,21 +117,33 @@ elsif ($op eq 'edit') { } elsif ($op eq 'doedit' || $op eq 'add') { my $rule_data = $rule_from_cgi->($input); - if ($rule_data->{tag} ne '*') { - eval { qr/$rule_data->{tag}/ }; - if ($@) { - push @{$errors}, { - type => 'error', - code => 'invalid_tag_regexp', - tag => $rule_data->{tag}, - message => $@ - }; - } - } if (!@{$errors}) { my $rule = Koha::MarcMergeRules->find_or_create($rule_data); - $rule->set($rule_data); - $rule->store(); + try { + $rule->set($rule_data); + $rule->store(); + } + catch { + die $_ unless blessed $_ && $_->can('rethrow'); + + if ($_->isa('Koha::Exceptions::MarcMergeRule::InvalidTagRegExp')) { + push @{$errors}, { + type => 'error', + code => 'invalid_tag_regexp', + tag => $rule_data->{tag}, + }; + } + elsif ($_->isa('Koha::Exceptions::MarcMergeRule::InvalidControlFieldActions')) { + push @{$errors}, { + type => 'error', + code => 'invalid_control_field_actions', + tag => $rule_data->{tag}, + }; + } + else { + $_->rethrow; + } + }; $rules = $get_rules->(); } } --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/marc-merge-rules.tt +++ a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/marc-merge-rules.tt @@ -208,6 +208,19 @@ $(document).ready(function(){

Manage MARC merge rules

+[% FOR m IN messages %] +
+ [% SWITCH m.code %] + [% CASE 'invalid_tag_regexp' %] + Invalid regular expression "[% m.tag | html %]". + [% CASE 'invalid_control_field_actions' %] + Invalid combination of actions for tag [% m.tag | html %]. Control field rules do not allow "Appended: Append" and "Removed: Skip". + [% CASE %] + [% m.code | html %] + [% END %] +
+[% END %] + [% UNLESS Koha.Preference( 'MARCMergeRules' ) %]
The MARCMergeRules preference is not set, don't forget to enable it for rules to take effect. --