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 => 4;
   8
   9 use MARC::Record;
  10 use Test::MockModule;
  11 use Test::MockObject;
  12
  13 use t::lib::Mocks;
  14 use t::lib::TestBuilder;
  15
  16 use C4::Biblio;
  17 use Koha::Database;
  18
  19 BEGIN {
  20         use_ok('C4::AuthoritiesMarc');
  21 }
  22
  23 my $schema  = Koha::Database->new->schema;
  24 $schema->storage->txn_begin;
  25 my $dbh = C4::Context->dbh;
  26
  27 # Some advanced mocking :)
  28 my ( @zebrarecords, $index );
  29 my $context_mod = Test::MockModule->new( 'C4::Context' );
  30 my $search_mod = Test::MockModule->new( 'C4::Search' );
  31 my $zoom_mod = Test::MockModule->new( 'ZOOM::Query::CCL2RPN', no_auto => 1 );
  32 my $conn_obj = Test::MockObject->new;
  33 my $zoom_obj = Test::MockObject->new;
  34 my $zoom_record_obj = Test::MockObject->new;
  35 set_mocks();
  36
  37 # Framework operations
  38 my ( $authtype1, $authtype2 ) = modify_framework();
  39
  40 subtest 'Test merge A1 to A2 (within same authtype)' => sub {
  41 # Tests originate from bug 11700
  42     plan tests => 9;
  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( $authid2, $auth2, $authid1, $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     $newbiblio1->delete_fields( $newbiblio1->field('100') ); # fix for UNIMARC
  69     compare_field_count( $biblio1, $newbiblio1 );
  70     compare_field_order( $biblio1, $newbiblio1 );
  71     is( $newbiblio1->subfield('609', '9'), $authid1, 'Check biblio1 609$9' );
  72     is( $newbiblio1->subfield('609', 'a'), 'George Orwell',
  73         'Check biblio1 609$a' );
  74     my $newbiblio2 = GetMarcBiblio($biblionumber2);
  75     $newbiblio2->delete_fields( $newbiblio2->field('100') ); # fix for UNIMARC
  76     compare_field_count( $biblio2, $newbiblio2 );
  77     compare_field_order( $biblio2, $newbiblio2 );
  78     is( $newbiblio2->subfield('609', '9'), $authid1, 'Check biblio2 609$9' );
  79     is( $newbiblio2->subfield('609', 'a'), 'George Orwell',
  80         'Check biblio2 609$a' );
  81 };
  82
  83 subtest 'Test merge A1 to modified A1' => sub {
  84 # Tests originate from bug 11700
  85     plan tests => 9;
  86
  87     # Simulate modifying an authority from auth1old to auth1new
  88     my $auth1old = MARC::Record->new;
  89     $auth1old->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'Bruce Wayne' ));
  90     my $auth1new = $auth1old->clone;
  91     $auth1new->field('109')->update( a => 'Batman' );
  92     my $authid1 = AddAuthority( $auth1new, undef, $authtype1 );
  93
  94     # Add two biblio records
  95     my $MARC1 = MARC::Record->new;
  96     $MARC1->append_fields( MARC::Field->new( '109', '', '', 'a' => 'Bruce Wayne', 'b' => '2014', '9' => $authid1 ));
  97     $MARC1->append_fields( MARC::Field->new( '245', '', '', 'a' => 'From the depths' ));
  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
 105     @zebrarecords = ( $MARC1, $MARC2 );
 106     $index = 0;
 107     t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose');
 108     my $rv = C4::AuthoritiesMarc::merge( $authid1, $auth1old, $authid1, $auth1new );
 109     is( $rv, 2, 'Both records are updated now' );
 110
 111     #Check the results
 112     my $biblio1 = GetMarcBiblio($biblionumber1);
 113     $biblio1->delete_fields( $biblio1->field('100') ); # quick fix for UNIMARC
 114     compare_field_count( $MARC1, $biblio1 );
 115     compare_field_order( $MARC1, $biblio1 );
 116     is( $auth1new->field(109)->subfield('a'), $biblio1->field(109)->subfield('a'), 'Record1 values updated correctly' );
 117     my $biblio2 = GetMarcBiblio( $biblionumber2 );
 118     $biblio2->delete_fields( $biblio2->field('100') ); # quick fix for UNIMARC
 119     compare_field_count( $MARC2, $biblio2 );
 120     compare_field_order( $MARC2, $biblio2 );
 121     is( $auth1new->field(109)->subfield('a'), $biblio2->field(109)->subfield('a'), 'Record2 values updated correctly' );
 122     # This is only true in loose mode:
 123     is( $biblio1->field(109)->subfield('b'), $MARC1->field(109)->subfield('b'), 'Subfield not overwritten in loose mode');
 124
 125     # Merge again in strict mode
 126     t::lib::Mocks::mock_preference('AuthorityMergeMode', 'strict');
 127     ModBiblio( $MARC1, $biblionumber1, '' );
 128     @zebrarecords = ( $MARC1 );
 129     $index = 0;
 130     $rv = C4::AuthoritiesMarc::merge( $authid1, $auth1old, $authid1, $auth1new );
 131     $biblio1 = GetMarcBiblio($biblionumber1);
 132     is( $biblio1->field(109)->subfield('b'), undef, 'Subfield overwritten in strict mode' );
 133     t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose');
 134 };
 135
 136 subtest 'Test merge A1 to B1 (changing authtype)' => sub {
 137 # Tests were aimed for bug 9988, moved to 17909 in adjusted form
 138 # Would not encourage this type of merge, but we should test what we offer
 139 # The merge routine still needs the fixes on bug 17913
 140     plan tests => 12;
 141
 142     # create two auth recs of different type
 143     my $auth1 = MARC::Record->new;
 144     $auth1->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'George Orwell', b => 'bb' ));
 145     my $authid1 = AddAuthority( $auth1, undef, $authtype1 );
 146     my $auth2 = MARC::Record->new;
 147     $auth2->append_fields( MARC::Field->new( '112', '0', '0', 'a' => 'Batman', c => 'cc' ));
 148     my $authid2 = AddAuthority($auth1, undef, $authtype2 );
 149
 150     # create a biblio with one 109 and two 609s to be touched
 151     # seems exceptional see bug 13760 comment10
 152     my $marc = MARC::Record->new;
 153     $marc->append_fields(
 154         MARC::Field->new( '003', 'some_003' ),
 155         MARC::Field->new( '109', '', '', a => 'G. Orwell', b => 'bb', d => 'd', 9 => $authid1 ),
 156         MARC::Field->new( '245', '', '', a => 'My title' ),
 157         MARC::Field->new( '609', '', '', a => 'Orwell', 9 => "$authid1" ),
 158         MARC::Field->new( '609', '', '', a => 'Orwell', x => 'xx', 9 => "$authid1" ),
 159         MARC::Field->new( '611', '', '', a => 'Added for testing order' ),
 160         MARC::Field->new( '612', '', '', a => 'unrelated', 9 => 'other' ),
 161     );
 162     my ( $biblionumber ) = C4::Biblio::AddBiblio( $marc, '' );
 163     my $oldbiblio = C4::Biblio::GetMarcBiblio( $biblionumber );
 164     $oldbiblio->delete_fields( $oldbiblio->field('100') ); # fix for UNIMARC
 165
 166     # Time to merge
 167     @zebrarecords = ( $marc );
 168     $index = 0;
 169     my $retval = C4::AuthoritiesMarc::merge( $authid1, $auth1, $authid2, $auth2 );
 170     is( $retval, 1, 'We touched only one biblio' );
 171
 172     # Get new marc record for compares
 173     my $newbiblio = C4::Biblio::GetMarcBiblio( $biblionumber );
 174     $newbiblio->delete_fields( $newbiblio->field('100') ); # fix for UNIMARC
 175     compare_field_count( $oldbiblio, $newbiblio );
 176     # Exclude 109/609 and 112/612 in comparing order
 177     compare_field_order( $oldbiblio, $newbiblio,
 178         { '109' => 1, '112' => 1, '609' => 1, '612' => 1 },
 179     );
 180     # Check position of 612s in the new record
 181     my $full_order = join q/,/, map { $_->tag } $newbiblio->fields;
 182     is( $full_order =~ /611(,612){3}/, 1, 'Check position of all 612s' );
 183
 184     # Check some fields
 185     is( $newbiblio->field('003')->data,
 186         $oldbiblio->field('003')->data,
 187         'Check contents of a control field not expected to be touched' );
 188     is( $newbiblio->subfield( '245', 'a' ),
 189         $oldbiblio->subfield( '245', 'a' ),
 190         'Check contents of a data field not expected to be touched' );
 191     is( $newbiblio->subfield( '112', 'a' ),
 192         $auth2->subfield( '112', 'a' ), 'Check modified 112a' );
 193     is( $newbiblio->subfield( '112', 'c' ),
 194         $auth2->subfield( '112', 'c' ), 'Check new 112c' );
 195
 196     # Check the original 612
 197     is( ( $newbiblio->field('612') )[0]->subfield( 'a' ),
 198         $oldbiblio->subfield( '612', 'a' ), 'Check untouched 612a' );
 199     # Check second 612
 200     is( ( $newbiblio->field('612') )[1]->subfield( 'a' ),
 201         $auth2->subfield( '112', 'a' ), 'Check second touched 612a' );
 202     # Check second new 612ax (in LOOSE mode)
 203     is( ( $newbiblio->field('612') )[2]->subfield( 'a' ),
 204         $auth2->subfield( '112', 'a' ), 'Check touched 612a' );
 205     is( ( $newbiblio->field('612') )[2]->subfield( 'x' ),
 206         ( $oldbiblio->field('609') )[1]->subfield('x'),
 207         'Check 612x' );
 208 };
 209
 210 sub set_mocks {
 211     # Mock ZOOM objects: They do nothing actually
 212     # Get new_record_from_zebra to return the records
 213
 214     $context_mod->mock( 'Zconn', sub { $conn_obj; } );
 215     $search_mod->mock( 'new_record_from_zebra', sub {
 216          return if $index >= @zebrarecords;
 217          return $zebrarecords[ $index++ ];
 218     });
 219     $zoom_mod->mock( 'new', sub {} );
 220
 221     $conn_obj->mock( 'search', sub { $zoom_obj; } );
 222     $zoom_obj->mock( 'destroy', sub {} );
 223     $zoom_obj->mock( 'record', sub { $zoom_record_obj; } );
 224     $zoom_obj->mock( 'search', sub {} );
 225     $zoom_obj->mock( 'size', sub { @zebrarecords } );
 226     $zoom_record_obj->mock( 'raw', sub {} );
 227 }
 228
 229 sub modify_framework {
 230     my $builder = t::lib::TestBuilder->new;
 231
 232     # create two auth types
 233     my $authtype1 = $builder->build({
 234         source => 'AuthType',
 235         value  => {
 236             auth_tag_to_report => '109',
 237         },
 238     });
 239     my $authtype2 = $builder->build({
 240         source => 'AuthType',
 241         value  => {
 242             auth_tag_to_report => '112',
 243         },
 244     });
 245
 246     # Link 109/609 to the first authtype
 247     $builder->build({
 248         source => 'MarcSubfieldStructure',
 249         value  => {
 250             tagfield => '109',
 251             tagsubfield => 'a',
 252             authtypecode => $authtype1->{authtypecode},
 253             frameworkcode => '',
 254         },
 255     });
 256     $builder->build({
 257         source => 'MarcSubfieldStructure',
 258         value  => {
 259             tagfield => '609',
 260             tagsubfield => 'a',
 261             authtypecode => $authtype1->{authtypecode},
 262             frameworkcode => '',
 263         },
 264     });
 265
 266     # Link 112/612 to the second authtype
 267     $builder->build({
 268         source => 'MarcSubfieldStructure',
 269         value  => {
 270             tagfield => '112',
 271             tagsubfield => 'a',
 272             authtypecode => $authtype2->{authtypecode},
 273             frameworkcode => '',
 274         },
 275     });
 276     $builder->build({
 277         source => 'MarcSubfieldStructure',
 278         value  => {
 279             tagfield => '612',
 280             tagsubfield => 'a',
 281             authtypecode => $authtype2->{authtypecode},
 282             frameworkcode => '',
 283         },
 284     });
 285
 286     return ( $authtype1->{authtypecode}, $authtype2->{authtypecode} );
 287 }
 288
 289 sub compare_field_count {
 290     my ( $oldmarc, $newmarc ) = @_;
 291     my $t;
 292     is( scalar $newmarc->fields, $t = $oldmarc->fields, "Number of fields still equal to $t" );
 293 }
 294
 295 sub compare_field_order {
 296     my ( $oldmarc, $newmarc, $exclude ) = @_;
 297     $exclude //= {};
 298     my @oldfields = map { $exclude->{$_->tag} ? () : $_->tag } $oldmarc->fields;
 299     my @newfields = map { $exclude->{$_->tag} ? () : $_->tag } $newmarc->fields;
 300     is( ( join q/,/, @newfields ), ( join q/,/, @oldfields ),
 301         'Order of fields unchanged' );
 302 }
 303
 304 $schema->storage->txn_rollback;