Lines 68-82
subtest 'Test merge A1 to A2 (within same authtype)' => sub {
Link Here
|
68 |
# Check the results |
68 |
# Check the results |
69 |
my $newbiblio1 = GetMarcBiblio($biblionumber1); |
69 |
my $newbiblio1 = GetMarcBiblio($biblionumber1); |
70 |
$newbiblio1->delete_fields( $newbiblio1->field('100') ); # fix for UNIMARC |
70 |
$newbiblio1->delete_fields( $newbiblio1->field('100') ); # fix for UNIMARC |
71 |
compare_field_count( $biblio1, $newbiblio1, 1 ); |
71 |
compare_field_count( $biblio1, $newbiblio1 ); |
72 |
compare_field_order( $biblio1, $newbiblio1, 1 ); |
72 |
compare_field_order( $biblio1, $newbiblio1 ); |
73 |
is( $newbiblio1->subfield('609', '9'), $authid1, 'Check biblio1 609$9' ); |
73 |
is( $newbiblio1->subfield('609', '9'), $authid1, 'Check biblio1 609$9' ); |
74 |
is( $newbiblio1->subfield('609', 'a'), 'George Orwell', |
74 |
is( $newbiblio1->subfield('609', 'a'), 'George Orwell', |
75 |
'Check biblio1 609$a' ); |
75 |
'Check biblio1 609$a' ); |
76 |
my $newbiblio2 = GetMarcBiblio($biblionumber2); |
76 |
my $newbiblio2 = GetMarcBiblio($biblionumber2); |
77 |
$newbiblio2->delete_fields( $newbiblio2->field('100') ); # fix for UNIMARC |
77 |
$newbiblio2->delete_fields( $newbiblio2->field('100') ); # fix for UNIMARC |
78 |
compare_field_count( $biblio2, $newbiblio2, 1 ); |
78 |
compare_field_count( $biblio2, $newbiblio2 ); |
79 |
compare_field_order( $biblio2, $newbiblio2, 1 ); |
79 |
compare_field_order( $biblio2, $newbiblio2 ); |
80 |
is( $newbiblio2->subfield('609', '9'), $authid1, 'Check biblio2 609$9' ); |
80 |
is( $newbiblio2->subfield('609', '9'), $authid1, 'Check biblio2 609$9' ); |
81 |
is( $newbiblio2->subfield('609', 'a'), 'George Orwell', |
81 |
is( $newbiblio2->subfield('609', 'a'), 'George Orwell', |
82 |
'Check biblio2 609$a' ); |
82 |
'Check biblio2 609$a' ); |
Lines 113-125
subtest 'Test merge A1 to modified A1' => sub {
Link Here
|
113 |
#Check the results |
113 |
#Check the results |
114 |
my $biblio1 = GetMarcBiblio($biblionumber1); |
114 |
my $biblio1 = GetMarcBiblio($biblionumber1); |
115 |
$biblio1->delete_fields( $biblio1->field('100') ); # quick fix for UNIMARC |
115 |
$biblio1->delete_fields( $biblio1->field('100') ); # quick fix for UNIMARC |
116 |
compare_field_count( $MARC1, $biblio1, 1 ); |
116 |
compare_field_count( $MARC1, $biblio1 ); |
117 |
compare_field_order( $MARC1, $biblio1, 1 ); |
117 |
compare_field_order( $MARC1, $biblio1 ); |
118 |
is( $auth1new->field(109)->subfield('a'), $biblio1->field(109)->subfield('a'), 'Record1 values updated correctly' ); |
118 |
is( $auth1new->field(109)->subfield('a'), $biblio1->field(109)->subfield('a'), 'Record1 values updated correctly' ); |
119 |
my $biblio2 = GetMarcBiblio( $biblionumber2 ); |
119 |
my $biblio2 = GetMarcBiblio( $biblionumber2 ); |
120 |
$biblio2->delete_fields( $biblio2->field('100') ); # quick fix for UNIMARC |
120 |
$biblio2->delete_fields( $biblio2->field('100') ); # quick fix for UNIMARC |
121 |
compare_field_count( $MARC2, $biblio2, 1 ); |
121 |
compare_field_count( $MARC2, $biblio2 ); |
122 |
compare_field_order( $MARC2, $biblio2, 1 ); |
122 |
compare_field_order( $MARC2, $biblio2 ); |
123 |
is( $auth1new->field(109)->subfield('a'), $biblio2->field(109)->subfield('a'), 'Record2 values updated correctly' ); |
123 |
is( $auth1new->field(109)->subfield('a'), $biblio2->field(109)->subfield('a'), 'Record2 values updated correctly' ); |
124 |
# This is only true in loose mode: |
124 |
# This is only true in loose mode: |
125 |
is( $biblio1->field(109)->subfield('b'), $MARC1->field(109)->subfield('b'), 'Subfield not overwritten in loose mode'); |
125 |
is( $biblio1->field(109)->subfield('b'), $MARC1->field(109)->subfield('b'), 'Subfield not overwritten in loose mode'); |
Lines 139-145
subtest 'Test merge A1 to B1 (changing authtype)' => sub {
Link Here
|
139 |
# Tests were aimed for bug 9988, moved to 17909 in adjusted form |
139 |
# Tests were aimed for bug 9988, moved to 17909 in adjusted form |
140 |
# Would not encourage this type of merge, but we should test what we offer |
140 |
# Would not encourage this type of merge, but we should test what we offer |
141 |
# The merge routine still needs the fixes on bug 17913 |
141 |
# The merge routine still needs the fixes on bug 17913 |
142 |
plan tests => 8; |
142 |
plan tests => 12; |
143 |
|
143 |
|
144 |
# create two auth recs of different type |
144 |
# create two auth recs of different type |
145 |
my $auth1 = MARC::Record->new; |
145 |
my $auth1 = MARC::Record->new; |
Lines 174-182
subtest 'Test merge A1 to B1 (changing authtype)' => sub {
Link Here
|
174 |
# Get new marc record for compares |
174 |
# Get new marc record for compares |
175 |
my $newbiblio = C4::Biblio::GetMarcBiblio( $biblionumber ); |
175 |
my $newbiblio = C4::Biblio::GetMarcBiblio( $biblionumber ); |
176 |
$newbiblio->delete_fields( $newbiblio->field('100') ); # fix for UNIMARC |
176 |
$newbiblio->delete_fields( $newbiblio->field('100') ); # fix for UNIMARC |
177 |
compare_field_count( $oldbiblio, $newbiblio, 1 ); |
177 |
compare_field_count( $oldbiblio, $newbiblio ); |
178 |
# TODO The following test will still fail; refined after 17913 |
178 |
# Exclude 109/609 and 112/612 in comparing order |
179 |
compare_field_order( $oldbiblio, $newbiblio, 0 ); |
179 |
compare_field_order( $oldbiblio, $newbiblio, |
|
|
180 |
{ '109' => 1, '112' => 1, '609' => 1, '612' => 1 }, |
181 |
); |
182 |
# Check position of 612s in the new record |
183 |
my $full_order = join q/,/, map { $_->tag } $newbiblio->fields; |
184 |
is( $full_order =~ /611(,612){3}/, 1, 'Check position of all 612s' ); |
180 |
|
185 |
|
181 |
# Check some fields |
186 |
# Check some fields |
182 |
is( $newbiblio->field('003')->data, |
187 |
is( $newbiblio->field('003')->data, |
Lines 190-198
subtest 'Test merge A1 to B1 (changing authtype)' => sub {
Link Here
|
190 |
is( $newbiblio->subfield( '112', 'c' ), |
195 |
is( $newbiblio->subfield( '112', 'c' ), |
191 |
$auth2->subfield( '112', 'c' ), 'Check new 112c' ); |
196 |
$auth2->subfield( '112', 'c' ), 'Check new 112c' ); |
192 |
|
197 |
|
193 |
#TODO Check the new 612s (after fix on 17913, they are 112s now) |
198 |
# Check the original 612 |
194 |
is( $newbiblio->subfield( '612', 'a' ), |
199 |
is( ( $newbiblio->field('612') )[0]->subfield( 'a' ), |
195 |
$oldbiblio->subfield( '612', 'a' ), 'Check untouched 612a' ); |
200 |
$oldbiblio->subfield( '612', 'a' ), 'Check untouched 612a' ); |
|
|
201 |
# Check second 612 |
202 |
is( ( $newbiblio->field('612') )[1]->subfield( 'a' ), |
203 |
$auth2->subfield( '112', 'a' ), 'Check second touched 612a' ); |
204 |
# Check second new 612ax (in LOOSE mode) |
205 |
is( ( $newbiblio->field('612') )[2]->subfield( 'a' ), |
206 |
$auth2->subfield( '112', 'a' ), 'Check touched 612a' ); |
207 |
is( ( $newbiblio->field('612') )[2]->subfield( 'x' ), |
208 |
( $oldbiblio->field('609') )[1]->subfield('x'), |
209 |
'Check 612x' ); |
196 |
}; |
210 |
}; |
197 |
|
211 |
|
198 |
sub set_mocks { |
212 |
sub set_mocks { |
Lines 273-298
sub modify_framework {
Link Here
|
273 |
} |
287 |
} |
274 |
|
288 |
|
275 |
sub compare_field_count { |
289 |
sub compare_field_count { |
276 |
my ( $oldmarc, $newmarc, $pass ) = @_; |
290 |
my ( $oldmarc, $newmarc ) = @_; |
277 |
my $t; |
291 |
my $t; |
278 |
if( $pass ) { |
292 |
is( scalar $newmarc->fields, $t = $oldmarc->fields, "Number of fields still equal to $t" ); |
279 |
is( scalar $newmarc->fields, $t = $oldmarc->fields, "Number of fields still equal to $t" ); |
|
|
280 |
} else { |
281 |
isnt( scalar $newmarc->fields, $t = $oldmarc->fields, "Number of fields not equal to $t" ); |
282 |
} |
283 |
} |
293 |
} |
284 |
|
294 |
|
285 |
sub compare_field_order { |
295 |
sub compare_field_order { |
286 |
my ( $oldmarc, $newmarc, $pass ) = @_; |
296 |
my ( $oldmarc, $newmarc, $exclude ) = @_; |
287 |
if( $pass ) { |
297 |
$exclude //= {}; |
288 |
is( ( join q/,/, map { $_->tag; } $newmarc->fields ), |
298 |
my @oldfields = map { $exclude->{$_->tag} ? () : $_->tag } $oldmarc->fields; |
289 |
( join q/,/, map { $_->tag; } $oldmarc->fields ), |
299 |
my @newfields = map { $exclude->{$_->tag} ? () : $_->tag } $newmarc->fields; |
290 |
'Order of fields unchanged' ); |
300 |
is( ( join q/,/, @newfields ), ( join q/,/, @oldfields ), |
291 |
} else { |
301 |
'Order of fields unchanged' ); |
292 |
isnt( ( join q/,/, map { $_->tag; } $newmarc->fields ), |
|
|
293 |
( join q/,/, map { $_->tag; } $oldmarc->fields ), |
294 |
'Order of fields changed' ); |
295 |
} |
296 |
} |
302 |
} |
297 |
|
303 |
|
298 |
$schema->storage->txn_rollback; |
304 |
$schema->storage->txn_rollback; |
299 |
- |
|
|