Bug 18070: Extend sub merge to remove fields for deleted authorities

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.

Note: Deleting an authority with linked biblios is tested on the next
patch.

Test plan:
[1] Run t/db_dependent/Authorities/Merge.t
[2] Delete an authority without linked biblios from the Authorities
    module. If the indexer is not fast enough, wait a bit and refresh to
    verify that the authority is gone on authorities-home.pl.

Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>
Signed-off-by: Josef Moravec <josef.moravec@gmail.com>
Signed-off-by: Julian Maurice <julian.maurice@biblibre.com>
Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>

diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm
index 679ca7d..afef9c8 100644 (file)
--- 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 (executable)
--- 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 32c1903..7ee8cdb 100755 (executable)
--- 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 18070)' => 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,11 +232,34 @@ subtest 'Merging authorities should handle deletes (BZ 18070)' => 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'), undef, 'Field 609 should be gone too' );
+
+    # 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 {