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 692-705 sub DelAuthority { Link Here
692
    my ( $params ) = @_;
693
    my ( $params ) = @_;
693
    my $authid = $params->{authid} || return;
694
    my $authid = $params->{authid} || return;
694
    my $dbh=C4::Context->dbh;
695
    my $dbh=C4::Context->dbh;
695
696
    merge({ mergefrom => $authid, MARCfrom => GetAuthority($authid) });
696
    unless( C4::Context->preference('dontmerge') eq '1' ) {
697
        &merge({ mergefrom => $authid, MARCfrom => GetAuthority($authid) });
698
    } else {
699
        # save a record in need_merge_authorities table
700
        my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) VALUES (?,?)";
701
        $dbh->do( $sqlinsert, undef, $authid, 0 );
702
    }
703
    $dbh->do( "DELETE FROM auth_header WHERE authid=?", undef, $authid );
697
    $dbh->do( "DELETE FROM auth_header WHERE authid=?", undef, $authid );
704
    logaction( "AUTHORITIES", "DELETE", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog");
698
    logaction( "AUTHORITIES", "DELETE", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog");
705
    ModZebra( $authid, "recordDelete", "authorityserver", undef);
699
    ModZebra( $authid, "recordDelete", "authorityserver", undef);
Lines 714-740 Modifies authority record, optionally updates attached biblios. Link Here
714
=cut
708
=cut
715
709
716
sub ModAuthority {
710
sub ModAuthority {
717
  my ($authid,$record,$authtypecode)=@_; # deprecated $merge parameter removed
711
    my ( $authid, $record, $authtypecode ) = @_;
718
712
    my $oldrecord = GetAuthority($authid);
719
  my $dbh=C4::Context->dbh;
713
    #Now rewrite the $record to table with an add
720
  #Now rewrite the $record to table with an add
714
    $authid = AddAuthority($record, $authid, $authtypecode);
721
  my $oldrecord=GetAuthority($authid);
715
    merge({ mergefrom => $authid, MARCfrom => $oldrecord, mergeto => $authid, MARCto => $record });
722
  $authid=AddAuthority($record,$authid,$authtypecode);
716
    logaction( "AUTHORITIES", "MODIFY", $authid, "authority BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog");
723
717
    return $authid;
724
  # If a library thinks that updating all biblios is a long process and wishes
725
  # to leave that to a cron job, use misc/migration_tools/merge_authority.pl.
726
  # In that case set system preference "dontmerge" to 1. Otherwise biblios will
727
  # be updated.
728
  unless(C4::Context->preference('dontmerge') eq '1'){
729
      &merge({ mergefrom => $authid, MARCfrom => $oldrecord, mergeto => $authid, MARCto => $record });
730
  } else {
731
      # save a record in need_merge_authorities table
732
      my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) ".
733
	"VALUES (?,?)";
734
      $dbh->do($sqlinsert,undef,($authid,0));
735
  }
736
  logaction( "AUTHORITIES", "MODIFY", $authid, "authority BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog");
737
  return $authid;
738
}
718
}
739
719
740
=head2 GetAuthorityXML 
720
=head2 GetAuthorityXML 
Lines 1395-1400 sub AddAuthorityTrees{ Link Here
1395
        [ mergeto => $mergeto, ]
1375
        [ mergeto => $mergeto, ]
1396
        [ MARCto => $MARCto, ]
1376
        [ MARCto => $MARCto, ]
1397
        [ biblionumbers => [ $a, $b, $c ], ]
1377
        [ biblionumbers => [ $a, $b, $c ], ]
1378
        [ override_limit => 1, ]
1398
    });
1379
    });
1399
1380
1400
Merge biblios linked to authority $mergefrom.
1381
Merge biblios linked to authority $mergefrom.
Lines 1405-1410 If $mergeto is missing, the biblio field is deleted. Link Here
1405
Normally all biblio records linked to $mergefrom, will be considered. But
1386
Normally all biblio records linked to $mergefrom, will be considered. But
1406
you can pass specific numbers via the biblionumbers parameter.
1387
you can pass specific numbers via the biblionumbers parameter.
1407
1388
1389
The parameter override_limit is used by the cron job to force larger
1390
postponed merges.
1391
1408
Note: Although $mergefrom and $mergeto will normally be of the same
1392
Note: Although $mergefrom and $mergeto will normally be of the same
1409
authority type, merge also supports moving to another authority type.
1393
authority type, merge also supports moving to another authority type.
1410
1394
Lines 1416-1435 sub merge { Link Here
1416
    my $MARCfrom = $params->{MARCfrom};
1400
    my $MARCfrom = $params->{MARCfrom};
1417
    my $mergeto = $params->{mergeto};
1401
    my $mergeto = $params->{mergeto};
1418
    my $MARCto = $params->{MARCto};
1402
    my $MARCto = $params->{MARCto};
1419
    my @biblionumbers = $params->{biblionumbers}
1403
    my $override_limit = $params->{override_limit};
1420
        # If we do not have biblionumbers, we get all linked biblios
1404
1421
        ? @{ $params->{biblionumbers} }
1405
    # If we do not have biblionumbers, we get all linked biblios if the
1422
        : Koha::Authorities->linked_biblionumbers({ authid => $mergefrom });
1406
    # number of linked records does not exceed the limit UNLESS we override.
1407
    my @biblionumbers;
1408
    if( $params->{biblionumbers} ) {
1409
        @biblionumbers = @{ $params->{biblionumbers} };
1410
    } elsif( $override_limit ) {
1411
        @biblionumbers = Koha::Authorities->linked_biblionumbers({ authid => $mergefrom });
1412
    } else { # now first check number of linked records
1413
        my $max = C4::Context->preference('AuthorityMergeLimit') // 0;
1414
        my $hits = Koha::Authorities->get_usage_count({ authid => $mergefrom });
1415
        if( $hits > 0 && $hits <= $max ) {
1416
            @biblionumbers = Koha::Authorities->linked_biblionumbers({ authid => $mergefrom });
1417
        } elsif( $hits > $max ) { #postpone this merge to the cron job
1418
            Koha::Authority::MergeRequest->new({
1419
                authid => $mergefrom,
1420
                oldrecord => $MARCfrom,
1421
                authid_new => $mergeto,
1422
            })->store;
1423
        }
1424
    }
1423
    return 0 if !@biblionumbers;
1425
    return 0 if !@biblionumbers;
1424
1426
1425
    my $counteditedbiblio = 0;
1427
    # Search authtypes and reporting tags
1426
    my $dbh = C4::Context->dbh;
1427
    my $authfrom = Koha::Authorities->find($mergefrom);
1428
    my $authfrom = Koha::Authorities->find($mergefrom);
1428
    my $authto = Koha::Authorities->find($mergeto);
1429
    my $authto = Koha::Authorities->find($mergeto);
1429
    my $authtypefrom = $authfrom ? Koha::Authority::Types->find($authfrom->authtypecode) : undef;
1430
    my $authtypefrom = $authfrom ? Koha::Authority::Types->find($authfrom->authtypecode) : undef;
1430
    my $authtypeto   = $authto ? Koha::Authority::Types->find($authto->authtypecode) : undef;
1431
    my $authtypeto   = $authto ? Koha::Authority::Types->find($authto->authtypecode) : undef;
1431
1432
    # search the tag to report
1433
    my $auth_tag_to_report_from = $authtypefrom ? $authtypefrom->auth_tag_to_report : '';
1432
    my $auth_tag_to_report_from = $authtypefrom ? $authtypefrom->auth_tag_to_report : '';
1434
    my $auth_tag_to_report_to   = $authtypeto ? $authtypeto->auth_tag_to_report : '';
1433
    my $auth_tag_to_report_to   = $authtypeto ? $authtypeto->auth_tag_to_report : '';
1435
1434
Lines 1441-1446 sub merge { Link Here
1441
    # Get All candidate Tags for the change 
1440
    # Get All candidate Tags for the change 
1442
    # (This will reduce the search scope in marc records).
1441
    # (This will reduce the search scope in marc records).
1443
    # For a deleted authority record, we scan all auth controlled fields
1442
    # For a deleted authority record, we scan all auth controlled fields
1443
    my $dbh = C4::Context->dbh;
1444
    my $sql = "SELECT DISTINCT tagfield FROM marc_subfield_structure WHERE authtypecode=?";
1444
    my $sql = "SELECT DISTINCT tagfield FROM marc_subfield_structure WHERE authtypecode=?";
1445
    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_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<>''" );
1446
    my $tags_new;
1446
    my $tags_new;
Lines 1458-1463 sub merge { Link Here
1458
    # And we need to add $9 in order not to duplicate
1458
    # And we need to add $9 in order not to duplicate
1459
    $skip_subfields->{9} = 1 if !$overwrite;
1459
    $skip_subfields->{9} = 1 if !$overwrite;
1460
1460
1461
    my $counteditedbiblio = 0;
1461
    foreach my $biblionumber ( @biblionumbers ) {
1462
    foreach my $biblionumber ( @biblionumbers ) {
1462
        my $marcrecord = GetMarcBiblio( $biblionumber );
1463
        my $marcrecord = GetMarcBiblio( $biblionumber );
1463
        next if !$marcrecord;
1464
        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 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