Attachment #60393 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 680-691 sub AddAuthority { Link Here

(-)a/C4/AuthoritiesMarc.pm (-21 / +32 lines)
680	return ( $authid );	680	return ( $authid );
681	}	681	}
682		682
683
684	=head2 DelAuthority	683	=head2 DelAuthority
685		684
686	$authid= &DelAuthority($authid)	685	$authid = DelAuthority( $authid )
687		686
688	Deletes $authid	687	Deletes $authid and calls merge to cleanup in linked biblio records
689		688
690	=cut	689	=cut
691		690
Lines 693-702 sub DelAuthority { Link Here
693	my ($authid) = @_;	692	my ($authid) = @_;
694	my $dbh=C4::Context->dbh;	693	my $dbh=C4::Context->dbh;
695		694
		695	unless( C4::Context->preference('dontmerge') eq '1' ) {
		696	&merge( $authid, GetAuthority($authid) );
		697	} else {
		698	# save a record in need_merge_authorities table
		699	my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) VALUES (?,?)";
		700	$dbh->do( $sqlinsert, undef, $authid, 0 );
		701	}
		702	$dbh->do( "DELETE FROM auth_header WHERE authid=?", undef, $authid );
696	logaction( "AUTHORITIES", "DELETE", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog");	703	logaction( "AUTHORITIES", "DELETE", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog");
697	ModZebra($authid,"recordDelete","authorityserver",GetAuthority($authid),undef);	704	ModZebra( $authid, "recordDelete", "authorityserver", undef);
698	my $sth = $dbh->prepare("DELETE FROM auth_header WHERE authid=?");
699	$sth->execute($authid);
700	}	705	}
701		706
702	=head2 ModAuthority	707	=head2 ModAuthority
Lines 1382-1413 sub AddAuthorityTrees{ Link Here
1382		1387
1383	=head2 merge	1388	=head2 merge
1384		1389
1385	$ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto)	1390	$count = merge ( mergefrom, $MARCfrom, [$mergeto, $MARCto] )
		1391
		1392	Merge biblios linked to authority $mergefrom.
		1393	If $mergeto equals mergefrom, the linked biblio field is updated.
		1394	If $mergeto is different, the biblio field will be linked to $mergeto.
		1395	If $mergeto is missing, the biblio field is deleted.
1386		1396
1387	Could add some feature : Migrating from a typecode to an other for instance.	1397	Note: Although $mergefrom and $mergeto will normally be of the same
1388	Then we should add some new parameter : bibliotargettag, authtargettag	1398	authority type, merge also supports moving to another authority type.
1389		1399
1390	=cut	1400	=cut
1391		1401
1392	sub merge {	1402	sub merge {
1393	my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;	1403	my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
		1404	return 0 unless $mergefrom > 0; # prevent abuse
1394	my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);	1405	my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);
1395	my $dbh=C4::Context->dbh;	1406	my $dbh=C4::Context->dbh;
1396	my $authfrom = Koha::Authorities->find($mergefrom);	1407	my $authfrom = Koha::Authorities->find($mergefrom);
1397	my $authto = Koha::Authorities->find($mergeto);	1408	my $authto = Koha::Authorities->find($mergeto);
1398	my $authtypefrom = Koha::Authority::Types->find($authfrom->authtypecode);	1409	my $authtypefrom = $authfrom ? Koha::Authority::Types->find($authfrom->authtypecode) : undef;
1399	my $authtypeto = Koha::Authority::Types->find($authto->authtypecode);	1410	my $authtypeto = $authto ? Koha::Authority::Types->find($authto->authtypecode) : undef;
1400		1411
1401	return "error MARCFROM not a marcrecord ".Data::Dumper::Dumper($MARCfrom) if scalar($MARCfrom->fields()) == 0;
1402	return "error MARCTO not a marcrecord".Data::Dumper::Dumper($MARCto) if scalar($MARCto->fields()) == 0;
1403	# search the tag to report	1412	# search the tag to report
1404	my $auth_tag_to_report_from = $authtypefrom->auth_tag_to_report;	1413	my $auth_tag_to_report_from = $authtypefrom ? $authtypefrom->auth_tag_to_report : '';
1405	my $auth_tag_to_report_to = $authtypeto->auth_tag_to_report;	1414	my $auth_tag_to_report_to = $authtypeto ? $authtypeto->auth_tag_to_report : '';
1406		1415
1407	my @record_to;	1416	my @record_to;
1408	@record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to);	1417	@record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $auth_tag_to_report_to && $MARCto && $MARCto->field($auth_tag_to_report_to);
1409	my @record_from;	1418	my @record_from;
1410	@record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);	1419	@record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $auth_tag_to_report_from && $MARCfrom && $MARCfrom->field($auth_tag_to_report_from);
1411		1420
1412	my @reccache;	1421	my @reccache;
1413	# search all biblio tags using this authority.	1422	# search all biblio tags using this authority.
Lines 1440-1449 sub merge { Link Here
1440	$oResult->destroy();	1449	$oResult->destroy();
1441	# Get All candidate Tags for the change	1450	# Get All candidate Tags for the change
1442	# (This will reduce the search scope in marc records).	1451	# (This will reduce the search scope in marc records).
		1452	# For a deleted authority record, we scan all auth controlled fields
1443	my $sql = "SELECT DISTINCT tagfield FROM marc_subfield_structure WHERE authtypecode=?";	1453	my $sql = "SELECT DISTINCT tagfield FROM marc_subfield_structure WHERE authtypecode=?";
1444	my $tags_using_authtype = $dbh->selectcol_arrayref( $sql, undef, ( $authtypefrom->authtypecode ));	1454	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<>''" );
1445	my $tags_new;	1455	my $tags_new;
1446	if ($authtypeto->authtypecode ne $authtypefrom->authtypecode){	1456	if( $authtypefrom && $authtypeto && $authtypeto->authtypecode ne $authtypefrom->authtypecode ) {
1447	$tags_new = $dbh->selectcol_arrayref( $sql, undef, ( $authtypeto->authtypecode ));	1457	$tags_new = $dbh->selectcol_arrayref( $sql, undef, ( $authtypeto->authtypecode ));
1448	}	1458	}
1449		1459
Lines 1466-1473 sub merge { Link Here
1466	my $tag = $field->tag();	1476	my $tag = $field->tag();
1467	next if !defined($auth_number) \|\| $auth_number ne $mergefrom;	1477	next if !defined($auth_number) \|\| $auth_number ne $mergefrom;
1468	$countfrom++;	1478	$countfrom++;
1469	if ( $overwrite && $countfrom > 1 ) {	1479	if ( !$mergeto \|\| ( $overwrite && $countfrom > 1 ) ) {
1470	# remove this duplicate in strict mode	1480	# if mergeto is missing, this indicates a delete
		1481	# Or: remove this duplicate in strict mode
1471	$marcrecord->delete_field($field);	1482	$marcrecord->delete_field($field);
1472	$update = 1;	1483	$update = 1;
1473	next;	1484	next;