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