3 # Tests for C4::AuthoritiesMarc::merge
7 use Test::More tests => 4;
13 use t::lib::TestBuilder;
19 use_ok('C4::AuthoritiesMarc');
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;
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;
38 # Framework operations
39 my ( $authtype1, $authtype2 ) = modify_framework();
41 subtest 'Test merge A1 to A2 (within same authtype)' => sub {
42 # Tests originate from bug 11700
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 );
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, '');
62 @zebrarecords = ( $biblio1, $biblio2 );
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' );
68 my $newbiblio1 = GetMarcBiblio($biblionumber1);
69 compare_field_count( $biblio1, $newbiblio1, 1 );
70 compare_field_order( $biblio1, $newbiblio1, 1 );
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 compare_field_count( $biblio2, $newbiblio2, 1 );
76 compare_field_order( $biblio2, $newbiblio2, 1 );
77 is( $newbiblio2->subfield('609', '9'), $authid1, 'Check biblio2 609$9' );
78 is( $newbiblio2->subfield('609', 'a'), 'George Orwell',
79 'Check biblio2 609$a' );
82 subtest 'Test merge A1 to modified A1' => sub {
83 # Tests originate from bug 11700
86 # Simulate modifying an authority from auth1old to auth1new
87 my $auth1old = MARC::Record->new;
88 $auth1old->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'Bruce Wayne' ));
89 my $auth1new = $auth1old->clone;
90 $auth1new->field('109')->update( a => 'Batman' );
91 my $authid1 = AddAuthority( $auth1new, undef, $authtype1 );
93 # Add two biblio records
94 my $MARC1 = MARC::Record->new;
95 $MARC1->append_fields( MARC::Field->new( '109', '', '', 'a' => 'Bruce Wayne', 'b' => '2014', '9' => $authid1 ));
96 $MARC1->append_fields( MARC::Field->new( '245', '', '', 'a' => 'From the depths' ));
97 my $MARC2 = MARC::Record->new;
98 $MARC2->append_fields( MARC::Field->new( '109', '', '', 'a' => 'Batman', '9' => $authid1 ));
99 $MARC2->append_fields( MARC::Field->new( '245', '', '', 'a' => 'All the way to heaven' ));
100 my ( $biblionumber1 ) = AddBiblio( $MARC1, '');
101 my ( $biblionumber2 ) = AddBiblio( $MARC2, '');
104 @zebrarecords = ( $MARC1, $MARC2 );
106 my $rv = C4::AuthoritiesMarc::merge( $authid1, $auth1old, $authid1, $auth1new );
107 is( $rv, 2, 'Both records are updated now' );
110 my $biblio1 = GetMarcBiblio($biblionumber1);
111 compare_field_count( $MARC1, $biblio1, 1 );
112 compare_field_order( $MARC1, $biblio1, 1 );
113 is( $auth1new->field(109)->subfield('a'), $biblio1->field(109)->subfield('a'), 'Record1 values updated correctly' );
114 my $biblio2 = GetMarcBiblio( $biblionumber2 );
115 compare_field_count( $MARC2, $biblio2, 1 );
116 compare_field_order( $MARC2, $biblio2, 1 );
117 is( $auth1new->field(109)->subfield('a'), $biblio2->field(109)->subfield('a'), 'Record2 values updated correctly' );
119 # TODO Following test will change when we improve merge
120 # Will depend on a preference
121 is( $biblio1->field(109)->subfield('b'), $MARC1->field(109)->subfield('b'), 'Record not overwritten while merging');
124 subtest 'Test merge A1 to B1 (changing authtype)' => sub {
125 # Tests were aimed for bug 9988, moved to 17909 in adjusted form
126 # Would not encourage this type of merge, but we should test what we offer
127 # The merge routine still needs the fixes on bug 17913
130 # create two auth recs of different type
131 my $auth1 = MARC::Record->new;
132 $auth1->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'George Orwell', b => 'bb' ));
133 my $authid1 = AddAuthority( $auth1, undef, $authtype1 );
134 my $auth2 = MARC::Record->new;
135 $auth2->append_fields( MARC::Field->new( '112', '0', '0', 'a' => 'Batman', c => 'cc' ));
136 my $authid2 = AddAuthority($auth1, undef, $authtype2 );
138 # create a biblio with one 109 and two 609s to be touched
139 # seems exceptional see bug 13760 comment10
140 my $marc = MARC::Record->new;
141 $marc->append_fields(
142 MARC::Field->new( '003', 'some_003' ),
143 MARC::Field->new( '109', '', '', a => 'G. Orwell', b => 'bb', d => 'd', 9 => $authid1 ),
144 MARC::Field->new( '245', '', '', a => 'My title' ),
145 MARC::Field->new( '609', '', '', a => 'Orwell', 9 => "$authid1" ),
146 MARC::Field->new( '609', '', '', a => 'Orwell', x => 'xx', 9 => "$authid1" ),
147 MARC::Field->new( '611', '', '', a => 'Added for testing order' ),
148 MARC::Field->new( '612', '', '', a => 'unrelated', 9 => 'other' ),
150 my ( $biblionumber ) = C4::Biblio::AddBiblio( $marc, '' );
151 my $oldbiblio = C4::Biblio::GetMarcBiblio( $biblionumber );
154 @zebrarecords = ( $marc );
156 my $retval = C4::AuthoritiesMarc::merge( $authid1, $auth1, $authid2, $auth2 );
157 is( $retval, 1, 'We touched only one biblio' );
159 # Get new marc record for compares
160 my $newbiblio = C4::Biblio::GetMarcBiblio( $biblionumber );
161 compare_field_count( $oldbiblio, $newbiblio, 1 );
162 # TODO The following test will still fail; refined after 17913
163 compare_field_order( $oldbiblio, $newbiblio, 0 );
166 is( $newbiblio->field('003')->data,
167 $oldbiblio->field('003')->data,
168 'Check contents of a control field not expected to be touched' );
169 is( $newbiblio->subfield( '245', 'a' ),
170 $oldbiblio->subfield( '245', 'a' ),
171 'Check contents of a data field not expected to be touched' );
172 is( $newbiblio->subfield( '112', 'a' ),
173 $auth2->subfield( '112', 'a' ), 'Check modified 112a' );
174 is( $newbiblio->subfield( '112', 'c' ),
175 $auth2->subfield( '112', 'c' ), 'Check new 112c' );
177 #TODO Check the new 612s (after fix on 17913, they are 112s now)
178 is( $newbiblio->subfield( '612', 'a' ),
179 $oldbiblio->subfield( '612', 'a' ), 'Check untouched 612a' );
183 # Mock ZOOM objects: They do nothing actually
184 # Get new_record_from_zebra to return the records
186 $context_mod->mock( 'Zconn', sub { $conn_obj; } );
187 $search_mod->mock( 'new_record_from_zebra', sub {
188 return if $index >= @zebrarecords;
189 return $zebrarecords[ $index++ ];
191 $zoom_mod->mock( 'new', sub {} );
193 $conn_obj->mock( 'search', sub { $zoom_obj; } );
194 $zoom_obj->mock( 'destroy', sub {} );
195 $zoom_obj->mock( 'record', sub { $zoom_record_obj; } );
196 $zoom_obj->mock( 'search', sub {} );
197 $zoom_obj->mock( 'size', sub { @zebrarecords } );
198 $zoom_record_obj->mock( 'raw', sub {} );
201 sub modify_framework {
202 # create two auth types
203 my $authtype1 = $builder->build({
204 source => 'AuthType',
206 auth_tag_to_report => '109',
209 my $authtype2 = $builder->build({
210 source => 'AuthType',
212 auth_tag_to_report => '112',
216 # Link 109/609 to the first authtype
218 source => 'MarcSubfieldStructure',
222 authtypecode => $authtype1->{authtypecode},
227 source => 'MarcSubfieldStructure',
231 authtypecode => $authtype1->{authtypecode},
236 # Link 112/612 to the second authtype
238 source => 'MarcSubfieldStructure',
242 authtypecode => $authtype2->{authtypecode},
247 source => 'MarcSubfieldStructure',
251 authtypecode => $authtype2->{authtypecode},
256 return ( $authtype1->{authtypecode}, $authtype2->{authtypecode} );
259 sub compare_field_count {
260 my ( $oldmarc, $newmarc, $pass ) = @_;
263 is( scalar $newmarc->fields, $t = $oldmarc->fields, "Number of fields still equal to $t" );
265 isnt( scalar $newmarc->fields, $t = $oldmarc->fields, "Number of fields not equal to $t" );
269 sub compare_field_order {
270 my ( $oldmarc, $newmarc, $pass ) = @_;
272 is( ( join q/,/, map { $_->tag; } $newmarc->fields ),
273 ( join q/,/, map { $_->tag; } $oldmarc->fields ),
274 'Order of fields unchanged' );
276 isnt( ( join q/,/, map { $_->tag; } $newmarc->fields ),
277 ( join q/,/, map { $_->tag; } $oldmarc->fields ),
278 'Order of fields changed' );
282 $schema->storage->txn_rollback;