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