Attachment #62129 for bug #9988

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





=head2 DelAuthority

    DelAuthority({ authid => $authid });

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

=cut

sub DelAuthority {
    my ( $params ) = @_;
    my $authid = $params->{authid} || return;
    my $dbh=C4::Context->dbh;

    unless( C4::Context->preference('dontmerge') eq '1' ) {
        &merge({ mergefrom => $authid, MARCfrom => GetAuthority($authid) });
    } else {
        # save a record in need_merge_authorities table
        my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) VALUES (?,?)";

  # In that case set system preference "dontmerge" to 1. Otherwise biblios will
  # be updated.
  unless(C4::Context->preference('dontmerge') eq '1'){
      &merge({ mergefrom => $authid, MARCfrom => $oldrecord, mergeto => $authid, MARCto => $record });
  } else {
      # save a record in need_merge_authorities table
      my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) ".


=head2 merge

    $count = merge({
        mergefrom => mergefrom,
        MARCfrom => $MARCfrom,
        [ mergeto => $mergeto, ]
        [ MARCto => $MARCto, ]
    });

Merge biblios linked to authority $mergefrom.
If $mergeto equals mergefrom, the linked biblio field is updated.

=cut

sub merge {
    my ( $params ) = @_;
    my $mergefrom = $params->{mergefrom};
    my $MARCfrom = $params->{MARCfrom};
    my $mergeto = $params->{mergeto};
    my $MARCto = $params->{MARCto};

    return 0 unless $mergefrom > 0; # prevent abuse
    my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);        
    my $dbh=C4::Context->dbh;

Lines 852-858 sub BatchRevertRecords { Link Here

(-)a/C4/ImportBatch.pm (-1 / +1 lines)
852	$num_items_deleted += BatchRevertItems($rowref->{'import_record_id'}, $rowref->{'matched_biblionumber'});	852	$num_items_deleted += BatchRevertItems($rowref->{'import_record_id'}, $rowref->{'matched_biblionumber'});
853	$error = DelBiblio($rowref->{'matched_biblionumber'});	853	$error = DelBiblio($rowref->{'matched_biblionumber'});
854	} else {	854	} else {
855	DelAuthority( $rowref->{'matched_authid'} );	855	DelAuthority({ authid => $rowref->{'matched_authid'} });
856	}	856	}
857	if (defined $error) {	857	if (defined $error) {
858	$num_errors++;	858	$num_errors++;

Lines 65-71 if ( $op eq "delete" ) { Link Here

(-)a/authorities/authorities-home.pl (-1 / +1 lines)
65	token => scalar $query->param('csrf_token'),	65	token => scalar $query->param('csrf_token'),
66	});	66	});
67		67
68	&DelAuthority( $authid, 1 );	68	DelAuthority({ authid => $authid });
69		69
70	if ( $query->param('operator') ) {	70	if ( $query->param('operator') ) {
71	# query contains search params so perform search	71	# query contains search params so perform search

Lines 641-647 if ($op eq "add") { Link Here

(-)a/authorities/authorities.pl (-1 / +1 lines)
641	}	641	}
642	} elsif ($op eq "delete") {	642	} elsif ($op eq "delete") {
643	#------------------------------------------------------------------------------------------------------------------------------	643	#------------------------------------------------------------------------------------------------------------------------------
644	&DelAuthority($authid);	644	DelAuthority({ authid => $authid });
645	if ($nonav){	645	if ($nonav){
646	print $input->redirect("auth_finder.pl");	646	print $input->redirect("auth_finder.pl");
647	}else{	647	}else{

Lines 64-73 if ($merge) { Link Here

(-)a/authorities/merge.pl (-2 / +2 lines)
64	# Now merge for biblios attached to $recordid2	64	# Now merge for biblios attached to $recordid2
65	# We ignore dontmerge now, since recordid2 is deleted	65	# We ignore dontmerge now, since recordid2 is deleted
66	my $MARCfrom = GetAuthority( $recordid2 );	66	my $MARCfrom = GetAuthority( $recordid2 );
67	merge( $recordid2, $MARCfrom, $recordid1, $record );	67	merge({ mergefrom => $recordid2, MARCfrom => $MARCfrom, mergeto => $recordid1, MARCto => $record });
68		68
69	# Deleting the other record	69	# Deleting the other record
70	DelAuthority( $recordid2 );	70	DelAuthority({ authid => $recordid2 });
71		71
72	# Parameters	72	# Parameters
73	$template->param(	73	$template->param(




      print "managing $authid\n" if $verbose;
      my $MARCauth = GetAuthority( $authid );
      if( $MARCauth ) {
          merge({ mergefrom => $authid, MARCfrom => $MARCauth, mergeto => $authid, MARCto => $MARCauth });
      } else {
          merge({ mergefrom => $authid }); # handle a delete
      }
  }
  $dbh->do("update need_merge_authorities set done=1 where done=2"); #DONE
} else {
  my $MARCfrom = GetAuthority($mergefrom);
  my $MARCto = GetAuthority($mergeto);
  &merge({ mergefrom => $mergefrom, MARCfrom => $MARCfrom, mergeto => $mergeto, MARCto => $MARCto });
  #Could add mergefrom authority to mergeto rejected forms before deletion 
  DelAuthority({ authid => $mergefrom }) if ($mergefrom != $mergeto);
}
my $timeneeded = gettimeofday - $starttime;
print "Done in $timeneeded seconds" unless $noconfirm;

Lines 82-88 while (my $data=$rqselect->fetchrow_hashref){ Link Here

(-)a/misc/migration_tools/remove_unused_authorities.pl (-1 / +1 lines)
82	print "$counter\n" unless $counter++ % 100;	82	print "$counter\n" unless $counter++ % 100;
83	# if found, delete, otherwise, just count	83	# if found, delete, otherwise, just count
84	if ($used>=$thresholdmin and $used<=$thresholdmax){	84	if ($used>=$thresholdmin and $used<=$thresholdmax){
85	DelAuthority($data->{'authid'}) unless $test;	85	DelAuthority({ authid => $data->{'authid'} }) unless $test;
86	$totdeleted++;	86	$totdeleted++;
87	} else {	87	} else {
88	$totundeleted++;	88	$totundeleted++;




    # Time to merge
    @zebrarecords = ( $biblio1, $biblio2 );
    $index = 0;
    my $rv = C4::AuthoritiesMarc::merge({ mergefrom => $authid2, MARCfrom => $auth2, mergeto => $authid1, MARCto => $auth1 });
    is( $rv, 1, 'We expect one biblio record (out of two) to be updated' );

    # Check the results

    @zebrarecords = ( $MARC1, $MARC2 );
    $index = 0;
    t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose');
    my $rv = C4::AuthoritiesMarc::merge({ mergefrom => $authid1, MARCfrom => $auth1old, mergeto => $authid1, MARCto => $auth1new });
    is( $rv, 2, 'Both records are updated now' );

    #Check the results

    ModBiblio( $MARC1, $biblionumber1, '' );
    @zebrarecords = ( $MARC1 );
    $index = 0;
    $rv = C4::AuthoritiesMarc::merge({ mergefrom => $authid1, MARCfrom => $auth1old, mergeto => $authid1, MARCto => $auth1new });
    $biblio1 = GetMarcBiblio($biblionumber1);
    is( $biblio1->field(109)->subfield('b'), undef, 'Subfield overwritten in strict mode' );
    compare_fields( $MARC1, $biblio1, { 609 => 1 }, 'count' );

    # Time to merge
    @zebrarecords = ( $marc );
    $index = 0;
    my $retval = C4::AuthoritiesMarc::merge({ mergefrom => $authid1, MARCfrom => $auth1, mergeto => $authid2, MARCto => $auth2 });
    is( $retval, 1, 'We touched only one biblio' );

    # Get new marc record for compares

    my ( $biblionumber ) = C4::Biblio::AddBiblio( $bib1, '' );
    @zebrarecords = ( $bib1 );
    $index = 0;
    DelAuthority({ authid => $authid1 }); # this triggers a merge call

    # See what happened in the biblio record
    my $marc1 = C4::Biblio::GetMarcBiblio( $biblionumber );

    C4::Context->dbh->do( "DELETE FROM auth_header WHERE authid=?", undef, $authid1 );
    @zebrarecords = ( $marc1 );
    $index = 0;
    merge({ mergefrom => $authid1 });
    # Final check
    $marc1 = C4::Biblio::GetMarcBiblio( $biblionumber );
    is( $marc1->field('609'), undef, 'Merge removed the 609 again even after deleting the authority record' );

Lines 197-203 subtest 'AddAuthority should respect AUTO_INCREMENT (BZ 18104)' => sub { Link Here

(-)a/t/db_dependent/AuthoritiesMarc.t (-1 / +1 lines)
197	t::lib::Mocks::mock_preference( 'marcflavour', 'MARC21' );	197	t::lib::Mocks::mock_preference( 'marcflavour', 'MARC21' );
198	my $record = C4::AuthoritiesMarc::GetAuthority(1);	198	my $record = C4::AuthoritiesMarc::GetAuthority(1);
199	my $id1 = AddAuthority( $record, undef, 'GEOGR_NAME' );	199	my $id1 = AddAuthority( $record, undef, 'GEOGR_NAME' );
200	DelAuthority( $id1 );	200	DelAuthority({ authid => $id1 });
201	my $id2 = AddAuthority( $record, undef, 'GEOGR_NAME' );	201	my $id2 = AddAuthority( $record, undef, 'GEOGR_NAME' );
202	isnt( $id1, $id2, 'Do not return the same id again' );	202	isnt( $id1, $id2, 'Do not return the same id again' );
203	t::lib::Mocks::mock_preference( 'marcflavour', 'UNIMARC' );	203	t::lib::Mocks::mock_preference( 'marcflavour', 'UNIMARC' );

Lines 204-210 if ( $op eq 'form' ) { Link Here

(-)a/tools/batch_delete_records.pl (-2 / +1 lines)
204	} else {	204	} else {
205	# Authorities	205	# Authorities
206	my $authid = $record_id;	206	my $authid = $record_id;
207	eval { C4::AuthoritiesMarc::DelAuthority( $authid ) };	207	eval { C4::AuthoritiesMarc::DelAuthority({ authid => $authid }) };
208	if ( $@ ) {	208	if ( $@ ) {
209	push @messages, {	209	push @messages, {
210	type => 'error',	210	type => 'error',
211	-

Return to bug 9988

Lines 682-699 sub AddAuthority { Link Here

(-)a/C4/AuthoritiesMarc.pm (-6 / +17 lines)
682		682
683	=head2 DelAuthority	683	=head2 DelAuthority
684		684
685	DelAuthority( $authid )	685	DelAuthority({ authid => $authid });
686		686
687	Deletes $authid and calls merge to cleanup in linked biblio records	687	Deletes $authid and calls merge to cleanup in linked biblio records
688		688
689	=cut	689	=cut
690		690
691	sub DelAuthority {	691	sub DelAuthority {
692	my ($authid) = @_;	692	my ( $params ) = @_;
		693	my $authid = $params->{authid} \|\| return;
693	my $dbh=C4::Context->dbh;	694	my $dbh=C4::Context->dbh;
694		695
695	unless( C4::Context->preference('dontmerge') eq '1' ) {	696	unless( C4::Context->preference('dontmerge') eq '1' ) {
696	&merge( $authid, GetAuthority($authid) );	697	&merge({ mergefrom => $authid, MARCfrom => GetAuthority($authid) });
697	} else {	698	} else {
698	# save a record in need_merge_authorities table	699	# save a record in need_merge_authorities table
699	my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) VALUES (?,?)";	700	my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) VALUES (?,?)";
Lines 725-731 sub ModAuthority { Link Here
725	# In that case set system preference "dontmerge" to 1. Otherwise biblios will	726	# In that case set system preference "dontmerge" to 1. Otherwise biblios will
726	# be updated.	727	# be updated.
727	unless(C4::Context->preference('dontmerge') eq '1'){	728	unless(C4::Context->preference('dontmerge') eq '1'){
728	&merge($authid,$oldrecord,$authid,$record);	729	&merge({ mergefrom => $authid, MARCfrom => $oldrecord, mergeto => $authid, MARCto => $record });
729	} else {	730	} else {
730	# save a record in need_merge_authorities table	731	# save a record in need_merge_authorities table
731	my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) ".	732	my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) ".
Lines 1388-1394 sub AddAuthorityTrees{ Link Here
1388		1389
1389	=head2 merge	1390	=head2 merge
1390		1391
1391	$count = merge ( mergefrom, $MARCfrom, [$mergeto, $MARCto] )	1392	$count = merge({
		1393	mergefrom => mergefrom,
		1394	MARCfrom => $MARCfrom,
		1395	[ mergeto => $mergeto, ]
		1396	[ MARCto => $MARCto, ]
		1397	});
1392		1398
1393	Merge biblios linked to authority $mergefrom.	1399	Merge biblios linked to authority $mergefrom.
1394	If $mergeto equals mergefrom, the linked biblio field is updated.	1400	If $mergeto equals mergefrom, the linked biblio field is updated.
Lines 1401-1407 authority type, merge also supports moving to another authority type. Link Here
1401	=cut	1407	=cut
1402		1408
1403	sub merge {	1409	sub merge {
1404	my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;	1410	my ( $params ) = @_;
		1411	my $mergefrom = $params->{mergefrom};
		1412	my $MARCfrom = $params->{MARCfrom};
		1413	my $mergeto = $params->{mergeto};
		1414	my $MARCto = $params->{MARCto};
		1415
1405	return 0 unless $mergefrom > 0; # prevent abuse	1416	return 0 unless $mergefrom > 0; # prevent abuse
1406	my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);	1417	my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);
1407	my $dbh=C4::Context->dbh;	1418	my $dbh=C4::Context->dbh;

Lines 86-103 if ($batch) { Link Here

(-)a/misc/migration_tools/merge_authority.pl (-4 / +4 lines)
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	if( $MARCauth ) {	88	if( $MARCauth ) {
89	merge( $authid, $MARCauth, $authid, $MARCauth );	89	merge({ mergefrom => $authid, MARCfrom => $MARCauth, mergeto => $authid, MARCto => $MARCauth });
90	} else {	90	} else {
91	merge( $authid, undef ); # handle a delete	91	merge({ mergefrom => $authid }); # handle a delete
92	}	92	}
93	}	93	}
94	$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
95	} else {	95	} else {
96	my $MARCfrom = GetAuthority($mergefrom);	96	my $MARCfrom = GetAuthority($mergefrom);
97	my $MARCto = GetAuthority($mergeto);	97	my $MARCto = GetAuthority($mergeto);
98	&merge($mergefrom,$MARCfrom,$mergeto,$MARCto);	98	&merge({ mergefrom => $mergefrom, MARCfrom => $MARCfrom, mergeto => $mergeto, MARCto => $MARCto });
99	#Could add mergefrom authority to mergeto rejected forms before deletion	99	#Could add mergefrom authority to mergeto rejected forms before deletion
100	DelAuthority($mergefrom) if ($mergefrom != $mergeto);	100	DelAuthority({ authid => $mergefrom }) if ($mergefrom != $mergeto);
101	}	101	}
102	my $timeneeded = gettimeofday - $starttime;	102	my $timeneeded = gettimeofday - $starttime;
103	print "Done in $timeneeded seconds" unless $noconfirm;	103	print "Done in $timeneeded seconds" unless $noconfirm;

Lines 60-66 subtest 'Test merge A1 to A2 (within same authtype)' => sub { Link Here

(-)a/t/db_dependent/Authorities/Merge.t (-6 / +6 lines)
60	# Time to merge	60	# Time to merge
61	@zebrarecords = ( $biblio1, $biblio2 );	61	@zebrarecords = ( $biblio1, $biblio2 );
62	$index = 0;	62	$index = 0;
63	my $rv = C4::AuthoritiesMarc::merge( $authid2, $auth2, $authid1, $auth1 );	63	my $rv = C4::AuthoritiesMarc::merge({ mergefrom => $authid2, MARCfrom => $auth2, mergeto => $authid1, MARCto => $auth1 });
64	is( $rv, 1, 'We expect one biblio record (out of two) to be updated' );	64	is( $rv, 1, 'We expect one biblio record (out of two) to be updated' );
65		65
66	# Check the results	66	# Check the results
Lines 105-111 subtest 'Test merge A1 to modified A1, test strict mode' => sub { Link Here
105	@zebrarecords = ( $MARC1, $MARC2 );	105	@zebrarecords = ( $MARC1, $MARC2 );
106	$index = 0;	106	$index = 0;
107	t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose');	107	t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose');
108	my $rv = C4::AuthoritiesMarc::merge( $authid1, $auth1old, $authid1, $auth1new );	108	my $rv = C4::AuthoritiesMarc::merge({ mergefrom => $authid1, MARCfrom => $auth1old, mergeto => $authid1, MARCto => $auth1new });
109	is( $rv, 2, 'Both records are updated now' );	109	is( $rv, 2, 'Both records are updated now' );
110		110
111	#Check the results	111	#Check the results
Lines 125-131 subtest 'Test merge A1 to modified A1, test strict mode' => sub { Link Here
125	ModBiblio( $MARC1, $biblionumber1, '' );	125	ModBiblio( $MARC1, $biblionumber1, '' );
126	@zebrarecords = ( $MARC1 );	126	@zebrarecords = ( $MARC1 );
127	$index = 0;	127	$index = 0;
128	$rv = C4::AuthoritiesMarc::merge( $authid1, $auth1old, $authid1, $auth1new );	128	$rv = C4::AuthoritiesMarc::merge({ mergefrom => $authid1, MARCfrom => $auth1old, mergeto => $authid1, MARCto => $auth1new });
129	$biblio1 = GetMarcBiblio($biblionumber1);	129	$biblio1 = GetMarcBiblio($biblionumber1);
130	is( $biblio1->field(109)->subfield('b'), undef, 'Subfield overwritten in strict mode' );	130	is( $biblio1->field(109)->subfield('b'), undef, 'Subfield overwritten in strict mode' );
131	compare_fields( $MARC1, $biblio1, { 609 => 1 }, 'count' );	131	compare_fields( $MARC1, $biblio1, { 609 => 1 }, 'count' );
Lines 172-178 subtest 'Test merge A1 to B1 (changing authtype)' => sub { Link Here
172	# Time to merge	172	# Time to merge
173	@zebrarecords = ( $marc );	173	@zebrarecords = ( $marc );
174	$index = 0;	174	$index = 0;
175	my $retval = C4::AuthoritiesMarc::merge( $authid1, $auth1, $authid2, $auth2 );	175	my $retval = C4::AuthoritiesMarc::merge({ mergefrom => $authid1, MARCfrom => $auth1, mergeto => $authid2, MARCto => $auth2 });
176	is( $retval, 1, 'We touched only one biblio' );	176	is( $retval, 1, 'We touched only one biblio' );
177		177
178	# Get new marc record for compares	178	# Get new marc record for compares
Lines 234-240 subtest 'Merging authorities should handle deletes (BZ 18070)' => sub { Link Here
234	my ( $biblionumber ) = C4::Biblio::AddBiblio( $bib1, '' );	234	my ( $biblionumber ) = C4::Biblio::AddBiblio( $bib1, '' );
235	@zebrarecords = ( $bib1 );	235	@zebrarecords = ( $bib1 );
236	$index = 0;	236	$index = 0;
237	DelAuthority( $authid1 ); # this triggers a merge call	237	DelAuthority({ authid => $authid1 }); # this triggers a merge call
238		238
239	# See what happened in the biblio record	239	# See what happened in the biblio record
240	my $marc1 = C4::Biblio::GetMarcBiblio( $biblionumber );	240	my $marc1 = C4::Biblio::GetMarcBiblio( $biblionumber );
Lines 256-262 subtest 'Merging authorities should handle deletes (BZ 18070)' => sub { Link Here
256	C4::Context->dbh->do( "DELETE FROM auth_header WHERE authid=?", undef, $authid1 );	256	C4::Context->dbh->do( "DELETE FROM auth_header WHERE authid=?", undef, $authid1 );
257	@zebrarecords = ( $marc1 );	257	@zebrarecords = ( $marc1 );
258	$index = 0;	258	$index = 0;
259	merge( $authid1, undef );	259	merge({ mergefrom => $authid1 });
260	# Final check	260	# Final check
261	$marc1 = C4::Biblio::GetMarcBiblio( $biblionumber );	261	$marc1 = C4::Biblio::GetMarcBiblio( $biblionumber );
262	is( $marc1->field('609'), undef, 'Merge removed the 609 again even after deleting the authority record' );	262	is( $marc1->field('609'), undef, 'Merge removed the 609 again even after deleting the authority record' );