From 7756a50e843d456a3afae814f9db625d7119803b Mon Sep 17 00:00:00 2001 From: Marcel de Rooy Date: Tue, 31 Jan 2017 13:01:58 +0100 Subject: [PATCH] Bug 14026: Extend sub merge to remove fields for deleted authorities Content-Type: text/plain; charset=utf-8 In order to accomplish this, we need to add some additional checks in the merge routine. The actual change to remove the field, is quite small. Furthermore, we need to add a merge call in DelAuthority and adjust the merge cron job accordingly. The change is well supported by additional tests, including a simulation of postponed removal via cron, if dontmerge is enabled. Test plan: [1] Run t/db_dependent/Authorities/Merge.t [2] Look for an authority with a few linked biblios. Delete this authority: the quickest way currently is URL manipulation: /cgi-bin/koha/authorities/authorities-home.pl?op=delete&authid=[XXX] Now check the biblio records; the link should be removed. Note: Since merge can handle deleting authorities now, we could consider adding the option 'Delete' on the Actions menu for authorities having linked biblios. The delete action also needs CSRF protection. Both should be handled on new reports. Signed-off-by: Marcel de Rooy --- C4/AuthoritiesMarc.pm | 53 ++++++++++++++++++++------------- misc/migration_tools/merge_authority.pl | 9 ++++-- t/db_dependent/Authorities/Merge.t | 35 ++++++++++++++++++---- 3 files changed, 68 insertions(+), 29 deletions(-) diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm index 679ca7d..afef9c8 100644 --- a/C4/AuthoritiesMarc.pm +++ b/C4/AuthoritiesMarc.pm @@ -680,12 +680,11 @@ sub AddAuthority { return ( $authid ); } - =head2 DelAuthority - $authid= &DelAuthority($authid) + $authid = DelAuthority( $authid ) -Deletes $authid +Deletes $authid and calls merge to cleanup in linked biblio records =cut @@ -693,10 +692,16 @@ sub DelAuthority { my ($authid) = @_; my $dbh=C4::Context->dbh; + unless( C4::Context->preference('dontmerge') eq '1' ) { + &merge( $authid, GetAuthority($authid) ); + } else { + # save a record in need_merge_authorities table + my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) VALUES (?,?)"; + $dbh->do( $sqlinsert, undef, $authid, 0 ); + } + $dbh->do( "DELETE FROM auth_header WHERE authid=?", undef, $authid ); logaction( "AUTHORITIES", "DELETE", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog"); - ModZebra($authid,"recordDelete","authorityserver",GetAuthority($authid),undef); - my $sth = $dbh->prepare("DELETE FROM auth_header WHERE authid=?"); - $sth->execute($authid); + ModZebra( $authid, "recordDelete", "authorityserver", undef); } =head2 ModAuthority @@ -1382,32 +1387,36 @@ sub AddAuthorityTrees{ =head2 merge - $ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto) + $count = merge ( mergefrom, $MARCfrom, [$mergeto, $MARCto] ) + +Merge biblios linked to authority $mergefrom. +If $mergeto equals mergefrom, the linked biblio field is updated. +If $mergeto is different, the biblio field will be linked to $mergeto. +If $mergeto is missing, the biblio field is deleted. -Could add some feature : Migrating from a typecode to an other for instance. -Then we should add some new parameter : bibliotargettag, authtargettag +Note: Although $mergefrom and $mergeto will normally be of the same +authority type, merge also supports moving to another authority type. =cut sub merge { my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_; + return 0 unless $mergefrom > 0; # prevent abuse my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0); my $dbh=C4::Context->dbh; my $authfrom = Koha::Authorities->find($mergefrom); my $authto = Koha::Authorities->find($mergeto); - my $authtypefrom = Koha::Authority::Types->find($authfrom->authtypecode); - my $authtypeto = Koha::Authority::Types->find($authto->authtypecode); + my $authtypefrom = $authfrom ? Koha::Authority::Types->find($authfrom->authtypecode) : undef; + my $authtypeto = $authto ? Koha::Authority::Types->find($authto->authtypecode) : undef; - return "error MARCFROM not a marcrecord ".Data::Dumper::Dumper($MARCfrom) if scalar($MARCfrom->fields()) == 0; - return "error MARCTO not a marcrecord".Data::Dumper::Dumper($MARCto) if scalar($MARCto->fields()) == 0; # search the tag to report - my $auth_tag_to_report_from = $authtypefrom->auth_tag_to_report; - my $auth_tag_to_report_to = $authtypeto->auth_tag_to_report; + my $auth_tag_to_report_from = $authtypefrom ? $authtypefrom->auth_tag_to_report : ''; + my $auth_tag_to_report_to = $authtypeto ? $authtypeto->auth_tag_to_report : ''; my @record_to; - @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to); + @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $auth_tag_to_report_to && $MARCto && $MARCto->field($auth_tag_to_report_to); my @record_from; - @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from); + @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $auth_tag_to_report_from && $MARCfrom && $MARCfrom->field($auth_tag_to_report_from); my @reccache; # search all biblio tags using this authority. @@ -1440,10 +1449,11 @@ sub merge { $oResult->destroy(); # Get All candidate Tags for the change # (This will reduce the search scope in marc records). + # For a deleted authority record, we scan all auth controlled fields my $sql = "SELECT DISTINCT tagfield FROM marc_subfield_structure WHERE authtypecode=?"; - my $tags_using_authtype = $dbh->selectcol_arrayref( $sql, undef, ( $authtypefrom->authtypecode )); + my $tags_using_authtype = $authtypefrom ? $dbh->selectcol_arrayref( $sql, undef, ( $authtypefrom->authtypecode )) : $dbh->selectcol_arrayref( "SELECT DISTINCT tagfield FROM marc_subfield_structure WHERE authtypecode IS NOT NULL AND authtypecode<>''" ); my $tags_new; - if ($authtypeto->authtypecode ne $authtypefrom->authtypecode){ + if( $authtypefrom && $authtypeto && $authtypeto->authtypecode ne $authtypefrom->authtypecode ) { $tags_new = $dbh->selectcol_arrayref( $sql, undef, ( $authtypeto->authtypecode )); } @@ -1466,8 +1476,9 @@ sub merge { my $tag = $field->tag(); next if !defined($auth_number) || $auth_number ne $mergefrom; $countfrom++; - if ( $overwrite && $countfrom > 1 ) { - # remove this duplicate in strict mode + if ( !$mergeto || ( $overwrite && $countfrom > 1 ) ) { + # if mergeto is missing, this indicates a delete + # Or: remove this duplicate in strict mode $marcrecord->delete_field($field); $update = 1; next; diff --git a/misc/migration_tools/merge_authority.pl b/misc/migration_tools/merge_authority.pl index 405b66a..061a3bd 100755 --- a/misc/migration_tools/merge_authority.pl +++ b/misc/migration_tools/merge_authority.pl @@ -84,9 +84,12 @@ if ($batch) { foreach(@$authref) { my $authid=$_->[0]; print "managing $authid\n" if $verbose; - my $MARCauth = GetAuthority($authid) ; - next unless ($MARCauth); - merge($authid,$MARCauth,$authid,$MARCauth) if ($MARCauth); + my $MARCauth = GetAuthority( $authid ); + if( $MARCauth ) { + merge( $authid, $MARCauth, $authid, $MARCauth ); + } else { + merge( $authid, undef ); # handle a delete + } } $dbh->do("update need_merge_authorities set done=1 where done=2"); #DONE } else { diff --git a/t/db_dependent/Authorities/Merge.t b/t/db_dependent/Authorities/Merge.t index 4005e97..f720d28 100755 --- a/t/db_dependent/Authorities/Merge.t +++ b/t/db_dependent/Authorities/Merge.t @@ -217,7 +217,10 @@ subtest 'Test merge A1 to B1 (changing authtype)' => sub { }; subtest 'Merging authorities should handle deletes (BZ 14026)' => sub { - plan tests => 1; + plan tests => 2; + + # For this test we need dontmerge OFF + t::lib::Mocks::mock_preference('dontmerge', '0'); # Add authority and linked biblio, delete authority my $auth1 = MARC::Record->new; @@ -229,12 +232,34 @@ subtest 'Merging authorities should handle deletes (BZ 14026)' => sub { MARC::Field->new( '609', '', '', a => 'DEL', 9 => "$authid1" ), ); my ( $biblionumber ) = C4::Biblio::AddBiblio( $bib1, '' ); - DelAuthority( $authid1 ); + @zebrarecords = ( $bib1 ); + $index = 0; + DelAuthority( $authid1 ); # this triggers a merge call - # See what happened + # See what happened in the biblio record my $marc1 = C4::Biblio::GetMarcBiblio( $biblionumber ); - is( $marc1->field('609') && $marc1->field('609')->subfield('9'), - $authid1, 'FIXME: Merge should be called to remove this subfield' ); + is( $marc1->field('609'), undef, 'Merge should have removed the 609' ); + + # Now we simulate the delete as done from the cron job (with dontmerge) + # First, restore auth1 and add 609 back in bib1 + $auth1 = MARC::Record->new; + $auth1->append_fields( MARC::Field->new( '109', '', '', 'a' => 'DEL')); + $authid1 = AddAuthority( $auth1, undef, $authtype1 ); + $marc1->append_fields( + MARC::Field->new( '609', '', '', a => 'DEL', 9 => "$authid1" ), + ); + ModBiblio( $marc1, $biblionumber, '' ); + # Instead of going through DelAuthority, we manually delete the auth + # record and call merge afterwards. + # This mimics deleting an authority and calling merge later in the + # merge_authority.pl cron job (when dontmerge is enabled). + C4::Context->dbh->do( "DELETE FROM auth_header WHERE authid=?", undef, $authid1 ); + @zebrarecords = ( $marc1 ); + $index = 0; + merge( $authid1, undef ); + # Final check + $marc1 = C4::Biblio::GetMarcBiblio( $biblionumber ); + is( $marc1->field('609'), undef, 'Merge removed the 609 again even after deleting the authority record' ); }; sub set_mocks { -- 2.1.4