|
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(); |