Attachment #59973 for bug #18070

View | Details | Raw Unified | Return to bug 18070
Collapse All | Expand All




  return ($authid);
}


=head2 DelAuthority

  $authid = DelAuthority( $authid )

Deletes $authid and calls merge to cleanup in linked biblio records

=cut


    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", undef);
    my $sth = $dbh->prepare("DELETE FROM auth_header WHERE authid=?");
    $sth->execute($authid);
}

=head2 ModAuthority


=head2 merge

  $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.

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 = $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 ? $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 $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 $auth_tag_to_report_from && $MARCfrom && $MARCfrom->field($auth_tag_to_report_from);
    
    my @reccache;
    # search all biblio tags using this authority.

    $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 = $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( $authtypefrom && $authtypeto && $authtypeto->authtypecode ne $authtypefrom->authtypecode ) {
        $tags_new = $dbh->selectcol_arrayref( $sql, undef, ( $authtypeto->authtypecode ));
    }  


                my $tag         = $field->tag();
                next if !defined($auth_number) || $auth_number ne $mergefrom;
                $countfrom++;
                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;

Lines 84-92 if ($batch) { Link Here

(-)a/misc/migration_tools/merge_authority.pl (-3 / +6 lines)
84	foreach(@$authref) {	84	foreach(@$authref) {
85	my $authid=$_->[0];	85	my $authid=$_->[0];
86	print "managing $authid\n" if $verbose;	86	print "managing $authid\n" if $verbose;
87	my $MARCauth = GetAuthority($authid) ;	87	my $MARCauth = GetAuthority( $authid );
88	next unless ($MARCauth);	88	if( $MARCauth ) {
89	merge($authid,$MARCauth,$authid,$MARCauth) if ($MARCauth);	89	merge( $authid, $MARCauth, $authid, $MARCauth );
		90	} else {
		91	merge( $authid, undef ); # handle a delete
		92	}
90	}	93	}
91	$dbh->do("update need_merge_authorities set done=1 where done=2"); #DONE	94	$dbh->do("update need_merge_authorities set done=1 where done=2"); #DONE
92	} else {	95	} else {

Lines 225-231 subtest 'Test merge A1 to B1 (changing authtype)' => sub { Link Here

(-)a/t/db_dependent/Authorities/Merge.t (-4 / +29 lines)
225	};	225	};
226		226
227	subtest 'Merging authorities should handle deletes (BZ 18070)' => sub {	227	subtest 'Merging authorities should handle deletes (BZ 18070)' => sub {
228	plan tests => 1;	228	plan tests => 2;
		229
		230	# For this test we need dontmerge OFF
		231	t::lib::Mocks::mock_preference('dontmerge', '0');
229		232
230	# Add authority and linked biblio, delete authority	233	# Add authority and linked biblio, delete authority
231	my $auth1 = MARC::Record->new;	234	my $auth1 = MARC::Record->new;
Lines 237-247 subtest 'Merging authorities should handle deletes (BZ 18070)' => sub { Link Here
237	MARC::Field->new( '609', '', '', a => 'DEL', 9 => "$authid1" ),	240	MARC::Field->new( '609', '', '', a => 'DEL', 9 => "$authid1" ),
238	);	241	);
239	my ( $biblionumber ) = C4::Biblio::AddBiblio( $bib1, '' );	242	my ( $biblionumber ) = C4::Biblio::AddBiblio( $bib1, '' );
240	DelAuthority( $authid1 );	243	@zebrarecords = ( $bib1 );
		244	$index = 0;
		245	DelAuthority( $authid1 ); # this triggers a merge call
241		246
242	# See what happened	247	# See what happened in the biblio record
243	my $marc1 = C4::Biblio::GetMarcBiblio( $biblionumber );	248	my $marc1 = C4::Biblio::GetMarcBiblio( $biblionumber );
244	is( $marc1->field('609'), undef, 'Field 609 should be gone too' );	249	is( $marc1->field('609'), undef, 'Field 609 should be gone too' );
		250
		251	# Now we simulate the delete as done from the cron job (with dontmerge)
		252	# First, restore auth1 and add 609 back in bib1
		253	$auth1 = MARC::Record->new;
		254	$auth1->append_fields( MARC::Field->new( '109', '', '', 'a' => 'DEL'));
		255	$authid1 = AddAuthority( $auth1, undef, $authtype1 );
		256	$marc1->append_fields(
		257	MARC::Field->new( '609', '', '', a => 'DEL', 9 => "$authid1" ),
		258	);
		259	ModBiblio( $marc1, $biblionumber, '' );
		260	# Instead of going through DelAuthority, we manually delete the auth
		261	# record and call merge afterwards.
		262	# This mimics deleting an authority and calling merge later in the
		263	# merge_authority.pl cron job (when dontmerge is enabled).
		264	C4::Context->dbh->do( "DELETE FROM auth_header WHERE authid=?", undef, $authid1 );
		265	@zebrarecords = ( $marc1 );
		266	$index = 0;
		267	merge( $authid1, undef );
		268	# Final check
		269	$marc1 = C4::Biblio::GetMarcBiblio( $biblionumber );
		270	is( $marc1->field('609'), undef, 'Merge removed the 609 again even after deleting the authority record' );
245	};	271	};
246		272
247	sub set_mocks {	273	sub set_mocks {
248	-

Return to bug 18070

Lines 697-708 sub AddAuthority { Link Here

(-)a/C4/AuthoritiesMarc.pm (-21 / +32 lines)
697	return ($authid);	697	return ($authid);
698	}	698	}
699		699
700
701	=head2 DelAuthority	700	=head2 DelAuthority
702		701
703	$authid= &DelAuthority($authid)	702	$authid = DelAuthority( $authid )
704		703
705	Deletes $authid	704	Deletes $authid and calls merge to cleanup in linked biblio records
706		705
707	=cut	706	=cut
708		707
Lines 710-719 sub DelAuthority { Link Here
710	my ($authid) = @_;	709	my ($authid) = @_;
711	my $dbh=C4::Context->dbh;	710	my $dbh=C4::Context->dbh;
712		711
		712	unless( C4::Context->preference('dontmerge') eq '1' ) {
		713	&merge( $authid, GetAuthority($authid) );
		714	} else {
		715	# save a record in need_merge_authorities table
		716	my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) VALUES (?,?)";
		717	$dbh->do( $sqlinsert, undef, $authid, 0 );
		718	}
		719	$dbh->do( "DELETE FROM auth_header WHERE authid=?", undef, $authid );
713	logaction( "AUTHORITIES", "DELETE", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog");	720	logaction( "AUTHORITIES", "DELETE", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog");
714	ModZebra($authid,"recordDelete","authorityserver",GetAuthority($authid),undef);	721	ModZebra( $authid, "recordDelete", "authorityserver", undef);
715	my $sth = $dbh->prepare("DELETE FROM auth_header WHERE authid=?");
716	$sth->execute($authid);
717	}	722	}
718		723
719	=head2 ModAuthority	724	=head2 ModAuthority
Lines 1399-1430 sub AddAuthorityTrees{ Link Here
1399		1404
1400	=head2 merge	1405	=head2 merge
1401		1406
1402	$ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto)	1407	$count = merge ( mergefrom, $MARCfrom, [$mergeto, $MARCto] )
		1408
		1409	Merge biblios linked to authority $mergefrom.
		1410	If $mergeto equals mergefrom, the linked biblio field is updated.
		1411	If $mergeto is different, the biblio field will be linked to $mergeto.
		1412	If $mergeto is missing, the biblio field is deleted.
1403		1413
1404	Could add some feature : Migrating from a typecode to an other for instance.	1414	Note: Although $mergefrom and $mergeto will normally be of the same
1405	Then we should add some new parameter : bibliotargettag, authtargettag	1415	authority type, merge also supports moving to another authority type.
1406		1416
1407	=cut	1417	=cut
1408		1418
1409	sub merge {	1419	sub merge {
1410	my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;	1420	my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
		1421	return 0 unless $mergefrom > 0; # prevent abuse
1411	my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);	1422	my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);
1412	my $dbh=C4::Context->dbh;	1423	my $dbh=C4::Context->dbh;
1413	my $authfrom = Koha::Authorities->find($mergefrom);	1424	my $authfrom = Koha::Authorities->find($mergefrom);
1414	my $authto = Koha::Authorities->find($mergeto);	1425	my $authto = Koha::Authorities->find($mergeto);
1415	my $authtypefrom = Koha::Authority::Types->find($authfrom->authtypecode);	1426	my $authtypefrom = $authfrom ? Koha::Authority::Types->find($authfrom->authtypecode) : undef;
1416	my $authtypeto = Koha::Authority::Types->find($authto->authtypecode);	1427	my $authtypeto = $authto ? Koha::Authority::Types->find($authto->authtypecode) : undef;
1417		1428
1418	return "error MARCFROM not a marcrecord ".Data::Dumper::Dumper($MARCfrom) if scalar($MARCfrom->fields()) == 0;
1419	return "error MARCTO not a marcrecord".Data::Dumper::Dumper($MARCto) if scalar($MARCto->fields()) == 0;
1420	# search the tag to report	1429	# search the tag to report
1421	my $auth_tag_to_report_from = $authtypefrom->auth_tag_to_report;	1430	my $auth_tag_to_report_from = $authtypefrom ? $authtypefrom->auth_tag_to_report : '';
1422	my $auth_tag_to_report_to = $authtypeto->auth_tag_to_report;	1431	my $auth_tag_to_report_to = $authtypeto ? $authtypeto->auth_tag_to_report : '';
1423		1432
1424	my @record_to;	1433	my @record_to;
1425	@record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to);	1434	@record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $auth_tag_to_report_to && $MARCto && $MARCto->field($auth_tag_to_report_to);
1426	my @record_from;	1435	my @record_from;
1427	@record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);	1436	@record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $auth_tag_to_report_from && $MARCfrom && $MARCfrom->field($auth_tag_to_report_from);
1428		1437
1429	my @reccache;	1438	my @reccache;
1430	# search all biblio tags using this authority.	1439	# search all biblio tags using this authority.
Lines 1457-1466 sub merge { Link Here
1457	$oResult->destroy();	1466	$oResult->destroy();
1458	# Get All candidate Tags for the change	1467	# Get All candidate Tags for the change
1459	# (This will reduce the search scope in marc records).	1468	# (This will reduce the search scope in marc records).
		1469	# For a deleted authority record, we scan all auth controlled fields
1460	my $sql = "SELECT DISTINCT tagfield FROM marc_subfield_structure WHERE authtypecode=?";	1470	my $sql = "SELECT DISTINCT tagfield FROM marc_subfield_structure WHERE authtypecode=?";
1461	my $tags_using_authtype = $dbh->selectcol_arrayref( $sql, undef, ( $authtypefrom->authtypecode ));	1471	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<>''" );
1462	my $tags_new;	1472	my $tags_new;
1463	if ($authtypeto->authtypecode ne $authtypefrom->authtypecode){	1473	if( $authtypefrom && $authtypeto && $authtypeto->authtypecode ne $authtypefrom->authtypecode ) {
1464	$tags_new = $dbh->selectcol_arrayref( $sql, undef, ( $authtypeto->authtypecode ));	1474	$tags_new = $dbh->selectcol_arrayref( $sql, undef, ( $authtypeto->authtypecode ));
1465	}	1475	}
1466		1476
Lines 1483-1490 sub merge { Link Here
1483	my $tag = $field->tag();	1493	my $tag = $field->tag();
1484	next if !defined($auth_number) \|\| $auth_number ne $mergefrom;	1494	next if !defined($auth_number) \|\| $auth_number ne $mergefrom;
1485	$countfrom++;	1495	$countfrom++;
1486	if ( $overwrite && $countfrom > 1 ) {	1496	if ( !$mergeto \|\| ( $overwrite && $countfrom > 1 ) ) {
1487	# remove this duplicate in strict mode	1497	# if mergeto is missing, this indicates a delete
		1498	# Or: remove this duplicate in strict mode
1488	$marcrecord->delete_field($field);	1499	$marcrecord->delete_field($field);
1489	$update = 1;	1500	$update = 1;
1490	next;	1501	next;