From 63cb4abd086fdfc2c40bd04f5700fffb4cc74c28 Mon Sep 17 00:00:00 2001 From: Marcel de Rooy Date: Mon, 23 Jan 2017 14:06:48 +0100 Subject: [PATCH] Bug 17913: [16.11.x] Authority merge fix Content-Type: text/plain; charset=utf-8 [PUSHED_17.05] Squashed into one patch for 16.11.x --- C4/AuthoritiesMarc.pm | 103 ++++++++++++++------ .../en/modules/admin/preferences/authorities.pref | 9 ++ t/db_dependent/Authorities/Merge.t | 107 ++++++++++++++------- 3 files changed, 155 insertions(+), 64 deletions(-) diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm index e14c85f..9c02b99 100644 --- a/C4/AuthoritiesMarc.pm +++ b/C4/AuthoritiesMarc.pm @@ -1458,46 +1458,67 @@ sub merge { #warn scalar(@reccache)." biblios to update"; # Get All candidate Tags for the change # (This will reduce the search scope in marc records). - my $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?"); - $sth->execute($authtypefrom->authtypecode); - my @tags_using_authtype; - while (my ($tagfield) = $sth->fetchrow) { - push @tags_using_authtype,$tagfield ; - } - my $tag_to=0; - if ($authtypeto->authtypecode ne $authtypefrom->authtypecode){ - # If many tags, take the first - $sth->execute($authtypeto->authtypecode); - $tag_to=$sth->fetchrow; - #warn $tag_to; + my $sql = "SELECT DISTINCT tagfield FROM marc_subfield_structure WHERE authtypecode=?"; + my $tags_using_authtype = $dbh->selectcol_arrayref( $sql, undef, ( $authtypecodefrom )); + my $tags_new; + if ($authtypecodeto ne $authtypecodefrom){ + $tags_new = $dbh->selectcol_arrayref( $sql, undef, ( $authtypecodeto )); } # BulkEdit marc records # May be used as a template for a bulkedit field + my $overwrite = C4::Context->preference( 'AuthorityMergeMode' ) eq 'strict'; + my $skip_subfields = $overwrite + # This hash contains all subfields from the authority report fields + # Including $MARCfrom as well as $MARCto + # We only need it in loose merge mode; replaces the former $exclude + ? {} + : { map { ( $_->[0], 1 ); } ( @record_from, @record_to ) }; + # And we need to add $9 in order not to duplicate + $skip_subfields->{9} = 1 if !$overwrite; + foreach my $marcrecord(@reccache){ my $update = 0; - foreach my $tagfield (@tags_using_authtype){ + foreach my $tagfield (@$tags_using_authtype) { # warn "tagfield : $tagfield "; + my $countfrom = 0; # used in strict mode to remove duplicates foreach my $field ($marcrecord->field($tagfield)){ # biblio is linked to authority with $9 subfield containing authid my $auth_number=$field->subfield("9"); - my $tag=$field->tag(); - if ($auth_number==$mergefrom) { - my $field_to=MARC::Field->new(($tag_to?$tag_to:$tag),$field->indicator(1),$field->indicator(2),"9"=>$mergeto); - my $exclude='9'; + my $tag=$field->tag(); + next if !defined($auth_number) || $auth_number ne $mergefrom; + $countfrom++; + if( $overwrite && $countfrom > 1 ) { + # remove this duplicate in strict mode + $marcrecord->delete_field( $field ); + $update = 1; + next; + } + my $newtag = $tags_new + ? _merge_newtag( $tag, $tags_new ) + : $tag; + my $field_to = MARC::Field->new( + $newtag, + $field->indicator(1), + $field->indicator(2), + "9" => $mergeto, + ); foreach my $subfield (grep {$_->[0] ne '9'} @record_to) { $field_to->add_subfields($subfield->[0] =>$subfield->[1]); - $exclude.= $subfield->[0]; } - $exclude='['.$exclude.']'; -# add subfields in $field not included in @record_to - my @restore= grep {$_->[0]!~/$exclude/} $field->subfields(); - foreach my $subfield (@restore) { - $field_to->add_subfields($subfield->[0] =>$subfield->[1]); - } - $marcrecord->delete_field($field); - $marcrecord->insert_grouped_field($field_to); - $update=1; + if( !$overwrite ) { + # add subfields back in loose mode, check skip_subfields + foreach my $subfield ( $field->subfields ) { + next if $skip_subfields->{ $subfield->[0] }; + $field_to->add_subfields( $subfield->[0], $subfield->[1] ); + } } + if( $tags_new ) { + $marcrecord->delete_field( $field ); + append_fields_ordered( $marcrecord, $field_to ); + } else { + $field->replace_with($field_to); + } + $update=1; }#for each tag }#foreach tagfield my ($bibliotag,$bibliosubf) = GetMarcFromKohaField("biblio.biblionumber","") ; @@ -1569,6 +1590,34 @@ sub merge { # }#foreach $marc }#sub +sub _merge_newtag { +# Routine is only called for an (exceptional) authtypecode change +# Fixes old behavior of returning the first tag found + my ( $oldtag, $new_tags ) = @_; + + # If we e.g. have 650 and 151,651,751 try 651 and check presence + my $prefix = substr( $oldtag, 0, 1 ); + my $guess = $prefix . substr( $new_tags->[0], -2 ); + if( grep { $_ eq $guess } @$new_tags ) { + return $guess; + } + # Otherwise return one from the same block e.g. 6XX for 650 + # If not there too, fall back to first new tag (old behavior!) + my @same_block = grep { /^$prefix/ } @$new_tags; + return @same_block ? $same_block[0] : $new_tags->[0]; +} + +sub append_fields_ordered { +# while we lack this function in MARC::Record +# we do not want insert_fields_ordered since it inserts before + my ( $record, $field ) = @_; + if( my @flds = $record->field( $field->tag ) ) { + $record->insert_fields_after( pop @flds, $field ); + } else { # now fallback to insert_fields_ordered + $record->insert_fields_ordered( $field ); + } +} + =head2 get_auth_type_location my ($tag, $subfield) = get_auth_type_location($auth_type_code); diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/authorities.pref b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/authorities.pref index 2762411..7237035 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/authorities.pref +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/authorities.pref @@ -49,6 +49,15 @@ Authorities: defautl: "afrey50 ba0" type: textarea class: code + - + - When updating biblio records from an attached authority record ("merging"), handle subfields of relevant biblio record fields in + - pref: AuthorityMergeMode + default: "loose" + choices: + "loose": loose + "strict": strict + - mode. In strict mode subfields that are not found in the authority record, are deleted. Loose mode will keep them. Loose mode is the historical behavior and still the default. + Linker: - - Use the diff --git a/t/db_dependent/Authorities/Merge.t b/t/db_dependent/Authorities/Merge.t index 50e4520..3102695 100755 --- a/t/db_dependent/Authorities/Merge.t +++ b/t/db_dependent/Authorities/Merge.t @@ -10,6 +10,7 @@ use MARC::Record; use Test::MockModule; use Test::MockObject; +use t::lib::Mocks; use t::lib::TestBuilder; use C4::Biblio; @@ -40,6 +41,9 @@ subtest 'Test merge A1 to A2 (within same authtype)' => sub { # Tests originate from bug 11700 plan tests => 9; + # Start in loose mode, although it actually does not matter here + t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose'); + # Add two authority records my $auth1 = MARC::Record->new; $auth1->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'George Orwell' )); @@ -65,23 +69,23 @@ subtest 'Test merge A1 to A2 (within same authtype)' => sub { # Check the results my $newbiblio1 = GetMarcBiblio($biblionumber1); $newbiblio1->delete_fields( $newbiblio1->field('100') ); # fix for UNIMARC - compare_field_count( $biblio1, $newbiblio1, 1 ); - compare_field_order( $biblio1, $newbiblio1, 1 ); + compare_field_count( $biblio1, $newbiblio1 ); + compare_field_order( $biblio1, $newbiblio1 ); is( $newbiblio1->subfield('609', '9'), $authid1, 'Check biblio1 609$9' ); is( $newbiblio1->subfield('609', 'a'), 'George Orwell', 'Check biblio1 609$a' ); my $newbiblio2 = GetMarcBiblio($biblionumber2); $newbiblio2->delete_fields( $newbiblio2->field('100') ); # fix for UNIMARC - compare_field_count( $biblio2, $newbiblio2, 1 ); - compare_field_order( $biblio2, $newbiblio2, 1 ); + compare_field_count( $biblio2, $newbiblio2 ); + compare_field_order( $biblio2, $newbiblio2 ); is( $newbiblio2->subfield('609', '9'), $authid1, 'Check biblio2 609$9' ); is( $newbiblio2->subfield('609', 'a'), 'George Orwell', 'Check biblio2 609$a' ); }; -subtest 'Test merge A1 to modified A1' => sub { +subtest 'Test merge A1 to modified A1, test strict mode' => sub { # Tests originate from bug 11700 - plan tests => 8; + plan tests => 11; # Simulate modifying an authority from auth1old to auth1new my $auth1old = MARC::Record->new; @@ -94,40 +98,58 @@ subtest 'Test merge A1 to modified A1' => sub { my $MARC1 = MARC::Record->new; $MARC1->append_fields( MARC::Field->new( '109', '', '', 'a' => 'Bruce Wayne', 'b' => '2014', '9' => $authid1 )); $MARC1->append_fields( MARC::Field->new( '245', '', '', 'a' => 'From the depths' )); + $MARC1->append_fields( MARC::Field->new( '609', '', '', 'a' => 'Bruce Lee', 'b' => 'Should be cleared too', '9' => $authid1 )); + $MARC1->append_fields( MARC::Field->new( '609', '', '', 'a' => 'Bruce Lee', 'c' => 'This is a duplicate to be removed in strict mode', '9' => $authid1 )); my $MARC2 = MARC::Record->new; $MARC2->append_fields( MARC::Field->new( '109', '', '', 'a' => 'Batman', '9' => $authid1 )); $MARC2->append_fields( MARC::Field->new( '245', '', '', 'a' => 'All the way to heaven' )); my ( $biblionumber1 ) = AddBiblio( $MARC1, ''); my ( $biblionumber2 ) = AddBiblio( $MARC2, ''); - # Time to merge + # Time to merge in loose mode first @zebrarecords = ( $MARC1, $MARC2 ); $index = 0; + t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose'); my $rv = C4::AuthoritiesMarc::merge( $authid1, $auth1old, $authid1, $auth1new ); is( $rv, 2, 'Both records are updated now' ); #Check the results my $biblio1 = GetMarcBiblio($biblionumber1); $biblio1->delete_fields( $biblio1->field('100') ); # quick fix for UNIMARC - compare_field_count( $MARC1, $biblio1, 1 ); - compare_field_order( $MARC1, $biblio1, 1 ); + compare_field_count( $MARC1, $biblio1 ); + compare_field_order( $MARC1, $biblio1 ); is( $auth1new->field(109)->subfield('a'), $biblio1->field(109)->subfield('a'), 'Record1 values updated correctly' ); my $biblio2 = GetMarcBiblio( $biblionumber2 ); $biblio2->delete_fields( $biblio2->field('100') ); # quick fix for UNIMARC - compare_field_count( $MARC2, $biblio2, 1 ); - compare_field_order( $MARC2, $biblio2, 1 ); + compare_field_count( $MARC2, $biblio2 ); + compare_field_order( $MARC2, $biblio2 ); is( $auth1new->field(109)->subfield('a'), $biblio2->field(109)->subfield('a'), 'Record2 values updated correctly' ); + # This is only true in loose mode: + is( $biblio1->field(109)->subfield('b'), $MARC1->field(109)->subfield('b'), 'Subfield not overwritten in loose mode'); - # TODO Following test will change when we improve merge - # Will depend on a preference - is( $biblio1->field(109)->subfield('b'), $MARC1->field(109)->subfield('b'), 'Record not overwritten while merging'); + # Merge again in strict mode + t::lib::Mocks::mock_preference('AuthorityMergeMode', 'strict'); + ModBiblio( $MARC1, $biblionumber1, '' ); + @zebrarecords = ( $MARC1 ); + $index = 0; + $rv = C4::AuthoritiesMarc::merge( $authid1, $auth1old, $authid1, $auth1new ); + $biblio1 = GetMarcBiblio($biblionumber1); + $biblio1->delete_fields( $biblio1->field('100') ); # quick fix for UNIMARC + is( $biblio1->field(109)->subfield('b'), undef, 'Subfield overwritten in strict mode' ); + is( $biblio1->fields, scalar( $MARC1->fields ) - 1, 'strict mode should remove a duplicate 609' ); + is( $biblio1->field(609)->subfields, + scalar($auth1new->field('109')->subfields) + 1, + 'Check number of subfields in strict mode for the remaining 609' ); + # Note: the +1 comes from the added subfield $9 in the biblio }; subtest 'Test merge A1 to B1 (changing authtype)' => sub { # Tests were aimed for bug 9988, moved to 17909 in adjusted form # Would not encourage this type of merge, but we should test what we offer -# The merge routine still needs the fixes on bug 17913 - plan tests => 8; + plan tests => 13; + + # Get back to loose mode now + t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose'); # create two auth recs of different type my $auth1 = MARC::Record->new; @@ -162,9 +184,14 @@ subtest 'Test merge A1 to B1 (changing authtype)' => sub { # Get new marc record for compares my $newbiblio = C4::Biblio::GetMarcBiblio( $biblionumber ); $newbiblio->delete_fields( $newbiblio->field('100') ); # fix for UNIMARC - compare_field_count( $oldbiblio, $newbiblio, 1 ); - # TODO The following test will still fail; refined after 17913 - compare_field_order( $oldbiblio, $newbiblio, 0 ); + compare_field_count( $oldbiblio, $newbiblio ); + # Exclude 109/609 and 112/612 in comparing order + compare_field_order( $oldbiblio, $newbiblio, + { '109' => 1, '112' => 1, '609' => 1, '612' => 1 }, + ); + # Check position of 612s in the new record + my $full_order = join q/,/, map { $_->tag } $newbiblio->fields; + is( $full_order =~ /611(,612){3}/, 1, 'Check position of all 612s' ); # Check some fields is( $newbiblio->field('003')->data, @@ -178,9 +205,23 @@ subtest 'Test merge A1 to B1 (changing authtype)' => sub { is( $newbiblio->subfield( '112', 'c' ), $auth2->subfield( '112', 'c' ), 'Check new 112c' ); - #TODO Check the new 612s (after fix on 17913, they are 112s now) - is( $newbiblio->subfield( '612', 'a' ), + # Check 112b; this subfield was cleared when moving from 109 to 112 + # Note that this fix only applies to the current loose mode only + is( $newbiblio->subfield( '112', 'b' ), undef, + 'Merge respects a cleared subfield in loose mode' ); + + # Check the original 612 + is( ( $newbiblio->field('612') )[0]->subfield( 'a' ), $oldbiblio->subfield( '612', 'a' ), 'Check untouched 612a' ); + # Check second 612 + is( ( $newbiblio->field('612') )[1]->subfield( 'a' ), + $auth2->subfield( '112', 'a' ), 'Check second touched 612a' ); + # Check second new 612ax (in LOOSE mode) + is( ( $newbiblio->field('612') )[2]->subfield( 'a' ), + $auth2->subfield( '112', 'a' ), 'Check touched 612a' ); + is( ( $newbiblio->field('612') )[2]->subfield( 'x' ), + ( $oldbiblio->field('609') )[1]->subfield('x'), + 'Check 612x' ); }; sub set_mocks { @@ -263,26 +304,18 @@ sub modify_framework { } sub compare_field_count { - my ( $oldmarc, $newmarc, $pass ) = @_; + my ( $oldmarc, $newmarc ) = @_; my $t; - if( $pass ) { - is( scalar $newmarc->fields, $t = $oldmarc->fields, "Number of fields still equal to $t" ); - } else { - isnt( scalar $newmarc->fields, $t = $oldmarc->fields, "Number of fields not equal to $t" ); - } + is( scalar $newmarc->fields, $t = $oldmarc->fields, "Number of fields still equal to $t" ); } sub compare_field_order { - my ( $oldmarc, $newmarc, $pass ) = @_; - if( $pass ) { - is( ( join q/,/, map { $_->tag; } $newmarc->fields ), - ( join q/,/, map { $_->tag; } $oldmarc->fields ), - 'Order of fields unchanged' ); - } else { - isnt( ( join q/,/, map { $_->tag; } $newmarc->fields ), - ( join q/,/, map { $_->tag; } $oldmarc->fields ), - 'Order of fields changed' ); - } + my ( $oldmarc, $newmarc, $exclude ) = @_; + $exclude //= {}; + my @oldfields = map { $exclude->{$_->tag} ? () : $_->tag } $oldmarc->fields; + my @newfields = map { $exclude->{$_->tag} ? () : $_->tag } $newmarc->fields; + is( ( join q/,/, @newfields ), ( join q/,/, @oldfields ), + 'Order of fields unchanged' ); } $schema->storage->txn_rollback; -- 2.1.4