From 8cde85451e3bae584ed1838efcaa4085cb656dfe Mon Sep 17 00:00:00 2001 From: Marcel de Rooy Date: Mon, 16 Jan 2017 14:54:37 +0100 Subject: [PATCH] Bug 17913: Fix the new field tag in merge when changing type Originally aimed for 9988, adjusted for this report. Old behavior was: pick the first tag. This is definitely wrong. If you (would) merge 610 to 611, you don't want to get a 111. This patch resolves the problem by determining the new tag in a small helper routine _merge_newtag, and corrects the position of the new field in the MARC record with append_fields_ordered. Too bad that MARC::Record does not have such a function; it looks like insert_fields_ordered, but it is different in case of multiple fields with the same tag. Note: These two small helper functions are not tested separately, since they should not be called outside of merge. They are implicitly tested by the adjusted tests in Merge.t. Note: In adding tests for this fix, I chose to simplify compare_field_count (no need for the pass parameter), and replace the pass parameter of sub compare_field_order by an exclude parameter, a hash of fields to exclude in counting fields. Test plan: Run t/db_dependent/Authorities/Merge.t Signed-off-by: Marcel de Rooy Signed-off-by: Josef Moravec Signed-off-by: Julian Maurice Signed-off-by: Kyle M Hall --- C4/AuthoritiesMarc.pm | 64 ++++++++++++++++++++++------- t/db_dependent/Authorities/Merge.t | 66 ++++++++++++++++-------------- 2 files changed, 85 insertions(+), 45 deletions(-) diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm index 131bc07f5c..53be7d2501 100644 --- a/C4/AuthoritiesMarc.pm +++ b/C4/AuthoritiesMarc.pm @@ -1458,32 +1458,33 @@ 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; + my $sql = "SELECT DISTINCT tagfield FROM marc_subfield_structure WHERE authtypecode=?"; + my $tags_using_authtype = $dbh->selectcol_arrayref( $sql, undef, ( $authtypefrom->authtypecode )); + my $tags_new; if ($authtypeto->authtypecode ne $authtypefrom->authtypecode){ - # If many tags, take the first - $sth->execute($authtypeto->authtypecode); - $tag_to=$sth->fetchrow; - #warn $tag_to; + $tags_new = $dbh->selectcol_arrayref( $sql, undef, ( $authtypeto->authtypecode )); } # BulkEdit marc records # May be used as a template for a bulkedit field my $overwrite = C4::Context->preference( 'AuthorityMergeMode' ) eq 'strict'; foreach my $marcrecord(@reccache){ my $update = 0; - foreach my $tagfield (@tags_using_authtype){ + foreach my $tagfield (@$tags_using_authtype){ # warn "tagfield : $tagfield "; 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(); + my $tag=$field->tag(); + my $newtag = $tags_new + ? _merge_newtag( $tag, $tags_new ) + : $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 $field_to = MARC::Field->new( + $newtag, + $field->indicator(1), + $field->indicator(2), + "9" => $mergeto, + ); my $exclude='9'; foreach my $subfield (grep {$_->[0] ne '9'} @record_to) { $field_to->add_subfields($subfield->[0] =>$subfield->[1]); @@ -1495,7 +1496,12 @@ sub merge { foreach my $subfield (@restore) { $field_to->add_subfields($subfield->[0] =>$subfield->[1]); } - $field->replace_with($field_to); + if( $tags_new ) { + $marcrecord->delete_field( $field ); + append_fields_ordered( $marcrecord, $field_to ); + } else { + $field->replace_with($field_to); + } $update=1; } }#for each tag @@ -1569,6 +1575,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/t/db_dependent/Authorities/Merge.t b/t/db_dependent/Authorities/Merge.t index 7e7d73b002..8ea7817a0e 100755 --- a/t/db_dependent/Authorities/Merge.t +++ b/t/db_dependent/Authorities/Merge.t @@ -66,15 +66,15 @@ 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' ); @@ -111,13 +111,13 @@ subtest 'Test merge A1 to modified A1' => sub { #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'); @@ -137,7 +137,7 @@ 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 => 12; # create two auth recs of different type my $auth1 = MARC::Record->new; @@ -172,9 +172,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, @@ -188,9 +193,18 @@ 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 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 { @@ -273,26 +287,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.39.5