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 => 9;
   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;
  17 use Koha::Authorities;
  18 use Koha::Authority::MergeRequests;
  19 use Koha::Database;
  20
  21 BEGIN {
  22         use_ok('C4::AuthoritiesMarc');
  23 }
  24
  25 # Optionally change marc flavour
  26 my $marcflavour;
  27 GetOptions( 'flavour:s' => \$marcflavour );
  28 t::lib::Mocks::mock_preference( 'marcflavour', $marcflavour ) if $marcflavour;
  29
  30 my $schema  = Koha::Database->new->schema;
  31 $schema->storage->txn_begin;
  32
  33 # Global variables, mocking and framework modifications
  34 our @linkedrecords;
  35 my $mocks = set_mocks();
  36 our ( $authtype1, $authtype2 ) = modify_framework();
  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
  68 subtest 'Test merge A1 to A2 (within same authtype)' => sub {
  69 # Tests originate from bug 11700
  70     plan tests => 9;
  71
  72     # Start in loose mode, although it actually does not matter here
  73     t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose');
  74
  75     # Add two authority records
  76     my $auth1 = MARC::Record->new;
  77     $auth1->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'George Orwell' ));
  78     my $authid1 = AddAuthority( $auth1, undef, $authtype1 );
  79     my $auth2 = MARC::Record->new;
  80     $auth2->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'G. Orwell' ));
  81     my $authid2 = AddAuthority( $auth2, undef, $authtype1 );
  82
  83     # Add two biblio records
  84     my $biblio1 = MARC::Record->new;
  85     $biblio1->append_fields( MARC::Field->new( '609', '0', '0', '9' => $authid1, 'a' => 'George Orwell' ));
  86     my ( $biblionumber1 ) = AddBiblio($biblio1, '');
  87     my $biblio2 = MARC::Record->new;
  88     $biblio2->append_fields( MARC::Field->new( '609', '0', '0', '9' => $authid2, 'a' => 'G. Orwell' ));
  89     my ( $biblionumber2 ) = AddBiblio($biblio2, '');
  90
  91     # Time to merge
  92     @linkedrecords = ( $biblionumber1, $biblionumber2 );
  93     my $rv = C4::AuthoritiesMarc::merge({ mergefrom => $authid2, MARCfrom => $auth2, mergeto => $authid1, MARCto => $auth1 });
  94     is( $rv, 1, 'We expect one biblio record (out of two) to be updated' );
  95
  96     # Check the results
  97     my $newbiblio1 = GetMarcBiblio({ biblionumber => $biblionumber1 });
  98     compare_fields( $biblio1, $newbiblio1, {}, 'count' );
  99     compare_fields( $biblio1, $newbiblio1, {}, 'order' );
 100     is( $newbiblio1->subfield('609', '9'), $authid1, 'Check biblio1 609$9' );
 101     is( $newbiblio1->subfield('609', 'a'), 'George Orwell',
 102         'Check biblio1 609$a' );
 103     my $newbiblio2 = GetMarcBiblio({ biblionumber => $biblionumber2 });
 104     compare_fields( $biblio2, $newbiblio2, {}, 'count' );
 105     compare_fields( $biblio2, $newbiblio2, {}, 'order' );
 106     is( $newbiblio2->subfield('609', '9'), $authid1, 'Check biblio2 609$9' );
 107     is( $newbiblio2->subfield('609', 'a'), 'George Orwell',
 108         'Check biblio2 609$a' );
 109 };
 110
 111 subtest 'Test merge A1 to modified A1, test strict mode' => sub {
 112 # Tests originate from bug 11700
 113     plan tests => 12;
 114
 115     # Simulate modifying an authority from auth1old to auth1new
 116     my $auth1old = MARC::Record->new;
 117     $auth1old->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'Bruce Wayne' ));
 118     my $auth1new = $auth1old->clone;
 119     $auth1new->field('109')->update( a => 'Batman' );
 120     my $authid1 = AddAuthority( $auth1new, undef, $authtype1 );
 121
 122     # Add two biblio records
 123     my $MARC1 = MARC::Record->new;
 124     $MARC1->append_fields( MARC::Field->new( '109', '', '', 'a' => 'Bruce Wayne', 'b' => '2014', '9' => $authid1 ));
 125     $MARC1->append_fields( MARC::Field->new( '245', '', '', 'a' => 'From the depths' ));
 126     $MARC1->append_fields( MARC::Field->new( '609', '', '', 'a' => 'Bruce Lee', 'b' => 'Should be cleared too', '9' => $authid1 ));
 127     $MARC1->append_fields( MARC::Field->new( '609', '', '', 'a' => 'Bruce Lee', 'c' => 'This is a duplicate to be removed in strict mode', '9' => $authid1 ));
 128     my $MARC2 = MARC::Record->new;
 129     $MARC2->append_fields( MARC::Field->new( '109', '', '', 'a' => 'Batman', '9' => $authid1 ));
 130     $MARC2->append_fields( MARC::Field->new( '245', '', '', 'a' => 'All the way to heaven' ));
 131     my ( $biblionumber1 ) = AddBiblio( $MARC1, '');
 132     my ( $biblionumber2 ) = AddBiblio( $MARC2, '');
 133
 134     # Time to merge in loose mode first
 135     @linkedrecords = ( $biblionumber1, $biblionumber2 );
 136     t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose');
 137     my $rv = C4::AuthoritiesMarc::merge({ mergefrom => $authid1, MARCfrom => $auth1old, mergeto => $authid1, MARCto => $auth1new });
 138     is( $rv, 2, 'Both records are updated now' );
 139
 140     #Check the results
 141     my $biblio1 = GetMarcBiblio({ biblionumber => $biblionumber1 });
 142     compare_fields( $MARC1, $biblio1, {}, 'count' );
 143     compare_fields( $MARC1, $biblio1, {}, 'order' );
 144     is( $auth1new->field(109)->subfield('a'), $biblio1->field(109)->subfield('a'), 'Record1 values updated correctly' );
 145     my $biblio2 = GetMarcBiblio({ biblionumber => $biblionumber2 });
 146     compare_fields( $MARC2, $biblio2, {}, 'count' );
 147     compare_fields( $MARC2, $biblio2, {}, 'order' );
 148     is( $auth1new->field(109)->subfield('a'), $biblio2->field(109)->subfield('a'), 'Record2 values updated correctly' );
 149     # This is only true in loose mode:
 150     is( $biblio1->field(109)->subfield('b'), $MARC1->field(109)->subfield('b'), 'Subfield not overwritten in loose mode');
 151
 152     # Merge again in strict mode
 153     t::lib::Mocks::mock_preference('AuthorityMergeMode', 'strict');
 154     ModBiblio( $MARC1, $biblionumber1, '' );
 155     @linkedrecords = ( $biblionumber1 );
 156     $rv = C4::AuthoritiesMarc::merge({ mergefrom => $authid1, MARCfrom => $auth1old, mergeto => $authid1, MARCto => $auth1new });
 157     $biblio1 = GetMarcBiblio({ biblionumber => $biblionumber1 });
 158     is( $biblio1->field(109)->subfield('b'), undef, 'Subfield overwritten in strict mode' );
 159     compare_fields( $MARC1, $biblio1, { 609 => 1 }, 'count' );
 160     my @old609 = $MARC1->field('609');
 161     my @new609 = $biblio1->field('609');
 162     is( scalar @new609, @old609 - 1, 'strict mode should remove a duplicate 609' );
 163     is( $biblio1->field(609)->subfields,
 164         scalar($auth1new->field('109')->subfields) + 1,
 165         'Check number of subfields in strict mode for the remaining 609' );
 166         # Note: the +1 comes from the added subfield $9 in the biblio
 167 };
 168
 169 subtest 'Test merge A1 to B1 (changing authtype)' => sub {
 170 # Tests were aimed for bug 9988, moved to 17909 in adjusted form
 171 # Would not encourage this type of merge, but we should test what we offer
 172     plan tests => 13;
 173
 174     # Get back to loose mode now
 175     t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose');
 176
 177     # create two auth recs of different type
 178     my $auth1 = MARC::Record->new;
 179     $auth1->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'George Orwell', b => 'bb' ));
 180     my $authid1 = AddAuthority( $auth1, undef, $authtype1 );
 181     my $auth2 = MARC::Record->new;
 182     $auth2->append_fields( MARC::Field->new( '112', '0', '0', 'a' => 'Batman', c => 'cc' ));
 183     my $authid2 = AddAuthority($auth1, undef, $authtype2 );
 184
 185     # create a biblio with one 109 and two 609s to be touched
 186     # seems exceptional see bug 13760 comment10
 187     my $marc = MARC::Record->new;
 188     $marc->append_fields(
 189         MARC::Field->new( '003', 'some_003' ),
 190         MARC::Field->new( '109', '', '', a => 'G. Orwell', b => 'bb', d => 'd', 9 => $authid1 ),
 191         MARC::Field->new( '245', '', '', a => 'My title' ),
 192         MARC::Field->new( '609', '', '', a => 'Orwell', 9 => "$authid1" ),
 193         MARC::Field->new( '609', '', '', a => 'Orwell', x => 'xx', 9 => "$authid1" ),
 194         MARC::Field->new( '611', '', '', a => 'Added for testing order' ),
 195         MARC::Field->new( '612', '', '', a => 'unrelated', 9 => 'other' ),
 196     );
 197     my ( $biblionumber ) = C4::Biblio::AddBiblio( $marc, '' );
 198     my $oldbiblio = C4::Biblio::GetMarcBiblio({ biblionumber => $biblionumber });
 199
 200     # Time to merge
 201     @linkedrecords = ( $biblionumber );
 202     my $retval = C4::AuthoritiesMarc::merge({ mergefrom => $authid1, MARCfrom => $auth1, mergeto => $authid2, MARCto => $auth2 });
 203     is( $retval, 1, 'We touched only one biblio' );
 204
 205     # Get new marc record for compares
 206     my $newbiblio = C4::Biblio::GetMarcBiblio({ biblionumber => $biblionumber });
 207     compare_fields( $oldbiblio, $newbiblio, {}, 'count' );
 208     # Exclude 109/609 and 112/612 in comparing order
 209     my $excl = { '109' => 1, '112' => 1, '609' => 1, '612' => 1 };
 210     compare_fields( $oldbiblio, $newbiblio, $excl, 'order' );
 211     # Check position of 612s in the new record
 212     my $full_order = join q/,/, map { $_->tag } $newbiblio->fields;
 213     is( $full_order =~ /611(,612){3}/, 1, 'Check position of all 612s' );
 214
 215     # Check some fields
 216     is( $newbiblio->field('003')->data,
 217         $oldbiblio->field('003')->data,
 218         'Check contents of a control field not expected to be touched' );
 219     is( $newbiblio->subfield( '245', 'a' ),
 220         $oldbiblio->subfield( '245', 'a' ),
 221         'Check contents of a data field not expected to be touched' );
 222     is( $newbiblio->subfield( '112', 'a' ),
 223         $auth2->subfield( '112', 'a' ), 'Check modified 112a' );
 224     is( $newbiblio->subfield( '112', 'c' ),
 225         $auth2->subfield( '112', 'c' ), 'Check new 112c' );
 226
 227     # Check 112b; this subfield was cleared when moving from 109 to 112
 228     # Note that this fix only applies to the current loose mode only
 229     is( $newbiblio->subfield( '112', 'b' ), undef,
 230         'Merge respects a cleared subfield in loose mode' );
 231
 232     # Check the original 612
 233     is( ( $newbiblio->field('612') )[0]->subfield( 'a' ),
 234         $oldbiblio->subfield( '612', 'a' ), 'Check untouched 612a' );
 235     # Check second 612
 236     is( ( $newbiblio->field('612') )[1]->subfield( 'a' ),
 237         $auth2->subfield( '112', 'a' ), 'Check second touched 612a' );
 238     # Check second new 612ax (in LOOSE mode)
 239     is( ( $newbiblio->field('612') )[2]->subfield( 'a' ),
 240         $auth2->subfield( '112', 'a' ), 'Check touched 612a' );
 241     is( ( $newbiblio->field('612') )[2]->subfield( 'x' ),
 242         ( $oldbiblio->field('609') )[1]->subfield('x'),
 243         'Check 612x' );
 244 };
 245
 246 subtest 'Merging authorities should handle deletes (BZ 18070)' => sub {
 247     plan tests => 2;
 248
 249     # Add authority and linked biblio, delete authority
 250     my $auth1 = MARC::Record->new;
 251     $auth1->append_fields( MARC::Field->new( '109', '', '', 'a' => 'DEL'));
 252     my $authid1 = AddAuthority( $auth1, undef, $authtype1 );
 253     my $bib1 = MARC::Record->new;
 254     $bib1->append_fields(
 255         MARC::Field->new( '245', '', '', a => 'test DEL' ),
 256         MARC::Field->new( '609', '', '', a => 'DEL', 9 => "$authid1" ),
 257     );
 258     my ( $biblionumber ) = C4::Biblio::AddBiblio( $bib1, '' );
 259     @linkedrecords = ( $biblionumber );
 260     DelAuthority({ authid => $authid1 }); # this triggers a merge call
 261
 262     # See what happened in the biblio record
 263     my $marc1 = C4::Biblio::GetMarcBiblio({ biblionumber => $biblionumber });
 264     is( $marc1->field('609'), undef, 'Field 609 should be gone too' );
 265
 266     # Now we simulate the delete as done in the cron job
 267     # First, restore auth1 and add 609 back in bib1
 268     $auth1 = MARC::Record->new;
 269     $auth1->append_fields( MARC::Field->new( '109', '', '', 'a' => 'DEL'));
 270     $authid1 = AddAuthority( $auth1, undef, $authtype1 );
 271     $marc1->append_fields(
 272         MARC::Field->new( '609', '', '', a => 'DEL', 9 => "$authid1" ),
 273     );
 274     ModBiblio( $marc1, $biblionumber, '' );
 275     # Instead of going through DelAuthority, we manually delete the auth
 276     # record and call merge afterwards.
 277     # This mimics deleting an authority and calling merge later in the
 278     # merge cron job.
 279     # We use the biblionumbers parameter here and unmock linked_biblionumbers.
 280     C4::Context->dbh->do( "DELETE FROM auth_header WHERE authid=?", undef, $authid1 );
 281     @linkedrecords = ();
 282     $mocks->{auth_mod}->unmock_all;
 283     merge({ mergefrom => $authid1, biblionumbers => [ $biblionumber ] });
 284     # Final check
 285     $marc1 = C4::Biblio::GetMarcBiblio({ biblionumber => $biblionumber });
 286     is( $marc1->field('609'), undef, 'Merge removed the 609 again even after deleting the authority record' );
 287 };
 288
 289 subtest "Test some specific postponed merge issues" => sub {
 290     plan tests => 4;
 291
 292     my $authmarc = MARC::Record->new;
 293     $authmarc->append_fields( MARC::Field->new( '109', '', '', 'a' => 'aa', b => 'bb' ));
 294     my $oldauthmarc = MARC::Record->new;
 295     $oldauthmarc->append_fields( MARC::Field->new( '112', '', '', c => 'cc' ));
 296     my $id = AddAuthority( $authmarc, undef, $authtype1 );
 297     my $biblio = MARC::Record->new;
 298     $biblio->append_fields(
 299         MARC::Field->new( '109', '', '', a => 'a1', 9 => $id ),
 300         MARC::Field->new( '612', '', '', a => 'a2', c => 'cc', 9 => $id+1 ),
 301         MARC::Field->new( '612', '', '', a => 'a3', 9 => $id+2 ),
 302     );
 303     my ( $biblionumber ) = C4::Biblio::AddBiblio( $biblio, '' );
 304
 305     # Merge A to B postponed, A is deleted (simulated by id+1)
 306     # This proves the !authtypefrom condition in sub merge
 307     # Additionally, we test clearing subfield
 308     merge({ mergefrom => $id + 1, MARCfrom => $oldauthmarc, mergeto => $id, MARCto => $authmarc, biblionumbers => [ $biblionumber ] });
 309     $biblio = C4::Biblio::GetMarcBiblio({ biblionumber => $biblionumber });
 310     is( $biblio->subfield('609', '9'), $id, '612 moved to 609' );
 311     is( $biblio->subfield('609', 'c'), undef, '609c cleared correctly' );
 312
 313     # Merge A to B postponed, delete B immediately (hits B < hits A)
 314     # This proves the !@record_to test in sub merge
 315     merge({ mergefrom => $id + 2, mergeto => $id + 1, MARCto => undef, biblionumbers => [ $biblionumber ] });
 316     $biblio = C4::Biblio::GetMarcBiblio({ biblionumber => $biblionumber });
 317     is( $biblio->field('612'), undef, 'Last 612 must be gone' );
 318
 319     # Show that we 'need' skip_merge; this example is far-fetched.
 320     # We *prove* by contradiction.
 321     # Suppose: Merge A to B postponed, and delete A would merge rightaway.
 322     # (You would need some special race condition with merge.pl to do so.)
 323     # The modify merge would be useless after that.
 324     @linkedrecords = ( $biblionumber );
 325     my $restored_mocks = set_mocks();
 326     DelAuthority({ authid => $id, skip_merge => 1 }); # delete A
 327     $restored_mocks->{auth_mod}->unmock_all;
 328     $biblio = C4::Biblio::GetMarcBiblio({ biblionumber => $biblionumber });
 329     is( $biblio->subfield('109', '9'), $id, 'If the 109 is no longer present, another modify merge would not bring it back' );
 330 };
 331
 332 subtest "Graceful resolution of missing reporting tag" => sub {
 333     plan tests => 2;
 334
 335     # Simulate merge with authority in Default fw without reporting tag
 336     # We expect data loss in biblio, but we keep $a and the reference in $9
 337     # in order to allow a future merge to restore data.
 338
 339     # Accomplish the above by clearing reporting tag in $authtype2
 340     my $fw2 = Koha::Authority::Types->find( $authtype2 );
 341     $fw2->auth_tag_to_report('')->store;
 342
 343     my $authmarc = MARC::Record->new;
 344     $authmarc->append_fields( MARC::Field->new( '109', '', '', 'a' => 'aa', b => 'bb' ));
 345     my $id1 = AddAuthority( $authmarc, undef, $authtype1 );
 346     my $id2 = AddAuthority( $authmarc, undef, $authtype2 );
 347
 348     my $biblio = MARC::Record->new;
 349     $biblio->append_fields(
 350         MARC::Field->new( '609', '', '', a => 'aa', 9 => $id1 ),
 351     );
 352     my ( $biblionumber ) = C4::Biblio::AddBiblio( $biblio, '' );
 353
 354     # Merge
 355     merge({ mergefrom => $id1, MARCfrom => $authmarc, mergeto => $id2, MARCto => $authmarc, biblionumbers => [ $biblionumber ] });
 356     $biblio = C4::Biblio::GetMarcBiblio({ biblionumber => $biblionumber });
 357     is( $biblio->subfield('612', '9'), $id2, 'id2 saved in $9' );
 358     is( $biblio->subfield('612', 'a'), ' ', 'Kept an empty $a too' );
 359
 360     $fw2->auth_tag_to_report('112')->store;
 361 };
 362
 363 subtest 'merge should not reorder too much' => sub {
 364     plan tests => 2;
 365
 366     # Back to loose mode
 367     t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose');
 368
 369     my $authmarc = MARC::Record->new;
 370     $authmarc->append_fields( MARC::Field->new( '109', '', '', 'a' => 'aa', b => 'bb' ));
 371     my $id = AddAuthority( $authmarc, undef, $authtype1 );
 372     my $biblio = MARC::Record->new;
 373     $biblio->append_fields(
 374         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
 375         MARC::Field->new( '609', '', '', i => 'in front', a => 'aa', c => 'after controlled block', 9 => $id ), # here $9 is already the last one
 376     );
 377     my ( $biblionumber ) = C4::Biblio::AddBiblio( $biblio, '' );
 378
 379     # Merge 109 and 609 and check order of subfields
 380     merge({ mergefrom => $id, MARCfrom => $authmarc, mergeto => $id, MARCto => $authmarc, biblionumbers => [ $biblionumber ] });
 381     my $biblio2 = C4::Biblio::GetMarcBiblio({ biblionumber => $biblionumber });
 382     my $subfields = [ map { $_->[0] } $biblio2->field('109')->subfields ];
 383     is_deeply( $subfields, [ 'i', 'a', 'b', 'c', '9' ], 'Merge only moved $9' );
 384     $subfields = [ map { $_->[0] } $biblio2->field('609')->subfields ];
 385     is_deeply( $subfields, [ 'i', 'a', 'b', 'c', '9' ], 'Order kept' );
 386 };
 387
 388 sub set_mocks {
 389     # After we removed the Zebra code from merge, we only need to mock
 390     # get_usage_count and linked_biblionumbers here.
 391
 392     my $mocks;
 393     $mocks->{auth_mod} = Test::MockModule->new( 'Koha::Authorities' );
 394     $mocks->{auth_mod}->mock( 'get_usage_count', sub {
 395          return scalar @linkedrecords;
 396     });
 397     $mocks->{auth_mod}->mock( 'linked_biblionumbers', sub {
 398          return @linkedrecords;
 399     });
 400     return $mocks;
 401 }
 402
 403 sub modify_framework {
 404     my $builder = t::lib::TestBuilder->new;
 405
 406     # create two auth types
 407     my $authtype1 = $builder->build({
 408         source => 'AuthType',
 409         value  => {
 410             auth_tag_to_report => '109',
 411         },
 412     });
 413     my $authtype2 = $builder->build({
 414         source => 'AuthType',
 415         value  => {
 416             auth_tag_to_report => '112',
 417         },
 418     });
 419
 420     # Link 109/609 to the first authtype
 421     $builder->build({
 422         source => 'MarcSubfieldStructure',
 423         value  => {
 424             tagfield => '109',
 425             tagsubfield => 'a',
 426             authtypecode => $authtype1->{authtypecode},
 427             frameworkcode => '',
 428         },
 429     });
 430     $builder->build({
 431         source => 'MarcSubfieldStructure',
 432         value  => {
 433             tagfield => '609',
 434             tagsubfield => 'a',
 435             authtypecode => $authtype1->{authtypecode},
 436             frameworkcode => '',
 437         },
 438     });
 439
 440     # Link 112/612 to the second authtype
 441     $builder->build({
 442         source => 'MarcSubfieldStructure',
 443         value  => {
 444             tagfield => '112',
 445             tagsubfield => 'a',
 446             authtypecode => $authtype2->{authtypecode},
 447             frameworkcode => '',
 448         },
 449     });
 450     $builder->build({
 451         source => 'MarcSubfieldStructure',
 452         value  => {
 453             tagfield => '612',
 454             tagsubfield => 'a',
 455             authtypecode => $authtype2->{authtypecode},
 456             frameworkcode => '',
 457         },
 458     });
 459
 460     return ( $authtype1->{authtypecode}, $authtype2->{authtypecode} );
 461 }
 462
 463 sub compare_fields { # mode parameter: order or count
 464     my ( $oldmarc, $newmarc, $exclude, $mode ) = @_;
 465     $exclude //= {};
 466     if( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
 467         # By default exclude field 100 from comparison in UNIMARC.
 468         # Will have been added by ModBiblio in merge.
 469         $exclude->{100} = 1;
 470     }
 471     my @oldfields = map { $exclude->{$_->tag} ? () : $_->tag } $oldmarc->fields;
 472     my @newfields = map { $exclude->{$_->tag} ? () : $_->tag } $newmarc->fields;
 473
 474     if( $mode eq 'count' ) {
 475         my $t;
 476         is( scalar @newfields, $t = @oldfields, "Number of fields still equal to $t" );
 477     } elsif( $mode eq 'order' ) {
 478         is( ( join q/,/, @newfields ), ( join q/,/, @oldfields ), 'Order of fields unchanged' );
 479     }
 480 }
 481
 482 $schema->storage->txn_rollback;