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 subtest 'Test merge A1 to A2 (withing same authtype)' => sub {
  39 # Tests originate from bug 11700
  40     plan tests => 5;
  41
  42     # Create authority type TEST_PERSO
  43     $dbh->do("INSERT INTO auth_types(authtypecode, authtypetext, auth_tag_to_report, summary) VALUES('TEST_PERSO', 'Personal Name', '109', 'Personal Names');");
  44     $dbh->do("INSERT INTO auth_tag_structure (authtypecode, tagfield, liblibrarian, libopac, repeatable, mandatory, authorised_value) VALUES('TEST_PERSO', '109', 'HEADING--PERSONAL NAME', 'HEADING--PERSONAL NAME', 0, 0, NULL)");
  45     $dbh->do("INSERT INTO auth_subfield_structure (authtypecode, tagfield, tagsubfield, liblibrarian, libopac, repeatable, mandatory, tab, authorised_value, value_builder, seealso, isurl, hidden, linkid, kohafield, frameworkcode) VALUES ('TEST_PERSO', '109', 'a', 'Personal name', 'Personal name', 0, 0, 1, NULL, NULL, '', 0, 0, '', '', '')");
  46
  47     my $auth1 = new MARC::Record;
  48     $auth1->append_fields(new MARC::Field('109', '0', '0', 'a' => 'George Orwell'));
  49     my $authid1 = AddAuthority($auth1, undef, 'TEST_PERSO');
  50     my $auth2 = new MARC::Record;
  51     $auth2->append_fields(new MARC::Field('109', '0', '0', 'a' => 'G. Orwell'));
  52     my $authid2 = AddAuthority($auth2, undef, 'TEST_PERSO');
  53
  54     $dbh->do("INSERT IGNORE INTO marc_subfield_structure(tagfield, tagsubfield, liblibrarian, libopac, repeatable, mandatory, kohafield, tab, authorised_value, authtypecode, value_builder, isurl, hidden, frameworkcode, seealso, link, defaultvalue) VALUES('609', 'a', 'Personal name', 'Personal name', 0, 0, '', 6, '', 'TEST_PERSO', '', NULL, 0, '', '', '', NULL)");
  55     $dbh->do("UPDATE marc_subfield_structure SET authtypecode = 'TEST_PERSO' WHERE tagfield='609' AND tagsubfield='a' AND frameworkcode='';");
  56     my $tagfields = $dbh->selectcol_arrayref("select distinct tagfield from marc_subfield_structure where authtypecode='TEST_PERSO'");
  57     my $biblio1 = new MARC::Record;
  58     $biblio1->append_fields(
  59         new MARC::Field('609', '0', '0', '9' => $authid1, 'a' => 'George Orwell')
  60     );
  61     my ( $biblionumber1 ) = AddBiblio($biblio1, '');
  62     my $biblio2 = new MARC::Record;
  63     $biblio2->append_fields(
  64         new MARC::Field('609', '0', '0', '9' => $authid2, 'a' => 'G. Orwell')
  65     );
  66     my ( $biblionumber2 ) = AddBiblio($biblio2, '');
  67
  68     @zebrarecords = ( $biblio1, $biblio2 );
  69     $index = 0;
  70     my $rv = C4::AuthoritiesMarc::merge( $authid2, $auth2, $authid1, $auth1 );
  71     is( $rv, 1, 'We expect one biblio record (out of two) to be updated' );
  72
  73     $biblio1 = GetMarcBiblio($biblionumber1);
  74     is($biblio1->subfield('609', '9'), $authid1, 'Check biblio1 609$9' );
  75     is($biblio1->subfield('609', 'a'), 'George Orwell',
  76         'Check biblio1 609$a' );
  77     $biblio2 = GetMarcBiblio($biblionumber2);
  78     is($biblio2->subfield('609', '9'), $authid1, 'Check biblio2 609$9' );
  79     is($biblio2->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 => 4;
  86
  87     $dbh->do("INSERT IGNORE INTO marc_subfield_structure(tagfield, tagsubfield, liblibrarian, libopac, repeatable, mandatory, kohafield, tab, authorised_value, authtypecode, value_builder, isurl, hidden, frameworkcode, seealso, link, defaultvalue) VALUES('109', 'a', 'Personal name', 'Personal name', 0, 0, '', 6, '', 'TEST_PERSO', '', NULL, 0, '', '', '', NULL)");
  88     $dbh->do("UPDATE marc_subfield_structure SET authtypecode = 'TEST_PERSO' WHERE tagfield='109' AND tagsubfield='a' AND frameworkcode='';");
  89
  90     my $auth1old = MARC::Record->new;
  91     $auth1old->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'Bruce Wayne' ));
  92     my $auth1new = $auth1old->clone;
  93     $auth1new->field('109')->update( a => 'Batman' );
  94     my $authid1 = AddAuthority( $auth1new, undef, 'TEST_PERSO' );
  95
  96     my $MARC1 = MARC::Record->new();
  97     $MARC1->append_fields( MARC::Field->new( '245', '', '', 'a' => 'From the depths' ));
  98     $MARC1->append_fields( MARC::Field->new( '109', '', '', 'a' => 'Bruce Wayne', 'b' => '2014', '9' => $authid1 ));
  99     my $MARC2 = MARC::Record->new();
 100     $MARC2->append_fields( MARC::Field->new( '245', '', '', 'a' => 'All the way to heaven' ));
 101     $MARC2->append_fields( MARC::Field->new( '109', '', '', 'a' => 'Batman', '9' => $authid1 ));
 102     my ( $biblionumber1 ) = AddBiblio( $MARC1, '');
 103     my ( $biblionumber2 ) = AddBiblio( $MARC2, '');
 104
 105     @zebrarecords = ( $MARC1, $MARC2 );
 106     $index = 0;
 107
 108     my $rv = C4::AuthoritiesMarc::merge( $authid1, $auth1old, $authid1, $auth1new );
 109     is( $rv, 2, 'Both records are updated now' );
 110
 111     my $biblio1 = GetMarcBiblio($biblionumber1);
 112     my $biblio2 = GetMarcBiblio($biblionumber1);
 113
 114     my $auth_field = $auth1new->field(109)->subfield('a');
 115     is( $auth_field, $biblio1->field(109)->subfield('a'), 'Record1 values updated correctly' );
 116     is( $auth_field, $biblio2->field(109)->subfield('a'), 'Record2 values updated correctly' );
 117
 118     # TODO Following test will change when we improve merge
 119     # Will depend on a preference
 120     is( $biblio1->field(109)->subfield('b'), $MARC1->field(109)->subfield('b'), 'Record not overwritten while merging');
 121 };
 122
 123 subtest 'Test merge A1 to B1 (changing authtype)' => sub {
 124 # Tests were aimed for bug 9988, moved to 17909 in adjusted form
 125 # Would not encourage this type of merge, but we should test what we offer
 126 # The merge routine still needs the fixes on bug 17913
 127     plan tests => 8;
 128
 129     # create another authtype
 130     my $authtype2 = $builder->build({
 131         source => 'AuthType',
 132         value  => {
 133             auth_tag_to_report => '112',
 134         },
 135     });
 136     # create two fields linked to this auth type
 137     $schema->resultset('MarcSubfieldStructure')->search({ tagfield => [ '112', '712' ] })->delete;
 138     $builder->build({
 139         source => 'MarcSubfieldStructure',
 140         value  => {
 141             tagfield => '112',
 142             tagsubfield => 'a',
 143             authtypecode => $authtype2->{authtypecode},
 144             frameworkcode => '',
 145         },
 146     });
 147     $builder->build({
 148         source => 'MarcSubfieldStructure',
 149         value  => {
 150             tagfield => '712',
 151             tagsubfield => 'a',
 152             authtypecode => $authtype2->{authtypecode},
 153             frameworkcode => '',
 154         },
 155     });
 156
 157     # create auth1 (from the earlier type)
 158     my $auth1 = MARC::Record->new;
 159     $auth1->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'George Orwell', b => 'bb' ));
 160     my $authid1 = AddAuthority($auth1, undef, 'TEST_PERSO');
 161     # create auth2 (new type)
 162     my $auth2 = MARC::Record->new;
 163     $auth2->append_fields( MARC::Field->new( '112', '0', '0', 'a' => 'Batman', c => 'cc' ));
 164     my $authid2 = AddAuthority($auth1, undef, $authtype2->{authtypecode} );
 165
 166     # create a biblio with one 109 and two 609s to be touched
 167     # seems exceptional see bug 13760 comment10
 168     my $marc = MARC::Record->new;
 169     $marc->append_fields(
 170         MARC::Field->new( '003', 'some_003' ),
 171         MARC::Field->new( '109', '', '', a => 'G. Orwell', b => 'bb', d => 'd', 9 => $authid1 ),
 172         MARC::Field->new( '245', '', '', a => 'My title' ),
 173         MARC::Field->new( '609', '', '', a => 'Orwell', 9 => "$authid1" ),
 174         MARC::Field->new( '609', '', '', a => 'Orwell', x => 'xx', 9 => "$authid1" ),
 175         MARC::Field->new( '611', '', '', a => 'Added for testing order' ),
 176         MARC::Field->new( '612', '', '', a => 'unrelated', 9 => 'other' ),
 177     );
 178     my ( $biblionumber ) = C4::Biblio::AddBiblio( $marc, '' );
 179     my $oldbiblio = C4::Biblio::GetMarcBiblio( $biblionumber );
 180
 181     @zebrarecords = ( $marc );
 182     $index = 0;
 183     my $retval = C4::AuthoritiesMarc::merge( $authid1, $auth1, $authid2, $auth2 );
 184     is( $retval, 1, 'We touched only one biblio' );
 185
 186     # Get new marc record for compares
 187     my $newbiblio = C4::Biblio::GetMarcBiblio( $biblionumber );
 188     compare_field_count( $oldbiblio, $newbiblio, 1 );
 189     # TODO The following test will still fail; refined after 17913
 190     compare_field_order( $oldbiblio, $newbiblio, 0 );
 191
 192     # Check some fields
 193     is( $newbiblio->field('003')->data,
 194         $oldbiblio->field('003')->data,
 195         'Check contents of a control field not expected to be touched' );
 196     is( $newbiblio->subfield( '245', 'a' ),
 197         $oldbiblio->subfield( '245', 'a' ),
 198         'Check contents of a data field not expected to be touched' );
 199     is( $newbiblio->subfield( '112', 'a' ),
 200         $auth2->subfield( '112', 'a' ), 'Check modified 112a' );
 201     is( $newbiblio->subfield( '112', 'c' ),
 202         $auth2->subfield( '112', 'c' ), 'Check new 112c' );
 203
 204     #TODO Check the new 612s (after fix on 17913, they are 112s now)
 205     is( $newbiblio->subfield( '612', 'a' ),
 206         $oldbiblio->subfield( '612', 'a' ), 'Check untouched 612a' );
 207 };
 208
 209 sub set_mocks {
 210     # Mock ZOOM objects: They do nothing actually
 211     # Get new_record_from_zebra to return the records
 212
 213     $context_mod->mock( 'Zconn', sub { $conn_obj; } );
 214     $search_mod->mock( 'new_record_from_zebra', sub {
 215          return if $index >= @zebrarecords;
 216          return $zebrarecords[ $index++ ];
 217     });
 218     $zoom_mod->mock( 'new', sub {} );
 219
 220     $conn_obj->mock( 'search', sub { $zoom_obj; } );
 221     $zoom_obj->mock( 'destroy', sub {} );
 222     $zoom_obj->mock( 'record', sub { $zoom_record_obj; } );
 223     $zoom_obj->mock( 'search', sub {} );
 224     $zoom_obj->mock( 'size', sub { @zebrarecords } );
 225     $zoom_record_obj->mock( 'raw', sub {} );
 226 }
 227
 228 sub compare_field_count {
 229     my ( $oldmarc, $newmarc, $pass ) = @_;
 230     my $t;
 231     if( $pass ) {
 232         is( scalar $newmarc->fields, $t = $oldmarc->fields, "Number of fields still equal to $t" );
 233     } else {
 234         isnt( scalar $newmarc->fields, $t = $oldmarc->fields, "Number of fields not equal to $t" );
 235     }
 236 }
 237
 238 sub compare_field_order {
 239     my ( $oldmarc, $newmarc, $pass ) = @_;
 240     if( $pass ) {
 241         is( ( join q/,/, map { $_->tag; } $newmarc->fields ),
 242             ( join q/,/, map { $_->tag; } $oldmarc->fields ),
 243             'Order of fields unchanged' );
 244     } else {
 245         isnt( ( join q/,/, map { $_->tag; } $newmarc->fields ),
 246             ( join q/,/, map { $_->tag; } $oldmarc->fields ),
 247             'Order of fields changed' );
 248     }
 249 }
 250
 251 $schema->storage->txn_rollback;