t/db_dependent/Authority/Merge.t

   1 #!/usr/bin/perl
   2
   3 # Tests for C4::AuthoritiesMarc::merge
   4
   5 use Modern::Perl;
   6
   7 use Test::More tests => 12;
   8
   9 use Getopt::Long;
  10 use MARC::Record;
  11 use Test::MockModule;
  12 use Test::Warn;
  13
  14 use t::lib::Mocks;
  15 use t::lib::TestBuilder;
  16
  17 use C4::Biblio qw( AddBiblio ModBiblio );
  18 use Koha::Authorities;
  19 use Koha::Authority::ControlledIndicators;
  20 use Koha::Authority::MergeRequests;
  21 use Koha::Biblios;
  22 use Koha::Database;
  23
  24 BEGIN {
  25         use_ok('C4::AuthoritiesMarc', qw( merge AddAuthority compare_fields DelAuthority ModAuthority ));
  26 }
  27
  28 # Optionally change marc flavour
  29 my $marcflavour;
  30 GetOptions( 'flavour:s' => \$marcflavour );
  31 t::lib::Mocks::mock_preference( 'marcflavour', $marcflavour ) if $marcflavour;
  32
  33 my $schema  = Koha::Database->new->schema;
  34 $schema->storage->txn_begin;
  35
  36 # Global variables, mocking and framework modifications
  37 our @linkedrecords;
  38 my $mocks = set_mocks();
  39 our ( $authtype1, $authtype2 ) = modify_framework();
  40
  41 subtest 'Test postponed merge feature' => sub {
  42     plan tests => 6;
  43
  44     # Set limit to zero, and call merge a few times
  45     t::lib::Mocks::mock_preference('AuthorityMergeLimit', 0);
  46     my $auth1 = t::lib::TestBuilder->new->build({ source => 'AuthHeader' });
  47     my $cnt = Koha::Authority::MergeRequests->count;
  48     merge({ mergefrom => '0' });
  49     is( Koha::Authority::MergeRequests->count, $cnt, 'No merge request added as expected' );
  50     merge({ mergefrom => $auth1->{authid} });
  51     is( Koha::Authority::MergeRequests->count, $cnt, 'No merge request added since we have zero hits' );
  52     @linkedrecords = ( 1, 2 ); # these biblionumbers do not matter
  53     merge({ mergefrom => $auth1->{authid} });
  54     is( Koha::Authority::MergeRequests->count, $cnt + 1, 'Merge request added as expected' );
  55
  56     # Set limit to two (starting with two records)
  57     t::lib::Mocks::mock_preference('AuthorityMergeLimit', 2);
  58     merge({ mergefrom => $auth1->{authid} });
  59     is( Koha::Authority::MergeRequests->count, $cnt + 1, 'No merge request added as we do not exceed the limit' );
  60     @linkedrecords = ( 1, 2, 3 ); # these biblionumbers do not matter
  61     merge({ mergefrom => $auth1->{authid} });
  62     is( Koha::Authority::MergeRequests->count, $cnt + 2, 'Merge request added as we do exceed the limit again' );
  63     # Now override
  64     merge({ mergefrom => $auth1->{authid}, override_limit => 1 });
  65     is( Koha::Authority::MergeRequests->count, $cnt + 2, 'No merge request added as we did override' );
  66
  67     # Set merge limit high enough for the other subtests
  68     t::lib::Mocks::mock_preference('AuthorityMergeLimit', 1000);
  69 };
  70
  71 subtest 'Test merge A1 to A2 (within same authtype)' => sub {
  72 # Tests originate from bug 11700
  73     plan tests => 9;
  74
  75     # Start in loose mode, although it actually does not matter here
  76     t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose');
  77
  78     # Add two authority records
  79     my $auth1 = MARC::Record->new;
  80     $auth1->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'George Orwell' ));
  81     my $authid1 = AddAuthority( $auth1, undef, $authtype1 );
  82     my $auth2 = MARC::Record->new;
  83     $auth2->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'G. Orwell' ));
  84     my $authid2 = AddAuthority( $auth2, undef, $authtype1 );
  85
  86     # Add two biblio records
  87     my $biblio1 = MARC::Record->new;
  88     $biblio1->append_fields( MARC::Field->new( '609', '0', '0', '9' => $authid1, 'a' => 'George Orwell' ));
  89     my ( $biblionumber1 ) = AddBiblio($biblio1, '');
  90     my $biblio2 = MARC::Record->new;
  91     $biblio2->append_fields( MARC::Field->new( '609', '0', '0', '9' => $authid2, 'a' => 'G. Orwell' ));
  92     my ( $biblionumber2 ) = AddBiblio($biblio2, '');
  93
  94     # Time to merge
  95     @linkedrecords = ( $biblionumber1, $biblionumber2 );
  96     my $rv = C4::AuthoritiesMarc::merge({ mergefrom => $authid2, MARCfrom => $auth2, mergeto => $authid1, MARCto => $auth1 });
  97     is( $rv, 1, 'We expect one biblio record (out of two) to be updated' );
  98
  99     # Check the results
 100     my $newbiblio1 = Koha::Biblios->find($biblionumber1)->metadata->record;
 101     compare_fields( $biblio1, $newbiblio1, {}, 'count' );
 102     compare_fields( $biblio1, $newbiblio1, {}, 'order' );
 103     is( $newbiblio1->subfield('609', '9'), $authid1, 'Check biblio1 609$9' );
 104     is( $newbiblio1->subfield('609', 'a'), 'George Orwell',
 105         'Check biblio1 609$a' );
 106     my $newbiblio2 = Koha::Biblios->find($biblionumber2)->metadata->record;
 107     compare_fields( $biblio2, $newbiblio2, {}, 'count' );
 108     compare_fields( $biblio2, $newbiblio2, {}, 'order' );
 109     is( $newbiblio2->subfield('609', '9'), $authid1, 'Check biblio2 609$9' );
 110     is( $newbiblio2->subfield('609', 'a'), 'George Orwell',
 111         'Check biblio2 609$a' );
 112 };
 113
 114 subtest 'Test merge A1 to modified A1, test strict mode' => sub {
 115 # Tests originate from bug 11700
 116     plan tests => 12;
 117
 118     # Simulate modifying an authority from auth1old to auth1new
 119     my $auth1old = MARC::Record->new;
 120     $auth1old->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'Bruce Wayne' ));
 121     my $auth1new = $auth1old->clone;
 122     $auth1new->field('109')->update( a => 'Batman' );
 123     my $authid1 = AddAuthority( $auth1new, undef, $authtype1 );
 124
 125     # Add two biblio records
 126     my $MARC1 = MARC::Record->new;
 127     $MARC1->append_fields( MARC::Field->new( '109', '', '', 'a' => 'Bruce Wayne', 'b' => '2014', '9' => $authid1 ));
 128     $MARC1->append_fields( MARC::Field->new( '245', '', '', 'a' => 'From the depths' ));
 129     $MARC1->append_fields( MARC::Field->new( '609', '', '', 'a' => 'Bruce Lee', 'b' => 'Should be cleared too', '9' => $authid1 ));
 130     $MARC1->append_fields( MARC::Field->new( '609', '', '', 'a' => 'Bruce Lee', 'c' => 'This is a duplicate to be removed in strict mode', '9' => $authid1 ));
 131     my $MARC2 = MARC::Record->new;
 132     $MARC2->append_fields( MARC::Field->new( '109', '', '', 'a' => 'Batman', '9' => $authid1 ));
 133     $MARC2->append_fields( MARC::Field->new( '245', '', '', 'a' => 'All the way to heaven' ));
 134     my ( $biblionumber1 ) = AddBiblio( $MARC1, '');
 135     my ( $biblionumber2 ) = AddBiblio( $MARC2, '');
 136
 137     # Time to merge in loose mode first
 138     @linkedrecords = ( $biblionumber1, $biblionumber2 );
 139     t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose');
 140     my $rv = C4::AuthoritiesMarc::merge({ mergefrom => $authid1, MARCfrom => $auth1old, mergeto => $authid1, MARCto => $auth1new });
 141     is( $rv, 2, 'Both records are updated now' );
 142
 143     #Check the results
 144     my $biblio1 = Koha::Biblios->find($biblionumber1)->metadata->record;
 145     compare_fields( $MARC1, $biblio1, {}, 'count' );
 146     compare_fields( $MARC1, $biblio1, {}, 'order' );
 147     is( $auth1new->field(109)->subfield('a'), $biblio1->field(109)->subfield('a'), 'Record1 values updated correctly' );
 148     my $biblio2 = Koha::Biblios->find($biblionumber2)->metadata->record;
 149     compare_fields( $MARC2, $biblio2, {}, 'count' );
 150     compare_fields( $MARC2, $biblio2, {}, 'order' );
 151     is( $auth1new->field(109)->subfield('a'), $biblio2->field(109)->subfield('a'), 'Record2 values updated correctly' );
 152     # This is only true in loose mode:
 153     is( $biblio1->field(109)->subfield('b'), $MARC1->field(109)->subfield('b'), 'Subfield not overwritten in loose mode');
 154
 155     # Merge again in strict mode
 156     t::lib::Mocks::mock_preference('AuthorityMergeMode', 'strict');
 157     ModBiblio( $MARC1, $biblionumber1, '' );
 158     @linkedrecords = ( $biblionumber1 );
 159     $rv = C4::AuthoritiesMarc::merge({ mergefrom => $authid1, MARCfrom => $auth1old, mergeto => $authid1, MARCto => $auth1new });
 160     $biblio1 = Koha::Biblios->find($biblionumber1)->metadata->record;
 161     is( $biblio1->field(109)->subfield('b'), undef, 'Subfield overwritten in strict mode' );
 162     compare_fields( $MARC1, $biblio1, { 609 => 1 }, 'count' );
 163     my @old609 = $MARC1->field('609');
 164     my @new609 = $biblio1->field('609');
 165     is( scalar @new609, @old609 - 1, 'strict mode should remove a duplicate 609' );
 166     is( $biblio1->field(609)->subfields,
 167         scalar($auth1new->field('109')->subfields) + 1,
 168         'Check number of subfields in strict mode for the remaining 609' );
 169         # Note: the +1 comes from the added subfield $9 in the biblio
 170 };
 171
 172 subtest 'Test merge A1 to B1 (changing authtype)' => sub {
 173 # Tests were aimed for bug 9988, moved to 17909 in adjusted form
 174 # Would not encourage this type of merge, but we should test what we offer
 175     plan tests => 13;
 176
 177     # Get back to loose mode now
 178     t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose');
 179
 180     # create two auth recs of different type
 181     my $auth1 = MARC::Record->new;
 182     $auth1->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'George Orwell', b => 'bb' ));
 183     my $authid1 = AddAuthority( $auth1, undef, $authtype1 );
 184     my $auth2 = MARC::Record->new;
 185     $auth2->append_fields( MARC::Field->new( '112', '0', '0', 'a' => 'Batman', c => 'cc' ));
 186     my $authid2 = AddAuthority($auth1, undef, $authtype2 );
 187
 188     # create a biblio with one 109 and two 609s to be touched
 189     # seems exceptional see bug 13760 comment10
 190     my $marc = MARC::Record->new;
 191     $marc->append_fields(
 192         MARC::Field->new( '003', 'some_003' ),
 193         MARC::Field->new( '109', '', '', a => 'G. Orwell', b => 'bb', d => 'd', 9 => $authid1 ),
 194         MARC::Field->new( '245', '', '', a => 'My title' ),
 195         MARC::Field->new( '609', '', '', a => 'Orwell', 9 => "$authid1" ),
 196         MARC::Field->new( '609', '', '', a => 'Orwell', x => 'xx', 9 => "$authid1" ),
 197         MARC::Field->new( '611', '', '', a => 'Added for testing order' ),
 198         MARC::Field->new( '612', '', '', a => 'unrelated', 9 => 'other' ),
 199     );
 200     my ( $biblionumber ) = C4::Biblio::AddBiblio( $marc, '' );
 201     my $oldbiblio = Koha::Biblios->find($biblionumber)->metadata->record;
 202
 203     # Time to merge
 204     @linkedrecords = ( $biblionumber );
 205     my $retval = C4::AuthoritiesMarc::merge({ mergefrom => $authid1, MARCfrom => $auth1, mergeto => $authid2, MARCto => $auth2 });
 206     is( $retval, 1, 'We touched only one biblio' );
 207
 208     # Get new marc record for compares
 209     my $newbiblio = Koha::Biblios->find($biblionumber)->metadata->record;
 210     compare_fields( $oldbiblio, $newbiblio, {}, 'count' );
 211     # Exclude 109/609 and 112/612 in comparing order
 212     my $excl = { '109' => 1, '112' => 1, '609' => 1, '612' => 1 };
 213     compare_fields( $oldbiblio, $newbiblio, $excl, 'order' );
 214     # Check position of 612s in the new record
 215     my $full_order = join q/,/, map { $_->tag } $newbiblio->fields;
 216     is( $full_order =~ /611(,612){3}/, 1, 'Check position of all 612s' );
 217
 218     # Check some fields
 219     is( $newbiblio->field('003')->data,
 220         $oldbiblio->field('003')->data,
 221         'Check contents of a control field not expected to be touched' );
 222     is( $newbiblio->subfield( '245', 'a' ),
 223         $oldbiblio->subfield( '245', 'a' ),
 224         'Check contents of a data field not expected to be touched' );
 225     is( $newbiblio->subfield( '112', 'a' ),
 226         $auth2->subfield( '112', 'a' ), 'Check modified 112a' );
 227     is( $newbiblio->subfield( '112', 'c' ),
 228         $auth2->subfield( '112', 'c' ), 'Check new 112c' );
 229
 230     # Check 112b; this subfield was cleared when moving from 109 to 112
 231     # Note that this fix only applies to the current loose mode only
 232     is( $newbiblio->subfield( '112', 'b' ), undef,
 233         'Merge respects a cleared subfield in loose mode' );
 234
 235     # Check the original 612
 236     is( ( $newbiblio->field('612') )[0]->subfield( 'a' ),
 237         $oldbiblio->subfield( '612', 'a' ), 'Check untouched 612a' );
 238     # Check second 612
 239     is( ( $newbiblio->field('612') )[1]->subfield( 'a' ),
 240         $auth2->subfield( '112', 'a' ), 'Check second touched 612a' );
 241     # Check second new 612ax (in LOOSE mode)
 242     is( ( $newbiblio->field('612') )[2]->subfield( 'a' ),
 243         $auth2->subfield( '112', 'a' ), 'Check touched 612a' );
 244     is( ( $newbiblio->field('612') )[2]->subfield( 'x' ),
 245         ( $oldbiblio->field('609') )[1]->subfield('x'),
 246         'Check 612x' );
 247 };
 248
 249 subtest 'Test update A with modified heading tag (changing authtype)' => sub {
 250 # Bug 19693
 251 # This would happen rarely when updating authorities from authority file
 252 # when the tag of a heading field is being changed (and thus also
 253 # the authtype)
 254     plan tests => 13;
 255
 256     # Get back to loose mode now
 257     t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose');
 258
 259     # create an auth rec
 260     my $auth1 = MARC::Record->new;
 261     $auth1->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'George Orwell', b => 'bb' ));
 262     my $authid1 = AddAuthority( $auth1, undef, $authtype1 );
 263
 264     # create a biblio with one 109 and two 609s to be touched
 265     # seems exceptional see bug 13760 comment10
 266     my $marc = MARC::Record->new;
 267     $marc->append_fields(
 268         MARC::Field->new( '003', 'some_003' ),
 269         MARC::Field->new( '109', '', '', a => 'G. Orwell', b => 'bb', d => 'd', 9 => $authid1 ),
 270         MARC::Field->new( '245', '', '', a => 'My title' ),
 271         MARC::Field->new( '609', '', '', a => 'Orwell', 9 => "$authid1" ),
 272         MARC::Field->new( '609', '', '', a => 'Orwell', x => 'xx', 9 => "$authid1" ),
 273         MARC::Field->new( '611', '', '', a => 'Added for testing order' ),
 274         MARC::Field->new( '612', '', '', a => 'unrelated', 9 => 'other' ),
 275     );
 276     my ( $biblionumber ) = C4::Biblio::AddBiblio( $marc, '' );
 277     my $oldbiblio = Koha::Biblios->find($biblionumber)->metadata->record;
 278
 279     # Time to merge
 280     @linkedrecords = ( $biblionumber );
 281     my $auth2 = MARC::Record->new;
 282     $auth2->append_fields( MARC::Field->new( '112', '0', '0', 'a' => 'Batman', c => 'cc' ));
 283     my $authid2 = ModAuthority($authid1, $auth2, $authtype2 );
 284     # inside ModAuthority the following is executed:
 285     # merge({ mergefrom => $authid1, MARCfrom => $auth1, mergeto => $authid1, MARCto => $auth2 });
 286     is( $authid2, $authid1, 'authid after ModAuthority OK' );
 287
 288     # Get new marc record for compares
 289     my $newbiblio = Koha::Biblios->find($biblionumber)->metadata->record;
 290     compare_fields( $oldbiblio, $newbiblio, {}, 'count' );
 291     # Exclude 109/609 and 112/612 in comparing order
 292     my $excl = { '109' => 1, '112' => 1, '609' => 1, '612' => 1 };
 293     compare_fields( $oldbiblio, $newbiblio, $excl, 'order' );
 294     # Check position of 612s in the new record
 295     my $full_order = join q/,/, map { $_->tag } $newbiblio->fields;
 296     is( $full_order =~ /611(,612){3}/, 1, 'Check position of all 612s' );
 297
 298     # Check some fields
 299     is( $newbiblio->field('003')->data,
 300         $oldbiblio->field('003')->data,
 301         'Check contents of a control field not expected to be touched' );
 302     is( $newbiblio->subfield( '245', 'a' ),
 303         $oldbiblio->subfield( '245', 'a' ),
 304         'Check contents of a data field not expected to be touched' );
 305     is( $newbiblio->subfield( '112', 'a' ),
 306         $auth2->subfield( '112', 'a' ), 'Check modified 112a' );
 307     is( $newbiblio->subfield( '112', 'c' ),
 308         $auth2->subfield( '112', 'c' ), 'Check new 112c' );
 309
 310     # Check 112b; this subfield was cleared when moving from 109 to 112
 311     # Note that this fix only applies to the current loose mode only
 312     is( $newbiblio->subfield( '112', 'b' ), undef,
 313         'Merge respects a cleared subfield in loose mode' );
 314
 315     # Check the original 612
 316     is( ( $newbiblio->field('612') )[0]->subfield( 'a' ),
 317         $oldbiblio->subfield( '612', 'a' ), 'Check untouched 612a' );
 318     # Check second 612
 319     is( ( $newbiblio->field('612') )[1]->subfield( 'a' ),
 320         $auth2->subfield( '112', 'a' ), 'Check second touched 612a' );
 321     # Check second new 612ax (in LOOSE mode)
 322     is( ( $newbiblio->field('612') )[2]->subfield( 'a' ),
 323         $auth2->subfield( '112', 'a' ), 'Check touched 612a' );
 324     is( ( $newbiblio->field('612') )[2]->subfield( 'x' ),
 325         ( $oldbiblio->field('609') )[1]->subfield('x'),
 326         'Check 612x' );
 327 };
 328
 329 subtest 'Merging authorities should handle deletes (BZ 18070)' => sub {
 330     plan tests => 2;
 331
 332     # Add authority and linked biblio, delete authority
 333     my $auth1 = MARC::Record->new;
 334     $auth1->append_fields( MARC::Field->new( '109', '', '', 'a' => 'DEL'));
 335     my $authid1 = AddAuthority( $auth1, undef, $authtype1 );
 336     my $bib1 = MARC::Record->new;
 337     $bib1->append_fields(
 338         MARC::Field->new( '245', '', '', a => 'test DEL' ),
 339         MARC::Field->new( '609', '', '', a => 'DEL', 9 => "$authid1" ),
 340     );
 341     my ( $biblionumber ) = C4::Biblio::AddBiblio( $bib1, '' );
 342     @linkedrecords = ( $biblionumber );
 343     DelAuthority({ authid => $authid1 }); # this triggers a merge call
 344
 345     # See what happened in the biblio record
 346     my $marc1 = Koha::Biblios->find($biblionumber)->metadata->record;
 347     is( $marc1->field('609'), undef, 'Field 609 should be gone too' );
 348
 349     # Now we simulate the delete as done in the cron job
 350     # First, restore auth1 and add 609 back in bib1
 351     $auth1 = MARC::Record->new;
 352     $auth1->append_fields( MARC::Field->new( '109', '', '', 'a' => 'DEL'));
 353     $authid1 = AddAuthority( $auth1, undef, $authtype1 );
 354     $marc1->append_fields(
 355         MARC::Field->new( '609', '', '', a => 'DEL', 9 => "$authid1" ),
 356     );
 357     ModBiblio( $marc1, $biblionumber, '' );
 358     # Instead of going through DelAuthority, we manually delete the auth
 359     # record and call merge afterwards.
 360     # This mimics deleting an authority and calling merge later in the
 361     # merge cron job.
 362     # We use the biblionumbers parameter here and unmock linked_biblionumbers.
 363     C4::Context->dbh->do( "DELETE FROM auth_header WHERE authid=?", undef, $authid1 );
 364     @linkedrecords = ();
 365     $mocks->{auth_mod}->unmock_all;
 366     merge({ mergefrom => $authid1, biblionumbers => [ $biblionumber ] });
 367     # Final check
 368     $marc1 = Koha::Biblios->find($biblionumber)->metadata->record;
 369     is( $marc1->field('609'), undef, 'Merge removed the 609 again even after deleting the authority record' );
 370 };
 371
 372 subtest "Test some specific postponed merge issues" => sub {
 373     plan tests => 6;
 374
 375     my $authmarc = MARC::Record->new;
 376     $authmarc->append_fields( MARC::Field->new( '109', '', '', 'a' => 'aa', b => 'bb' ));
 377     my $oldauthmarc = MARC::Record->new;
 378     $oldauthmarc->append_fields( MARC::Field->new( '112', '', '', c => 'cc' ));
 379     my $id = AddAuthority( $authmarc, undef, $authtype1 );
 380     my $biblio = MARC::Record->new;
 381     $biblio->append_fields(
 382         MARC::Field->new( '109', '', '', a => 'a1', 9 => $id ),
 383         MARC::Field->new( '612', '', '', a => 'a2', c => 'cc', 9 => $id+1 ),
 384         MARC::Field->new( '612', '', '', a => 'a3', 9 => $id+2 ),
 385     );
 386     my ( $biblionumber ) = C4::Biblio::AddBiblio( $biblio, '' );
 387
 388     # Merge A to B postponed, A is deleted (simulated by id+1)
 389     # This proves the !authtypefrom condition in sub merge
 390     # Additionally, we test clearing subfield
 391     merge({ mergefrom => $id + 1, MARCfrom => $oldauthmarc, mergeto => $id, MARCto => $authmarc, biblionumbers => [ $biblionumber ] });
 392     $biblio = Koha::Biblios->find($biblionumber)->metadata->record;
 393     is( $biblio->subfield('609', '9'), $id, '612 moved to 609' );
 394     is( $biblio->subfield('609', 'c'), undef, '609c cleared correctly' );
 395
 396     # Merge A to B postponed, delete B immediately (hits B < hits A)
 397     # This proves the !@record_to test in sub merge
 398     merge({ mergefrom => $id + 2, mergeto => $id + 1, MARCto => undef, biblionumbers => [ $biblionumber ] });
 399     $biblio = Koha::Biblios->find($biblionumber)->metadata->record;
 400     is( $biblio->field('612'), undef, 'Last 612 must be gone' );
 401
 402     # Show that we 'need' skip_merge; this example is far-fetched.
 403     # We *prove* by contradiction.
 404     # Suppose: Merge A to B postponed, and delete A would merge rightaway.
 405     # (You would need some special race condition with merge.pl to do so.)
 406     # The modify merge would be useless after that.
 407     @linkedrecords = ( $biblionumber );
 408     my $restored_mocks = set_mocks();
 409     DelAuthority({ authid => $id, skip_merge => 1 }); # delete A
 410     $restored_mocks->{auth_mod}->unmock_all;
 411     $biblio = Koha::Biblios->find($biblionumber)->metadata->record;
 412     is( $biblio->subfield('109', '9'), $id, 'If the 109 is no longer present, another modify merge would not bring it back' );
 413
 414     # Bug 22437 now removes older postponed A->A merges in DelAuthority
 415     $id = AddAuthority( $authmarc, undef, $authtype1 );
 416     my $merge = Koha::Authority::MergeRequest->new({ authid => $id })->store;
 417     DelAuthority({ authid => $id, skip_merge => 1 });
 418     $merge->discard_changes;
 419     is( $merge->in_storage, 0, 'Older merge should be removed' );
 420     # And even if we don't pass skip_merge
 421     $id = AddAuthority( $authmarc, undef, $authtype1 );
 422     $merge = Koha::Authority::MergeRequest->new({ authid => $id })->store;
 423     DelAuthority({ authid => $id });
 424     $merge->discard_changes;
 425     is( $merge->in_storage, 0, 'Older merge should be removed again' );
 426 };
 427
 428 subtest "Graceful resolution of missing reporting tag" => sub {
 429     plan tests => 2;
 430
 431     # Simulate merge with authority in Default fw without reporting tag
 432     # We expect data loss in biblio, but we keep $a and the reference in $9
 433     # in order to allow a future merge to restore data.
 434
 435     # Accomplish the above by clearing reporting tag in $authtype2
 436     my $fw2 = Koha::Authority::Types->find( $authtype2 );
 437     $fw2->auth_tag_to_report('')->store;
 438
 439     my $authmarc = MARC::Record->new;
 440     $authmarc->append_fields( MARC::Field->new( '109', '', '', 'a' => 'aa', b => 'bb' ));
 441     my $id1 = AddAuthority( $authmarc, undef, $authtype1 );
 442     my $id2 = AddAuthority( $authmarc, undef, $authtype2 );
 443
 444     my $biblio = MARC::Record->new;
 445     $biblio->append_fields(
 446         MARC::Field->new( '609', '', '', a => 'aa', 9 => $id1 ),
 447     );
 448     my ( $biblionumber ) = C4::Biblio::AddBiblio( $biblio, '' );
 449
 450     # Merge
 451     merge({ mergefrom => $id1, MARCfrom => $authmarc, mergeto => $id2, MARCto => $authmarc, biblionumbers => [ $biblionumber ] });
 452     $biblio = Koha::Biblios->find($biblionumber)->metadata->record;
 453     is( $biblio->subfield('612', '9'), $id2, 'id2 saved in $9' );
 454     is( $biblio->subfield('612', 'a'), ' ', 'Kept an empty $a too' );
 455
 456     $fw2->auth_tag_to_report('112')->store;
 457 };
 458
 459 subtest 'merge should not reorder too much' => sub {
 460     plan tests => 2;
 461
 462     # Back to loose mode
 463     t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose');
 464
 465     my $authmarc = MARC::Record->new;
 466     $authmarc->append_fields( MARC::Field->new( '109', '', '', 'a' => 'aa', b => 'bb' ));
 467     my $id = AddAuthority( $authmarc, undef, $authtype1 );
 468     my $biblio = MARC::Record->new;
 469     $biblio->append_fields(
 470         MARC::Field->new( '109', '', '', 9 => $id, i => 'in front', a => 'aa', c => 'after controlled block' ), # this field shows the old situation when $9 is the first subfield
 471         MARC::Field->new( '609', '', '', i => 'in front', a => 'aa', c => 'after controlled block', 9 => $id ), # here $9 is already the last one
 472     );
 473     my ( $biblionumber ) = C4::Biblio::AddBiblio( $biblio, '' );
 474
 475     # Merge 109 and 609 and check order of subfields
 476     merge({ mergefrom => $id, MARCfrom => $authmarc, mergeto => $id, MARCto => $authmarc, biblionumbers => [ $biblionumber ] });
 477     my $biblio2 = Koha::Biblios->find($biblionumber)->metadata->record;
 478     my $subfields = [ map { $_->[0] } $biblio2->field('109')->subfields ];
 479     is_deeply( $subfields, [ 'i', 'a', 'b', 'c', '9' ], 'Merge only moved $9' );
 480     $subfields = [ map { $_->[0] } $biblio2->field('609')->subfields ];
 481     is_deeply( $subfields, [ 'i', 'a', 'b', 'c', '9' ], 'Order kept' );
 482 };
 483
 484 subtest 'Test how merge handles controlled indicators' => sub {
 485     plan tests => 4;
 486
 487     # Note: See more detailed tests in t/Koha/Authority/ControlledIndicators.t
 488
 489     # Testing MARC21 because thesaurus code makes it more interesting
 490     t::lib::Mocks::mock_preference( 'marcflavour', 'MARC21' );
 491     t::lib::Mocks::mock_preference('AuthorityControlledIndicators', q|marc21,*,ind1:auth1,ind2:thesaurus|);
 492
 493     my $authmarc = MARC::Record->new;
 494     $authmarc->append_fields(
 495         MARC::Field->new( '008', (' 'x11).'r' ), # thesaurus code
 496         MARC::Field->new( '109', '7', '', 'a' => 'a' ),
 497     );
 498     my $id = AddAuthority( $authmarc, undef, $authtype1 );
 499     my $biblio = MARC::Record->new;
 500     $biblio->append_fields(
 501         MARC::Field->new( '609', '8', '4', a => 'a', 2 => '2', 9 => $id ),
 502     );
 503     my ( $biblionumber ) = C4::Biblio::AddBiblio( $biblio, '' );
 504
 505     # Merge and check indicators and $2
 506     merge({ mergefrom => $id, MARCfrom => $authmarc, mergeto => $id, MARCto => $authmarc, biblionumbers => [ $biblionumber ] });
 507     my $biblio2 = Koha::Biblios->find($biblionumber)->metadata->record;
 508     is( $biblio2->field('609')->indicator(1), '7', 'Indicator1 OK' );
 509     is( $biblio2->field('609')->indicator(2), '7', 'Indicator2 OK' );
 510     is( $biblio2->subfield('609', '2'), 'aat', 'Subfield $2 OK' );
 511
 512     # Test $2 removal now
 513     $authmarc->field('008')->update( (' 'x11).'a' ); # LOC, no $2 needed
 514     AddAuthority( $authmarc, $id, $authtype1 ); # modify
 515     merge({ mergefrom => $id, MARCfrom => $authmarc, mergeto => $id, MARCto => $authmarc, biblionumbers => [ $biblionumber ] });
 516     $biblio2 = Koha::Biblios->find($biblionumber)->metadata->record;
 517     is( $biblio2->subfield('609', '2'), undef, 'No subfield $2 left' );
 518 };
 519
 520 subtest "Test bibs not auto linked when merging" => sub {
 521     plan tests => 1;
 522
 523     my $authmarc = MARC::Record->new;
 524     $authmarc->append_fields( MARC::Field->new( '109', '', '', 'a' => 'aa', b => 'bb' ) );
 525     my $oldauthmarc = MARC::Record->new;
 526     $oldauthmarc->append_fields( MARC::Field->new( '112', '', '', c => 'cc' ) );
 527     my $new_id = AddAuthority( $authmarc,    undef, $authtype1 );
 528     my $old_id = AddAuthority( $oldauthmarc, undef, $authtype1 );
 529     my $biblio = MARC::Record->new;
 530     $biblio->append_fields(
 531         MARC::Field->new( '109', '', '', a => 'a1', 9 => $old_id ),
 532         MARC::Field->new( '612', '', '', a => 'a2', c => 'cc', 9 => $old_id ),
 533     );
 534     my ($biblionumber) = C4::Biblio::AddBiblio( $biblio, '' );
 535
 536     my $biblio_module = Test::MockModule->new('C4::AuthoritiesMarc');
 537     $biblio_module->mock(
 538         'ModBiblio',
 539         sub {
 540             my ( undef, undef, undef, $params ) = @_;
 541             warn "Auto link disabled" if $params->{disable_autolink};
 542         }
 543     );
 544
 545     warnings_are {
 546         merge(
 547             {
 548                 mergefrom     => $old_id, MARCfrom => $oldauthmarc, mergeto => $new_id, MARCto => $authmarc,
 549                 biblionumbers => [$biblionumber]
 550             }
 551         );
 552     }
 553     ["Auto link disabled"], "Auto link disabled when merging authorities";
 554
 555 };
 556
 557 sub set_mocks {
 558     # After we removed the Zebra code from merge, we only need to mock
 559     # get_usage_count and linked_biblionumbers here.
 560
 561     my $mocks;
 562     $mocks->{auth_mod} = Test::MockModule->new( 'Koha::Authorities' );
 563     $mocks->{auth_mod}->mock( 'get_usage_count', sub {
 564          return scalar @linkedrecords;
 565     });
 566     $mocks->{auth_mod}->mock( 'linked_biblionumbers', sub {
 567          return @linkedrecords;
 568     });
 569     return $mocks;
 570 }
 571
 572 sub modify_framework {
 573     my $builder = t::lib::TestBuilder->new;
 574
 575     # create two auth types
 576     my $authtype1 = $builder->build({
 577         source => 'AuthType',
 578         value  => {
 579             auth_tag_to_report => '109',
 580         },
 581     });
 582     my $authtype2 = $builder->build({
 583         source => 'AuthType',
 584         value  => {
 585             auth_tag_to_report => '112',
 586         },
 587     });
 588
 589     # Link 109/609 to the first authtype
 590     $builder->build({
 591         source => 'MarcSubfieldStructure',
 592         value  => {
 593             tagfield => '109',
 594             tagsubfield => 'a',
 595             authtypecode => $authtype1->{authtypecode},
 596             frameworkcode => '',
 597         },
 598     });
 599     $builder->build({
 600         source => 'MarcSubfieldStructure',
 601         value  => {
 602             tagfield => '609',
 603             tagsubfield => 'a',
 604             authtypecode => $authtype1->{authtypecode},
 605             frameworkcode => '',
 606         },
 607     });
 608
 609     # Link 112/612 to the second authtype
 610     $builder->build({
 611         source => 'MarcSubfieldStructure',
 612         value  => {
 613             tagfield => '112',
 614             tagsubfield => 'a',
 615             authtypecode => $authtype2->{authtypecode},
 616             frameworkcode => '',
 617         },
 618     });
 619     $builder->build({
 620         source => 'MarcSubfieldStructure',
 621         value  => {
 622             tagfield => '612',
 623             tagsubfield => 'a',
 624             authtypecode => $authtype2->{authtypecode},
 625             frameworkcode => '',
 626         },
 627     });
 628
 629     return ( $authtype1->{authtypecode}, $authtype2->{authtypecode} );
 630 }
 631
 632 sub compare_fields { # mode parameter: order or count
 633     my ( $oldmarc, $newmarc, $exclude, $mode ) = @_;
 634     $exclude //= {};
 635     if( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
 636         # By default exclude field 100 from comparison in UNIMARC.
 637         # Will have been added by ModBiblio in merge.
 638         $exclude->{100} = 1;
 639     }
 640     my @oldfields = map { $exclude->{$_->tag} ? () : $_->tag } $oldmarc->fields;
 641     my @newfields = map { $exclude->{$_->tag} ? () : $_->tag } $newmarc->fields;
 642
 643     if( $mode eq 'count' ) {
 644         my $t;
 645         is( scalar @newfields, $t = @oldfields, "Number of fields still equal to $t" );
 646     } elsif( $mode eq 'order' ) {
 647         is( ( join q/,/, @newfields ), ( join q/,/, @oldfields ), 'Order of fields unchanged' );
 648     }
 649 }
 650
 651 $schema->storage->txn_rollback;