t/db_dependent/Authorities/Merge.t

   1 #!/usr/bin/perl
   2
   3 # Tests for C4::AuthoritiesMarc::merge
   4
   5 use Modern::Perl;
   6
   7 use Test::More tests => 5;
   8
   9 use Getopt::Long;
  10 use MARC::Record;
  11 use Test::MockModule;
  12 use Test::MockObject;
  13
  14 use t::lib::Mocks;
  15 use t::lib::TestBuilder;
  16
  17 use C4::Biblio;
  18 use Koha::Database;
  19
  20 BEGIN {
  21         use_ok('C4::AuthoritiesMarc');
  22 }
  23
  24 # Optionally change marc flavour
  25 my $marcflavour;
  26 GetOptions( 'flavour:s' => \$marcflavour );
  27 t::lib::Mocks::mock_preference( 'marcflavour', $marcflavour ) if $marcflavour;
  28
  29 my $schema  = Koha::Database->new->schema;
  30 $schema->storage->txn_begin;
  31
  32 # Global variables, mocking and framework modifications
  33 our ( @zebrarecords, $index );
  34 my $mocks = set_mocks();
  35 our ( $authtype1, $authtype2 ) = modify_framework();
  36
  37 subtest 'Test merge A1 to A2 (within same authtype)' => sub {
  38 # Tests originate from bug 11700
  39     plan tests => 9;
  40
  41     # Start in loose mode, although it actually does not matter here
  42     t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose');
  43
  44     # Add two authority records
  45     my $auth1 = MARC::Record->new;
  46     $auth1->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'George Orwell' ));
  47     my $authid1 = AddAuthority( $auth1, undef, $authtype1 );
  48     my $auth2 = MARC::Record->new;
  49     $auth2->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'G. Orwell' ));
  50     my $authid2 = AddAuthority( $auth2, undef, $authtype1 );
  51
  52     # Add two biblio records
  53     my $biblio1 = MARC::Record->new;
  54     $biblio1->append_fields( MARC::Field->new( '609', '0', '0', '9' => $authid1, 'a' => 'George Orwell' ));
  55     my ( $biblionumber1 ) = AddBiblio($biblio1, '');
  56     my $biblio2 = MARC::Record->new;
  57     $biblio2->append_fields( MARC::Field->new( '609', '0', '0', '9' => $authid2, 'a' => 'G. Orwell' ));
  58     my ( $biblionumber2 ) = AddBiblio($biblio2, '');
  59
  60     # Time to merge
  61     @zebrarecords = ( $biblio1, $biblio2 );
  62     $index = 0;
  63     my $rv = C4::AuthoritiesMarc::merge({ mergefrom => $authid2, MARCfrom => $auth2, mergeto => $authid1, MARCto => $auth1 });
  64     is( $rv, 1, 'We expect one biblio record (out of two) to be updated' );
  65
  66     # Check the results
  67     my $newbiblio1 = GetMarcBiblio($biblionumber1);
  68     compare_fields( $biblio1, $newbiblio1, {}, 'count' );
  69     compare_fields( $biblio1, $newbiblio1, {}, 'order' );
  70     is( $newbiblio1->subfield('609', '9'), $authid1, 'Check biblio1 609$9' );
  71     is( $newbiblio1->subfield('609', 'a'), 'George Orwell',
  72         'Check biblio1 609$a' );
  73     my $newbiblio2 = GetMarcBiblio($biblionumber2);
  74     compare_fields( $biblio2, $newbiblio2, {}, 'count' );
  75     compare_fields( $biblio2, $newbiblio2, {}, 'order' );
  76     is( $newbiblio2->subfield('609', '9'), $authid1, 'Check biblio2 609$9' );
  77     is( $newbiblio2->subfield('609', 'a'), 'George Orwell',
  78         'Check biblio2 609$a' );
  79 };
  80
  81 subtest 'Test merge A1 to modified A1, test strict mode' => sub {
  82 # Tests originate from bug 11700
  83     plan tests => 12;
  84
  85     # Simulate modifying an authority from auth1old to auth1new
  86     my $auth1old = MARC::Record->new;
  87     $auth1old->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'Bruce Wayne' ));
  88     my $auth1new = $auth1old->clone;
  89     $auth1new->field('109')->update( a => 'Batman' );
  90     my $authid1 = AddAuthority( $auth1new, undef, $authtype1 );
  91
  92     # Add two biblio records
  93     my $MARC1 = MARC::Record->new;
  94     $MARC1->append_fields( MARC::Field->new( '109', '', '', 'a' => 'Bruce Wayne', 'b' => '2014', '9' => $authid1 ));
  95     $MARC1->append_fields( MARC::Field->new( '245', '', '', 'a' => 'From the depths' ));
  96     $MARC1->append_fields( MARC::Field->new( '609', '', '', 'a' => 'Bruce Lee', 'b' => 'Should be cleared too', '9' => $authid1 ));
  97     $MARC1->append_fields( MARC::Field->new( '609', '', '', 'a' => 'Bruce Lee', 'c' => 'This is a duplicate to be removed in strict mode', '9' => $authid1 ));
  98     my $MARC2 = MARC::Record->new;
  99     $MARC2->append_fields( MARC::Field->new( '109', '', '', 'a' => 'Batman', '9' => $authid1 ));
 100     $MARC2->append_fields( MARC::Field->new( '245', '', '', 'a' => 'All the way to heaven' ));
 101     my ( $biblionumber1 ) = AddBiblio( $MARC1, '');
 102     my ( $biblionumber2 ) = AddBiblio( $MARC2, '');
 103
 104     # Time to merge in loose mode first
 105     @zebrarecords = ( $MARC1, $MARC2 );
 106     $index = 0;
 107     t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose');
 108     my $rv = C4::AuthoritiesMarc::merge({ mergefrom => $authid1, MARCfrom => $auth1old, mergeto => $authid1, MARCto => $auth1new });
 109     is( $rv, 2, 'Both records are updated now' );
 110
 111     #Check the results
 112     my $biblio1 = GetMarcBiblio($biblionumber1);
 113     compare_fields( $MARC1, $biblio1, {}, 'count' );
 114     compare_fields( $MARC1, $biblio1, {}, 'order' );
 115     is( $auth1new->field(109)->subfield('a'), $biblio1->field(109)->subfield('a'), 'Record1 values updated correctly' );
 116     my $biblio2 = GetMarcBiblio( $biblionumber2 );
 117     compare_fields( $MARC2, $biblio2, {}, 'count' );
 118     compare_fields( $MARC2, $biblio2, {}, 'order' );
 119     is( $auth1new->field(109)->subfield('a'), $biblio2->field(109)->subfield('a'), 'Record2 values updated correctly' );
 120     # This is only true in loose mode:
 121     is( $biblio1->field(109)->subfield('b'), $MARC1->field(109)->subfield('b'), 'Subfield not overwritten in loose mode');
 122
 123     # Merge again in strict mode
 124     t::lib::Mocks::mock_preference('AuthorityMergeMode', 'strict');
 125     ModBiblio( $MARC1, $biblionumber1, '' );
 126     @zebrarecords = ( $MARC1 );
 127     $index = 0;
 128     $rv = C4::AuthoritiesMarc::merge({ mergefrom => $authid1, MARCfrom => $auth1old, mergeto => $authid1, MARCto => $auth1new });
 129     $biblio1 = GetMarcBiblio($biblionumber1);
 130     is( $biblio1->field(109)->subfield('b'), undef, 'Subfield overwritten in strict mode' );
 131     compare_fields( $MARC1, $biblio1, { 609 => 1 }, 'count' );
 132     my @old609 = $MARC1->field('609');
 133     my @new609 = $biblio1->field('609');
 134     is( scalar @new609, @old609 - 1, 'strict mode should remove a duplicate 609' );
 135     is( $biblio1->field(609)->subfields,
 136         scalar($auth1new->field('109')->subfields) + 1,
 137         'Check number of subfields in strict mode for the remaining 609' );
 138         # Note: the +1 comes from the added subfield $9 in the biblio
 139 };
 140
 141 subtest 'Test merge A1 to B1 (changing authtype)' => sub {
 142 # Tests were aimed for bug 9988, moved to 17909 in adjusted form
 143 # Would not encourage this type of merge, but we should test what we offer
 144     plan tests => 13;
 145
 146     # Get back to loose mode now
 147     t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose');
 148
 149     # create two auth recs of different type
 150     my $auth1 = MARC::Record->new;
 151     $auth1->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'George Orwell', b => 'bb' ));
 152     my $authid1 = AddAuthority( $auth1, undef, $authtype1 );
 153     my $auth2 = MARC::Record->new;
 154     $auth2->append_fields( MARC::Field->new( '112', '0', '0', 'a' => 'Batman', c => 'cc' ));
 155     my $authid2 = AddAuthority($auth1, undef, $authtype2 );
 156
 157     # create a biblio with one 109 and two 609s to be touched
 158     # seems exceptional see bug 13760 comment10
 159     my $marc = MARC::Record->new;
 160     $marc->append_fields(
 161         MARC::Field->new( '003', 'some_003' ),
 162         MARC::Field->new( '109', '', '', a => 'G. Orwell', b => 'bb', d => 'd', 9 => $authid1 ),
 163         MARC::Field->new( '245', '', '', a => 'My title' ),
 164         MARC::Field->new( '609', '', '', a => 'Orwell', 9 => "$authid1" ),
 165         MARC::Field->new( '609', '', '', a => 'Orwell', x => 'xx', 9 => "$authid1" ),
 166         MARC::Field->new( '611', '', '', a => 'Added for testing order' ),
 167         MARC::Field->new( '612', '', '', a => 'unrelated', 9 => 'other' ),
 168     );
 169     my ( $biblionumber ) = C4::Biblio::AddBiblio( $marc, '' );
 170     my $oldbiblio = C4::Biblio::GetMarcBiblio( $biblionumber );
 171
 172     # Time to merge
 173     @zebrarecords = ( $marc );
 174     $index = 0;
 175     my $retval = C4::AuthoritiesMarc::merge({ mergefrom => $authid1, MARCfrom => $auth1, mergeto => $authid2, MARCto => $auth2 });
 176     is( $retval, 1, 'We touched only one biblio' );
 177
 178     # Get new marc record for compares
 179     my $newbiblio = C4::Biblio::GetMarcBiblio( $biblionumber );
 180     compare_fields( $oldbiblio, $newbiblio, {}, 'count' );
 181     # Exclude 109/609 and 112/612 in comparing order
 182     my $excl = { '109' => 1, '112' => 1, '609' => 1, '612' => 1 };
 183     compare_fields( $oldbiblio, $newbiblio, $excl, 'order' );
 184     # Check position of 612s in the new record
 185     my $full_order = join q/,/, map { $_->tag } $newbiblio->fields;
 186     is( $full_order =~ /611(,612){3}/, 1, 'Check position of all 612s' );
 187
 188     # Check some fields
 189     is( $newbiblio->field('003')->data,
 190         $oldbiblio->field('003')->data,
 191         'Check contents of a control field not expected to be touched' );
 192     is( $newbiblio->subfield( '245', 'a' ),
 193         $oldbiblio->subfield( '245', 'a' ),
 194         'Check contents of a data field not expected to be touched' );
 195     is( $newbiblio->subfield( '112', 'a' ),
 196         $auth2->subfield( '112', 'a' ), 'Check modified 112a' );
 197     is( $newbiblio->subfield( '112', 'c' ),
 198         $auth2->subfield( '112', 'c' ), 'Check new 112c' );
 199
 200     # Check 112b; this subfield was cleared when moving from 109 to 112
 201     # Note that this fix only applies to the current loose mode only
 202     is( $newbiblio->subfield( '112', 'b' ), undef,
 203         'Merge respects a cleared subfield in loose mode' );
 204
 205     # Check the original 612
 206     is( ( $newbiblio->field('612') )[0]->subfield( 'a' ),
 207         $oldbiblio->subfield( '612', 'a' ), 'Check untouched 612a' );
 208     # Check second 612
 209     is( ( $newbiblio->field('612') )[1]->subfield( 'a' ),
 210         $auth2->subfield( '112', 'a' ), 'Check second touched 612a' );
 211     # Check second new 612ax (in LOOSE mode)
 212     is( ( $newbiblio->field('612') )[2]->subfield( 'a' ),
 213         $auth2->subfield( '112', 'a' ), 'Check touched 612a' );
 214     is( ( $newbiblio->field('612') )[2]->subfield( 'x' ),
 215         ( $oldbiblio->field('609') )[1]->subfield('x'),
 216         'Check 612x' );
 217 };
 218
 219 subtest 'Merging authorities should handle deletes (BZ 18070)' => sub {
 220     plan tests => 2;
 221
 222     # For this test we need dontmerge OFF
 223     t::lib::Mocks::mock_preference('dontmerge', '0');
 224
 225     # Add authority and linked biblio, delete authority
 226     my $auth1 = MARC::Record->new;
 227     $auth1->append_fields( MARC::Field->new( '109', '', '', 'a' => 'DEL'));
 228     my $authid1 = AddAuthority( $auth1, undef, $authtype1 );
 229     my $bib1 = MARC::Record->new;
 230     $bib1->append_fields(
 231         MARC::Field->new( '245', '', '', a => 'test DEL' ),
 232         MARC::Field->new( '609', '', '', a => 'DEL', 9 => "$authid1" ),
 233     );
 234     my ( $biblionumber ) = C4::Biblio::AddBiblio( $bib1, '' );
 235     @zebrarecords = ( $bib1 );
 236     $index = 0;
 237     DelAuthority({ authid => $authid1 }); # this triggers a merge call
 238
 239     # See what happened in the biblio record
 240     my $marc1 = C4::Biblio::GetMarcBiblio( $biblionumber );
 241     is( $marc1->field('609'), undef, 'Field 609 should be gone too' );
 242
 243     # Now we simulate the delete as done from the cron job (with dontmerge)
 244     # First, restore auth1 and add 609 back in bib1
 245     $auth1 = MARC::Record->new;
 246     $auth1->append_fields( MARC::Field->new( '109', '', '', 'a' => 'DEL'));
 247     $authid1 = AddAuthority( $auth1, undef, $authtype1 );
 248     $marc1->append_fields(
 249         MARC::Field->new( '609', '', '', a => 'DEL', 9 => "$authid1" ),
 250     );
 251     ModBiblio( $marc1, $biblionumber, '' );
 252     # Instead of going through DelAuthority, we manually delete the auth
 253     # record and call merge afterwards.
 254     # This mimics deleting an authority and calling merge later in the
 255     # merge_authority.pl cron job (when dontmerge is enabled).
 256     C4::Context->dbh->do( "DELETE FROM auth_header WHERE authid=?", undef, $authid1 );
 257     @zebrarecords = ( $marc1 );
 258     $index = 0;
 259     merge({ mergefrom => $authid1 });
 260     # Final check
 261     $marc1 = C4::Biblio::GetMarcBiblio( $biblionumber );
 262     is( $marc1->field('609'), undef, 'Merge removed the 609 again even after deleting the authority record' );
 263 };
 264
 265 sub set_mocks {
 266     # Mock ZOOM objects: They do nothing actually
 267     # Get new_record_from_zebra to return the records
 268
 269     my $mocks;
 270     $mocks->{context_mod} = Test::MockModule->new( 'C4::Context' );
 271     $mocks->{search_mod} = Test::MockModule->new( 'C4::Search' );
 272     $mocks->{zoom_mod} = Test::MockModule->new( 'ZOOM::Query::CCL2RPN', no_auto => 1 );
 273     $mocks->{conn_obj} = Test::MockObject->new;
 274     $mocks->{zoom_obj} = Test::MockObject->new;
 275     $mocks->{zoom_record_obj} = Test::MockObject->new;
 276
 277     $mocks->{context_mod}->mock( 'Zconn', sub { $mocks->{conn_obj}; } );
 278     $mocks->{search_mod}->mock( 'new_record_from_zebra', sub {
 279          return if $index >= @zebrarecords;
 280          return $zebrarecords[ $index++ ];
 281     });
 282     $mocks->{zoom_mod}->mock( 'new', sub {} );
 283
 284     $mocks->{conn_obj}->mock( 'search', sub { $mocks->{zoom_obj}; } );
 285     $mocks->{zoom_obj}->mock( 'destroy', sub {} );
 286     $mocks->{zoom_obj}->mock( 'record', sub { $mocks->{zoom_record_obj}; } );
 287     $mocks->{zoom_obj}->mock( 'search', sub {} );
 288     $mocks->{zoom_obj}->mock( 'size', sub { @zebrarecords } );
 289     $mocks->{zoom_record_obj}->mock( 'raw', sub {} );
 290
 291     return $mocks;
 292 }
 293
 294 sub modify_framework {
 295     my $builder = t::lib::TestBuilder->new;
 296
 297     # create two auth types
 298     my $authtype1 = $builder->build({
 299         source => 'AuthType',
 300         value  => {
 301             auth_tag_to_report => '109',
 302         },
 303     });
 304     my $authtype2 = $builder->build({
 305         source => 'AuthType',
 306         value  => {
 307             auth_tag_to_report => '112',
 308         },
 309     });
 310
 311     # Link 109/609 to the first authtype
 312     $builder->build({
 313         source => 'MarcSubfieldStructure',
 314         value  => {
 315             tagfield => '109',
 316             tagsubfield => 'a',
 317             authtypecode => $authtype1->{authtypecode},
 318             frameworkcode => '',
 319         },
 320     });
 321     $builder->build({
 322         source => 'MarcSubfieldStructure',
 323         value  => {
 324             tagfield => '609',
 325             tagsubfield => 'a',
 326             authtypecode => $authtype1->{authtypecode},
 327             frameworkcode => '',
 328         },
 329     });
 330
 331     # Link 112/612 to the second authtype
 332     $builder->build({
 333         source => 'MarcSubfieldStructure',
 334         value  => {
 335             tagfield => '112',
 336             tagsubfield => 'a',
 337             authtypecode => $authtype2->{authtypecode},
 338             frameworkcode => '',
 339         },
 340     });
 341     $builder->build({
 342         source => 'MarcSubfieldStructure',
 343         value  => {
 344             tagfield => '612',
 345             tagsubfield => 'a',
 346             authtypecode => $authtype2->{authtypecode},
 347             frameworkcode => '',
 348         },
 349     });
 350
 351     return ( $authtype1->{authtypecode}, $authtype2->{authtypecode} );
 352 }
 353
 354 sub compare_fields { # mode parameter: order or count
 355     my ( $oldmarc, $newmarc, $exclude, $mode ) = @_;
 356     $exclude //= {};
 357     if( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
 358         # By default exclude field 100 from comparison in UNIMARC.
 359         # Will have been added by ModBiblio in merge.
 360         $exclude->{100} = 1;
 361     }
 362     my @oldfields = map { $exclude->{$_->tag} ? () : $_->tag } $oldmarc->fields;
 363     my @newfields = map { $exclude->{$_->tag} ? () : $_->tag } $newmarc->fields;
 364
 365     if( $mode eq 'count' ) {
 366         my $t;
 367         is( scalar @newfields, $t = @oldfields, "Number of fields still equal to $t" );
 368     } elsif( $mode eq 'order' ) {
 369         is( ( join q/,/, @newfields ), ( join q/,/, @oldfields ), 'Order of fields unchanged' );
 370     }
 371 }
 372
 373 $schema->storage->txn_rollback;