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

(-)a/C4/AuthoritiesMarc.pm (-37 / +38 lines)
Lines 28-33 use C4::Charset; Link Here
28
use C4::Log;
28
use C4::Log;
29
use Koha::MetadataRecord::Authority;
29
use Koha::MetadataRecord::Authority;
30
use Koha::Authorities;
30
use Koha::Authorities;
31
use Koha::Authority::MergeRequest;
31
use Koha::Authority::Types;
32
use Koha::Authority::Types;
32
use Koha::Authority;
33
use Koha::Authority;
33
use Koha::SearchEngine;
34
use Koha::SearchEngine;
Lines 691-704 Deletes $authid and calls merge to cleanup in linked biblio records Link Here
691
sub DelAuthority {
692
sub DelAuthority {
692
    my ($authid) = @_;
693
    my ($authid) = @_;
693
    my $dbh=C4::Context->dbh;
694
    my $dbh=C4::Context->dbh;
694
695
    merge({ mergefrom => $authid, MARCfrom => GetAuthority($authid) });
695
    unless( C4::Context->preference('dontmerge') eq '1' ) {
696
        &merge({ mergefrom => $authid, MARCfrom => 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
    $dbh->do( "DELETE FROM auth_header WHERE authid=?", undef, $authid );
703
    logaction( "AUTHORITIES", "DELETE", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog");
697
    logaction( "AUTHORITIES", "DELETE", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog");
704
    ModZebra( $authid, "recordDelete", "authorityserver", undef);
698
    ModZebra( $authid, "recordDelete", "authorityserver", undef);
Lines 713-739 Modifies authority record, optionally updates attached biblios. Link Here
713
=cut
707
=cut
714
708
715
sub ModAuthority {
709
sub ModAuthority {
716
  my ($authid,$record,$authtypecode)=@_; # deprecated $merge parameter removed
710
    my ( $authid, $record, $authtypecode ) = @_;
717
711
    my $oldrecord = GetAuthority($authid);
718
  my $dbh=C4::Context->dbh;
712
    #Now rewrite the $record to table with an add
719
  #Now rewrite the $record to table with an add
713
    $authid = AddAuthority($record, $authid, $authtypecode);
720
  my $oldrecord=GetAuthority($authid);
714
    merge({ mergefrom => $authid, MARCfrom => $oldrecord, mergeto => $authid, MARCto => $record });
721
  $authid=AddAuthority($record,$authid,$authtypecode);
715
    logaction( "AUTHORITIES", "MODIFY", $authid, "authority BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog");
722
716
    return $authid;
723
  # If a library thinks that updating all biblios is a long process and wishes
724
  # to leave that to a cron job, use misc/migration_tools/merge_authority.pl.
725
  # In that case set system preference "dontmerge" to 1. Otherwise biblios will
726
  # be updated.
727
  unless(C4::Context->preference('dontmerge') eq '1'){
728
      &merge({ mergefrom => $authid, MARCfrom => $oldrecord, mergeto => $authid, MARCto => $record });
729
  } else {
730
      # save a record in need_merge_authorities table
731
      my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) ".
732
	"VALUES (?,?)";
733
      $dbh->do($sqlinsert,undef,($authid,0));
734
  }
735
  logaction( "AUTHORITIES", "MODIFY", $authid, "authority BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog");
736
  return $authid;
737
}
717
}
738
718
739
=head2 GetAuthorityXML 
719
=head2 GetAuthorityXML 
Lines 1394-1399 sub AddAuthorityTrees{ Link Here
1394
        [ mergeto => $mergeto, ]
1374
        [ mergeto => $mergeto, ]
1395
        [ MARCto => $MARCto, ]
1375
        [ MARCto => $MARCto, ]
1396
        [ biblionumbers => [ $a, $b, $c ], ]
1376
        [ biblionumbers => [ $a, $b, $c ], ]
1377
        [ override_limit => 1, ]
1397
    });
1378
    });
1398
1379
1399
Merge biblios linked to authority $mergefrom.
1380
Merge biblios linked to authority $mergefrom.
Lines 1404-1409 If $mergeto is missing, the biblio field is deleted. Link Here
1404
Normally all biblio records linked to $mergefrom, will be considered. But
1385
Normally all biblio records linked to $mergefrom, will be considered. But
1405
you can pass specific numbers via the biblionumbers parameter.
1386
you can pass specific numbers via the biblionumbers parameter.
1406
1387
1388
The parameter override_limit is used by the cron job to force larger
1389
postponed merges.
1390
1407
Note: Although $mergefrom and $mergeto will normally be of the same
1391
Note: Although $mergefrom and $mergeto will normally be of the same
1408
authority type, merge also supports moving to another authority type.
1392
authority type, merge also supports moving to another authority type.
1409
1393
Lines 1415-1434 sub merge { Link Here
1415
    my $MARCfrom = $params->{MARCfrom};
1399
    my $MARCfrom = $params->{MARCfrom};
1416
    my $mergeto = $params->{mergeto};
1400
    my $mergeto = $params->{mergeto};
1417
    my $MARCto = $params->{MARCto};
1401
    my $MARCto = $params->{MARCto};
1418
    my @biblionumbers = $params->{biblionumbers}
1402
    my $override_limit = $params->{override_limit};
1419
        # If we do not have biblionumbers, we get all linked biblios
1403
1420
        ? @{ $params->{biblionumbers} }
1404
    # If we do not have biblionumbers, we get all linked biblios if the
1421
        : Koha::Authorities->linked_biblionumbers({ authid => $mergefrom });
1405
    # number of linked records does not exceed the limit UNLESS we override.
1406
    my @biblionumbers;
1407
    if( $params->{biblionumbers} ) {
1408
        @biblionumbers = @{ $params->{biblionumbers} };
1409
    } elsif( $override_limit ) {
1410
        @biblionumbers = Koha::Authorities->linked_biblionumbers({ authid => $mergefrom });
1411
    } else { # now first check number of linked records
1412
        my $max = C4::Context->preference('AuthorityMergeLimit') // 0;
1413
        my $hits = Koha::Authorities->get_usage_count({ authid => $mergefrom });
1414
        if( $hits > 0 && $hits <= $max ) {
1415
            @biblionumbers = Koha::Authorities->linked_biblionumbers({ authid => $mergefrom });
1416
        } elsif( $hits > $max ) { #postpone this merge to the cron job
1417
            Koha::Authority::MergeRequest->new({
1418
                authid => $mergefrom,
1419
                oldrecord => $MARCfrom,
1420
                authid_new => $mergeto,
1421
            })->store;
1422
        }
1423
    }
1422
    return 0 if !@biblionumbers;
1424
    return 0 if !@biblionumbers;
1423
1425
1424
    my $counteditedbiblio = 0;
1426
    # Search authtypes and reporting tags
1425
    my $dbh = C4::Context->dbh;
1426
    my $authfrom = Koha::Authorities->find($mergefrom);
1427
    my $authfrom = Koha::Authorities->find($mergefrom);
1427
    my $authto = Koha::Authorities->find($mergeto);
1428
    my $authto = Koha::Authorities->find($mergeto);
1428
    my $authtypefrom = $authfrom ? Koha::Authority::Types->find($authfrom->authtypecode) : undef;
1429
    my $authtypefrom = $authfrom ? Koha::Authority::Types->find($authfrom->authtypecode) : undef;
1429
    my $authtypeto   = $authto ? Koha::Authority::Types->find($authto->authtypecode) : undef;
1430
    my $authtypeto   = $authto ? Koha::Authority::Types->find($authto->authtypecode) : undef;
1430
1431
    # search the tag to report
1432
    my $auth_tag_to_report_from = $authtypefrom ? $authtypefrom->auth_tag_to_report : '';
1431
    my $auth_tag_to_report_from = $authtypefrom ? $authtypefrom->auth_tag_to_report : '';
1433
    my $auth_tag_to_report_to   = $authtypeto ? $authtypeto->auth_tag_to_report : '';
1432
    my $auth_tag_to_report_to   = $authtypeto ? $authtypeto->auth_tag_to_report : '';
1434
1433
Lines 1440-1445 sub merge { Link Here
1440
    # Get All candidate Tags for the change 
1439
    # Get All candidate Tags for the change 
1441
    # (This will reduce the search scope in marc records).
1440
    # (This will reduce the search scope in marc records).
1442
    # For a deleted authority record, we scan all auth controlled fields
1441
    # For a deleted authority record, we scan all auth controlled fields
1442
    my $dbh = C4::Context->dbh;
1443
    my $sql = "SELECT DISTINCT tagfield FROM marc_subfield_structure WHERE authtypecode=?";
1443
    my $sql = "SELECT DISTINCT tagfield FROM marc_subfield_structure WHERE authtypecode=?";
1444
    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<>''" );
1444
    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;
1445
    my $tags_new;
Lines 1457-1462 sub merge { Link Here
1457
    # And we need to add $9 in order not to duplicate
1457
    # And we need to add $9 in order not to duplicate
1458
    $skip_subfields->{9} = 1 if !$overwrite;
1458
    $skip_subfields->{9} = 1 if !$overwrite;
1459
1459
1460
    my $counteditedbiblio = 0;
1460
    foreach my $biblionumber ( @biblionumbers ) {
1461
    foreach my $biblionumber ( @biblionumbers ) {
1461
        my $marcrecord = GetMarcBiblio( $biblionumber );
1462
        my $marcrecord = GetMarcBiblio( $biblionumber );
1462
        next if !$marcrecord;
1463
        next if !$marcrecord;
(-)a/misc/migration_tools/merge_authority.pl (-9 / +10 lines)
Lines 15-20 use C4::Context; Link Here
15
use C4::Search;
15
use C4::Search;
16
use C4::Biblio;
16
use C4::Biblio;
17
use C4::AuthoritiesMarc;
17
use C4::AuthoritiesMarc;
18
use Koha::Authorities;
19
use Koha::Authority::MergeRequests;
18
use Time::HiRes qw(gettimeofday);
20
use Time::HiRes qw(gettimeofday);
19
21
20
use Getopt::Long;
22
use Getopt::Long;
Lines 80-95 print "Merging\n" unless $noconfirm; Link Here
80
if ($batch) {
82
if ($batch) {
81
  my $authref;
83
  my $authref;
82
  $dbh->do("update need_merge_authorities set done=2 where done=0"); #temporary status 2 means: selected for merge
84
  $dbh->do("update need_merge_authorities set done=2 where done=0"); #temporary status 2 means: selected for merge
83
  $authref=$dbh->selectall_arrayref("select distinct authid from need_merge_authorities where done=2");
85
  $authref=$dbh->selectall_arrayref("select id,authid,authid_new from need_merge_authorities where done=2");
84
  foreach(@$authref) {
86
  foreach my $row ( @$authref ) {
85
      my $authid=$_->[0];
87
      my $req = Koha::Authority::MergeRequests->find( $row->[0] );
88
      my $marc = $req ? $req->oldmarc : undef;
89
      my $authid = $row->[1];
90
      my $authid_new = $row->[2];
86
      print "managing $authid\n" if $verbose;
91
      print "managing $authid\n" if $verbose;
87
      my $MARCauth = GetAuthority( $authid );
92
      # Following merge call handles both modifications and deletes
88
      if( $MARCauth ) {
93
      merge({ mergefrom => $authid, MARCfrom => $marc, mergeto => $authid_new, MARCto => GetAuthority($authid_new), override_limit => 1 });
89
          merge({ mergefrom => $authid, MARCfrom => $MARCauth, mergeto => $authid, MARCto => $MARCauth });
90
      } else {
91
          merge({ mergefrom => $authid }); # handle a delete
92
      }
93
  }
94
  }
94
  $dbh->do("update need_merge_authorities set done=1 where done=2"); #DONE
95
  $dbh->do("update need_merge_authorities set done=1 where done=2"); #DONE
95
} else {
96
} else {
(-)a/t/db_dependent/Authorities/Merge.t (-8 / +38 lines)
Lines 4-10 Link Here
4
4
5
use Modern::Perl;
5
use Modern::Perl;
6
6
7
use Test::More tests => 5;
7
use Test::More tests => 6;
8
8
9
use Getopt::Long;
9
use Getopt::Long;
10
use MARC::Record;
10
use MARC::Record;
Lines 15-20 use t::lib::TestBuilder; Link Here
15
15
16
use C4::Biblio;
16
use C4::Biblio;
17
use Koha::Authorities;
17
use Koha::Authorities;
18
use Koha::Authority::MergeRequests;
18
use Koha::Database;
19
use Koha::Database;
19
20
20
BEGIN {
21
BEGIN {
Lines 34-39 our @linkedrecords; Link Here
34
my $mocks = set_mocks();
35
my $mocks = set_mocks();
35
our ( $authtype1, $authtype2 ) = modify_framework();
36
our ( $authtype1, $authtype2 ) = modify_framework();
36
37
38
subtest 'Test postponed merge feature' => sub {
39
    plan tests => 6;
40
41
    # Set limit to zero, and call merge a few times
42
    t::lib::Mocks::mock_preference('AuthorityMergeLimit', 0);
43
    my $auth1 = t::lib::TestBuilder->new->build({ source => 'AuthHeader' });
44
    my $cnt = Koha::Authority::MergeRequests->count;
45
    merge({ mergefrom => '0' });
46
    is( Koha::Authority::MergeRequests->count, $cnt, 'No merge request added as expected' );
47
    merge({ mergefrom => $auth1->{authid} });
48
    is( Koha::Authority::MergeRequests->count, $cnt, 'No merge request added since we have zero hits' );
49
    @linkedrecords = ( 1, 2 ); # these biblionumbers do not matter
50
    merge({ mergefrom => $auth1->{authid} });
51
    is( Koha::Authority::MergeRequests->count, $cnt + 1, 'Merge request added as expected' );
52
53
    # Set limit to two (starting with two records)
54
    t::lib::Mocks::mock_preference('AuthorityMergeLimit', 2);
55
    merge({ mergefrom => $auth1->{authid} });
56
    is( Koha::Authority::MergeRequests->count, $cnt + 1, 'No merge request added as we do not exceed the limit' );
57
    @linkedrecords = ( 1, 2, 3 ); # these biblionumbers do not matter
58
    merge({ mergefrom => $auth1->{authid} });
59
    is( Koha::Authority::MergeRequests->count, $cnt + 2, 'Merge request added as we do exceed the limit again' );
60
    # Now override
61
    merge({ mergefrom => $auth1->{authid}, override_limit => 1 });
62
    is( Koha::Authority::MergeRequests->count, $cnt + 2, 'No merge request added as we did override' );
63
64
    # Set merge limit high enough for the other subtests
65
    t::lib::Mocks::mock_preference('AuthorityMergeLimit', 1000);
66
};
67
37
subtest 'Test merge A1 to A2 (within same authtype)' => sub {
68
subtest 'Test merge A1 to A2 (within same authtype)' => sub {
38
# Tests originate from bug 11700
69
# Tests originate from bug 11700
39
    plan tests => 9;
70
    plan tests => 9;
Lines 215-223 subtest 'Test merge A1 to B1 (changing authtype)' => sub { Link Here
215
subtest 'Merging authorities should handle deletes (BZ 18070)' => sub {
246
subtest 'Merging authorities should handle deletes (BZ 18070)' => sub {
216
    plan tests => 2;
247
    plan tests => 2;
217
248
218
    # For this test we need dontmerge OFF
219
    t::lib::Mocks::mock_preference('dontmerge', '0');
220
221
    # Add authority and linked biblio, delete authority
249
    # Add authority and linked biblio, delete authority
222
    my $auth1 = MARC::Record->new;
250
    my $auth1 = MARC::Record->new;
223
    $auth1->append_fields( MARC::Field->new( '109', '', '', 'a' => 'DEL'));
251
    $auth1->append_fields( MARC::Field->new( '109', '', '', 'a' => 'DEL'));
Lines 235-241 subtest 'Merging authorities should handle deletes (BZ 18070)' => sub { Link Here
235
    my $marc1 = C4::Biblio::GetMarcBiblio( $biblionumber );
263
    my $marc1 = C4::Biblio::GetMarcBiblio( $biblionumber );
236
    is( $marc1->field('609'), undef, 'Field 609 should be gone too' );
264
    is( $marc1->field('609'), undef, 'Field 609 should be gone too' );
237
265
238
    # Now we simulate the delete as done from the cron job (with dontmerge)
266
    # Now we simulate the delete as done in the cron job
239
    # First, restore auth1 and add 609 back in bib1
267
    # First, restore auth1 and add 609 back in bib1
240
    $auth1 = MARC::Record->new;
268
    $auth1 = MARC::Record->new;
241
    $auth1->append_fields( MARC::Field->new( '109', '', '', 'a' => 'DEL'));
269
    $auth1->append_fields( MARC::Field->new( '109', '', '', 'a' => 'DEL'));
Lines 247-253 subtest 'Merging authorities should handle deletes (BZ 18070)' => sub { Link Here
247
    # Instead of going through DelAuthority, we manually delete the auth
275
    # Instead of going through DelAuthority, we manually delete the auth
248
    # record and call merge afterwards.
276
    # record and call merge afterwards.
249
    # This mimics deleting an authority and calling merge later in the
277
    # This mimics deleting an authority and calling merge later in the
250
    # merge_authority.pl cron job (when dontmerge is enabled).
278
    # merge_authority.pl cron job.
251
    # We use the biblionumbers parameter here and unmock linked_biblionumbers.
279
    # We use the biblionumbers parameter here and unmock linked_biblionumbers.
252
    C4::Context->dbh->do( "DELETE FROM auth_header WHERE authid=?", undef, $authid1 );
280
    C4::Context->dbh->do( "DELETE FROM auth_header WHERE authid=?", undef, $authid1 );
253
    @linkedrecords = ();
281
    @linkedrecords = ();
Lines 260-269 subtest 'Merging authorities should handle deletes (BZ 18070)' => sub { Link Here
260
288
261
sub set_mocks {
289
sub set_mocks {
262
    # After we removed the Zebra code from merge, we only need to mock
290
    # After we removed the Zebra code from merge, we only need to mock
263
    # linked_biblionumbers here.
291
    # get_usage_count and linked_biblionumbers here.
264
292
265
    my $mocks;
293
    my $mocks;
266
    $mocks->{auth_mod} = Test::MockModule->new( 'Koha::Authorities' );
294
    $mocks->{auth_mod} = Test::MockModule->new( 'Koha::Authorities' );
295
    $mocks->{auth_mod}->mock( 'get_usage_count', sub {
296
         return scalar @linkedrecords;
297
    });
267
    $mocks->{auth_mod}->mock( 'linked_biblionumbers', sub {
298
    $mocks->{auth_mod}->mock( 'linked_biblionumbers', sub {
268
         return @linkedrecords;
299
         return @linkedrecords;
269
    });
300
    });
270
- 

Return to bug 9988