From 309d23f346058efdb31c8811f05fa4b8a579436a Mon Sep 17 00:00:00 2001 From: David Gustafsson Date: Thu, 25 Oct 2018 17:16:13 +0200 Subject: [PATCH] Bug 14957: Fix control field rules regression and add rule validation --- Koha/MarcMergeRule.pm | 27 ++++++++ Koha/MarcMergeRules.pm | 81 ++++++++++++++-------- admin/marc-merge-rules.pl | 39 +++++++---- .../prog/en/modules/admin/marc-merge-rules.tt | 13 ++++ 4 files changed, 117 insertions(+), 43 deletions(-) diff --git a/Koha/MarcMergeRule.pm b/Koha/MarcMergeRule.pm index 7e42e292b5..c15a864b8b 100644 --- a/Koha/MarcMergeRule.pm +++ b/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( + "Combination of allow append and skip remove not permitted for control fields" + ); + } + } + 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'); diff --git a/Koha/MarcMergeRules.pm b/Koha/MarcMergeRules.pm index a58c0b9c07..b671e89bfd 100644 --- a/Koha/MarcMergeRules.pm +++ b/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}}; - - my ($current_fields_only, $common_fields, $incoming_fields_only) = $diff_by_key->(\%current_fields_by_data, \%incoming_fields_by_data); - - my @merged_fields; - - # 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}; + # 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}}; + + # Always put incoming fields after current fields + my %incoming_fields_by_data = map { $hash_field_data->($_) => [$sort_weight++, $_] } @{$incoming_fields->{$tag}}; + + my ($current_fields_only, $common_fields, $incoming_fields_only) = $diff_by_key->(\%current_fields_by_data, \%incoming_fields_by_data); + + 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(); diff --git a/admin/marc-merge-rules.pl b/admin/marc-merge-rules.pl index 5f62fb3d34..3e45ba08f2 100755 --- a/admin/marc-merge-rules.pl +++ b/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->(); } } diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/marc-merge-rules.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/marc-merge-rules.tt index 3fcedf2086..8983c29f2e 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/marc-merge-rules.tt +++ b/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. -- 2.11.0