Main Koha release repository
https://koha-community.org
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
397 lines
12 KiB
397 lines
12 KiB
package Koha::MarcOverlayRules;
|
|
|
|
# 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, see <http://www.gnu.org/licenses>.
|
|
|
|
use Modern::Perl;
|
|
use List::Util qw(first);
|
|
use Koha::MarcOverlayRule;
|
|
use Carp;
|
|
|
|
use Koha::Exceptions::MarcOverlayRule;
|
|
use Try::Tiny;
|
|
use Scalar::Util qw(looks_like_number);
|
|
|
|
use parent qw(Koha::Objects);
|
|
|
|
my $cache = Koha::Caches->get_instance();
|
|
|
|
=head1 NAME
|
|
|
|
Koha::MarcOverlayRules - Koha MarcOverlayRules Object set class
|
|
|
|
=head1 API
|
|
|
|
=head2 Class methods
|
|
|
|
=head3 operations
|
|
|
|
Returns a list of all valid operations.
|
|
|
|
=cut
|
|
|
|
sub operations {
|
|
return ('add', 'append', 'remove', 'delete');
|
|
}
|
|
|
|
=head3 context_rules
|
|
|
|
my $rules = Koha::MarcOverlayRules->context_rules($context);
|
|
|
|
Gets all MARC overlay rules for the supplied C<$context> (hashref with { module => filter, ... } values).
|
|
|
|
=cut
|
|
|
|
sub context_rules {
|
|
my ($self, $context) = @_;
|
|
|
|
return unless %{$context};
|
|
|
|
my $rules = $cache->get_from_cache('marc_overlay_rules', { unsafe => 1 });
|
|
|
|
if (!$rules) {
|
|
$rules = {};
|
|
my @rules_rows = $self->_resultset()->search(
|
|
undef,
|
|
{
|
|
order_by => { -desc => [qw/id/] }
|
|
}
|
|
);
|
|
foreach my $rule_row (@rules_rows) {
|
|
my %rule = $rule_row->get_columns();
|
|
my $operations = {};
|
|
|
|
foreach my $operation ($self->operations) {
|
|
$operations->{$operation} = { allow => $rule{$operation}, rule => $rule{id} };
|
|
}
|
|
|
|
# TODO: Remove unless check and validate on saving rules?
|
|
if ($rule{tag} eq '*') {
|
|
unless (exists $rules->{$rule{module}}->{$rule{filter}}->{'*'}) {
|
|
$rules->{$rule{module}}->{$rule{filter}}->{'*'} = $operations;
|
|
}
|
|
}
|
|
elsif ($rule{tag} =~ /^(\d{3})$/) {
|
|
unless (exists $rules->{$rule{module}}->{$rule{filter}}->{tags}->{$rule{tag}}) {
|
|
$rules->{$rule{module}}->{$rule{filter}}->{tags}->{$rule{tag}} = $operations;
|
|
}
|
|
}
|
|
else {
|
|
my $regexps = ($rules->{$rule{module}}->{$rule{filter}}->{regexps} //= []);
|
|
push @{$regexps}, [$rule{tag}, $operations];
|
|
}
|
|
}
|
|
$cache->set_in_cache('marc_overlay_rules', $rules);
|
|
}
|
|
|
|
my $context_rules = undef;
|
|
foreach my $module_name (keys %{$context}) {
|
|
if (
|
|
exists $rules->{$module_name} &&
|
|
exists $rules->{$module_name}->{$context->{$module_name}}
|
|
) {
|
|
$context_rules = $rules->{$module_name}->{$context->{$module_name}};
|
|
last;
|
|
}
|
|
}
|
|
if (!$context_rules) {
|
|
# No perms matching specific context conditions found, try wildcard value for each active context
|
|
foreach my $module_name (keys %{$context}) {
|
|
if (exists $rules->{$module_name}->{'*'}) {
|
|
$context_rules = $rules->{$module_name}->{'*'};
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
return $context_rules;
|
|
}
|
|
|
|
=head3 merge_records
|
|
|
|
my $merged_record = Koha::MarcOverlayRules->merge_records($old_record, $incoming_record, $context);
|
|
|
|
Overlay C<$old_record> with C<$incoming_record> applying overlay rules for C<$context>.
|
|
Returns merged record C<$merged_record>. C<$old_record>, C<$incoming_record> and
|
|
C<$merged_record> are all MARC::Record objects.
|
|
|
|
=cut
|
|
|
|
sub merge_records {
|
|
my ($self, $old_record, $incoming_record, $context) = @_;
|
|
|
|
my $rules = $self->context_rules($context);
|
|
|
|
# Default when no rules found is to overwrite with incoming record
|
|
return $incoming_record unless $rules;
|
|
|
|
my $fields_by_tag = sub {
|
|
my ($record) = @_;
|
|
my $fields = {};
|
|
foreach my $field ($record->fields()) {
|
|
$fields->{$field->tag()} //= [];
|
|
push @{$fields->{$field->tag()}}, $field;
|
|
}
|
|
return $fields;
|
|
};
|
|
|
|
my $hash_field_data = sub {
|
|
my ($field) = @_;
|
|
my $indicators = join("\x1E", map { $field->indicator($_) } (1, 2));
|
|
return $indicators . "\x1E" . join("\x1E", sort map { join "\x1E", @{$_} } $field->subfields());
|
|
};
|
|
|
|
my $diff_by_key = sub {
|
|
my ($a, $b) = @_;
|
|
my @removed;
|
|
my @intersecting;
|
|
my @added;
|
|
my %keys_index = map { $_ => undef } (keys %{$a}, keys %{$b});
|
|
foreach my $key (keys %keys_index) {
|
|
if ($a->{$key} && $b->{$key}) {
|
|
push @intersecting, [$a->{$key}, $b->{$key}];
|
|
}
|
|
elsif ($a->{$key}) {
|
|
push @removed, $a->{$key};
|
|
}
|
|
else {
|
|
push @added, $b->{$key};
|
|
}
|
|
}
|
|
return (\@removed, \@intersecting, \@added);
|
|
};
|
|
|
|
my $tag_rules = $rules->{tags} // {};
|
|
my $default_rule = $rules->{'*'} // {
|
|
add => { allow => 1, 'rule' => 0},
|
|
append => { allow => 1, 'rule' => 0},
|
|
delete => { allow => 1, 'rule' => 0},
|
|
remove => { allow => 1, 'rule' => 0},
|
|
};
|
|
|
|
# Precompile regexps
|
|
my @regexp_rules = map { { regexp => qr/^$_->[0]$/, actions => $_->[1] } } @{$rules->{regexps} // []};
|
|
|
|
my $get_matching_field_rule = sub {
|
|
my ($tag) = @_;
|
|
# Exact match takes precedence, then regexp, then wildcard/defaults
|
|
return $tag_rules->{$tag} //
|
|
%{(first { $tag =~ $_->{regexp} } @regexp_rules) // {}}{actions} //
|
|
$default_rule;
|
|
};
|
|
|
|
my %merged_record_fields;
|
|
|
|
my $current_fields = $fields_by_tag->($old_record);
|
|
my $incoming_fields = $fields_by_tag->($incoming_record);
|
|
|
|
# First we get all new incoming fields
|
|
my @new_field_tags = grep { !(exists $current_fields->{$_}) } keys %{$incoming_fields};
|
|
foreach my $tag (@new_field_tags) {
|
|
my $rule = $get_matching_field_rule->($tag);
|
|
if ($rule->{add}->{allow}) {
|
|
$merged_record_fields{$tag} //= [];
|
|
push @{$merged_record_fields{$tag}}, @{$incoming_fields->{$tag}};
|
|
}
|
|
}
|
|
|
|
# Then we get all fields no longer present in incoming fields
|
|
my @deleted_field_tags = grep { !(exists $incoming_fields->{$_}) } keys %{$current_fields};
|
|
foreach my $tag (@deleted_field_tags) {
|
|
my $rule = $get_matching_field_rule->($tag);
|
|
if (!$rule->{delete}->{allow}) {
|
|
$merged_record_fields{$tag} //= [];
|
|
push @{$merged_record_fields{$tag}}, @{$current_fields->{$tag}};
|
|
}
|
|
}
|
|
|
|
# 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);
|
|
|
|
# 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}) {
|
|
if(
|
|
$rule->{delete}->{allow} &&
|
|
$rule->{add}->{allow} && (
|
|
@{$common_fields} == 1 || (
|
|
$rule->{append}->{allow} &&
|
|
$rule->{remove}->{allow}
|
|
)
|
|
)
|
|
) {
|
|
# If overwritable apply possible subfield order
|
|
# changes from incoming fields
|
|
push @merged_fields, map { $_->[1] } @{$common_fields};
|
|
}
|
|
else {
|
|
# else keep existing subfield order
|
|
push @merged_fields, map { $_->[0] } @{$common_fields};
|
|
}
|
|
}
|
|
# Removed
|
|
if (@{$current_fields_only}) {
|
|
if (!$rule->{remove}->{allow}) {
|
|
push @merged_fields, @{$current_fields_only};
|
|
}
|
|
}
|
|
# 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;
|
|
}
|
|
}
|
|
|
|
my $merged_record = MARC::Record->new();
|
|
|
|
# Leader is always overwritten, or kept???
|
|
$merged_record->leader($incoming_record->leader());
|
|
|
|
if (%merged_record_fields) {
|
|
foreach my $tag (sort keys %merged_record_fields) {
|
|
$merged_record->append_fields(@{$merged_record_fields{$tag}});
|
|
}
|
|
}
|
|
return $merged_record;
|
|
}
|
|
|
|
sub _clear_caches {
|
|
$cache->clear_from_cache('marc_overlay_rules');
|
|
}
|
|
|
|
=head2 find_or_create
|
|
|
|
Override C<find_or_create> to clear marc overlay rules cache.
|
|
|
|
=cut
|
|
|
|
sub find_or_create {
|
|
my $self = shift @_;
|
|
$self->_clear_caches();
|
|
return $self->SUPER::find_or_create(@_);
|
|
}
|
|
|
|
=head2 update
|
|
|
|
Override C<update> to clear marc overlay rules cache.
|
|
|
|
=cut
|
|
|
|
sub update {
|
|
my $self = shift @_;
|
|
$self->_clear_caches();
|
|
return $self->SUPER::update(@_);
|
|
}
|
|
|
|
=head2 delete
|
|
|
|
Override C<delete> to clear marc overlay rules cache.
|
|
|
|
=cut
|
|
|
|
sub delete {
|
|
my $self = shift @_;
|
|
$self->_clear_caches();
|
|
return $self->SUPER::delete(@_);
|
|
}
|
|
|
|
=head2 validate
|
|
|
|
Koha::MarcOverlayRules->validate($rule_data);
|
|
|
|
Validates C<$rule_data>. Throws C<Koha::Exceptions::MarcOverlayRule::InvalidTagRegExp>
|
|
if C<$rule_data->{tag}> contains an invalid regular expression. Throws
|
|
C<Koha::Exceptions::MarcOverlayRule::InvalidControlFieldActions> if contains invalid
|
|
combination of actions for control fields. Otherwise returns true.
|
|
|
|
=cut
|
|
|
|
sub validate {
|
|
my ($self, $rule_data) = @_;
|
|
|
|
if(exists $rule_data->{tag}) {
|
|
if ($rule_data->{tag} ne '*') {
|
|
eval { qr/$rule_data->{tag}/ };
|
|
if ($@) {
|
|
Koha::Exceptions::MarcOverlayRule::InvalidTagRegExp->throw(
|
|
"Invalid tag regular expression"
|
|
);
|
|
}
|
|
}
|
|
# TODO: Regexp or '*' that match controlfield not currently detected
|
|
if (
|
|
looks_like_number($rule_data->{tag}) &&
|
|
$rule_data->{tag} < 10 &&
|
|
$rule_data->{append} &&
|
|
!$rule_data->{remove}
|
|
) {
|
|
Koha::Exceptions::MarcOverlayRule::InvalidControlFieldActions->throw(
|
|
"Combination of allow append and skip remove not permitted for control fields"
|
|
);
|
|
}
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub _type {
|
|
return 'MarcOverlayRule';
|
|
}
|
|
|
|
=head3 object_class
|
|
|
|
=cut
|
|
|
|
sub object_class {
|
|
return 'Koha::MarcOverlayRule';
|
|
}
|
|
|
|
1;
|
|
|