Lines 6-11
use Modern::Perl;
Link Here
|
6 |
|
6 |
|
7 |
use Test::More tests => 4; |
7 |
use Test::More tests => 4; |
8 |
|
8 |
|
|
|
9 |
use Getopt::Long; |
9 |
use MARC::Record; |
10 |
use MARC::Record; |
10 |
use Test::MockModule; |
11 |
use Test::MockModule; |
11 |
use Test::MockObject; |
12 |
use Test::MockObject; |
Lines 20-25
BEGIN {
Link Here
|
20 |
use_ok('C4::AuthoritiesMarc'); |
21 |
use_ok('C4::AuthoritiesMarc'); |
21 |
} |
22 |
} |
22 |
|
23 |
|
|
|
24 |
# Optionally change marc flavour |
25 |
my $marcflavour; |
26 |
GetOptions( 'flavour:s' => \$marcflavour ); |
27 |
t::lib::Mocks::mock_preference( 'marcflavour', $marcflavour ) if $marcflavour; |
28 |
|
23 |
my $schema = Koha::Database->new->schema; |
29 |
my $schema = Koha::Database->new->schema; |
24 |
$schema->storage->txn_begin; |
30 |
$schema->storage->txn_begin; |
25 |
my $dbh = C4::Context->dbh; |
31 |
my $dbh = C4::Context->dbh; |
Lines 68-83
subtest 'Test merge A1 to A2 (within same authtype)' => sub {
Link Here
|
68 |
|
74 |
|
69 |
# Check the results |
75 |
# Check the results |
70 |
my $newbiblio1 = GetMarcBiblio($biblionumber1); |
76 |
my $newbiblio1 = GetMarcBiblio($biblionumber1); |
71 |
$newbiblio1->delete_fields( $newbiblio1->field('100') ); # fix for UNIMARC |
77 |
compare_fields( $biblio1, $newbiblio1, {}, 'count' ); |
72 |
compare_field_count( $biblio1, $newbiblio1 ); |
78 |
compare_fields( $biblio1, $newbiblio1, {}, 'order' ); |
73 |
compare_field_order( $biblio1, $newbiblio1 ); |
|
|
74 |
is( $newbiblio1->subfield('609', '9'), $authid1, 'Check biblio1 609$9' ); |
79 |
is( $newbiblio1->subfield('609', '9'), $authid1, 'Check biblio1 609$9' ); |
75 |
is( $newbiblio1->subfield('609', 'a'), 'George Orwell', |
80 |
is( $newbiblio1->subfield('609', 'a'), 'George Orwell', |
76 |
'Check biblio1 609$a' ); |
81 |
'Check biblio1 609$a' ); |
77 |
my $newbiblio2 = GetMarcBiblio($biblionumber2); |
82 |
my $newbiblio2 = GetMarcBiblio($biblionumber2); |
78 |
$newbiblio2->delete_fields( $newbiblio2->field('100') ); # fix for UNIMARC |
83 |
compare_fields( $biblio2, $newbiblio2, {}, 'count' ); |
79 |
compare_field_count( $biblio2, $newbiblio2 ); |
84 |
compare_fields( $biblio2, $newbiblio2, {}, 'order' ); |
80 |
compare_field_order( $biblio2, $newbiblio2 ); |
|
|
81 |
is( $newbiblio2->subfield('609', '9'), $authid1, 'Check biblio2 609$9' ); |
85 |
is( $newbiblio2->subfield('609', '9'), $authid1, 'Check biblio2 609$9' ); |
82 |
is( $newbiblio2->subfield('609', 'a'), 'George Orwell', |
86 |
is( $newbiblio2->subfield('609', 'a'), 'George Orwell', |
83 |
'Check biblio2 609$a' ); |
87 |
'Check biblio2 609$a' ); |
Lines 85-91
subtest 'Test merge A1 to A2 (within same authtype)' => sub {
Link Here
|
85 |
|
89 |
|
86 |
subtest 'Test merge A1 to modified A1, test strict mode' => sub { |
90 |
subtest 'Test merge A1 to modified A1, test strict mode' => sub { |
87 |
# Tests originate from bug 11700 |
91 |
# Tests originate from bug 11700 |
88 |
plan tests => 11; |
92 |
plan tests => 12; |
89 |
|
93 |
|
90 |
# Simulate modifying an authority from auth1old to auth1new |
94 |
# Simulate modifying an authority from auth1old to auth1new |
91 |
my $auth1old = MARC::Record->new; |
95 |
my $auth1old = MARC::Record->new; |
Lines 115-128
subtest 'Test merge A1 to modified A1, test strict mode' => sub {
Link Here
|
115 |
|
119 |
|
116 |
#Check the results |
120 |
#Check the results |
117 |
my $biblio1 = GetMarcBiblio($biblionumber1); |
121 |
my $biblio1 = GetMarcBiblio($biblionumber1); |
118 |
$biblio1->delete_fields( $biblio1->field('100') ); # quick fix for UNIMARC |
122 |
compare_fields( $MARC1, $biblio1, {}, 'count' ); |
119 |
compare_field_count( $MARC1, $biblio1 ); |
123 |
compare_fields( $MARC1, $biblio1, {}, 'order' ); |
120 |
compare_field_order( $MARC1, $biblio1 ); |
|
|
121 |
is( $auth1new->field(109)->subfield('a'), $biblio1->field(109)->subfield('a'), 'Record1 values updated correctly' ); |
124 |
is( $auth1new->field(109)->subfield('a'), $biblio1->field(109)->subfield('a'), 'Record1 values updated correctly' ); |
122 |
my $biblio2 = GetMarcBiblio( $biblionumber2 ); |
125 |
my $biblio2 = GetMarcBiblio( $biblionumber2 ); |
123 |
$biblio2->delete_fields( $biblio2->field('100') ); # quick fix for UNIMARC |
126 |
compare_fields( $MARC2, $biblio2, {}, 'count' ); |
124 |
compare_field_count( $MARC2, $biblio2 ); |
127 |
compare_fields( $MARC2, $biblio2, {}, 'order' ); |
125 |
compare_field_order( $MARC2, $biblio2 ); |
|
|
126 |
is( $auth1new->field(109)->subfield('a'), $biblio2->field(109)->subfield('a'), 'Record2 values updated correctly' ); |
128 |
is( $auth1new->field(109)->subfield('a'), $biblio2->field(109)->subfield('a'), 'Record2 values updated correctly' ); |
127 |
# This is only true in loose mode: |
129 |
# This is only true in loose mode: |
128 |
is( $biblio1->field(109)->subfield('b'), $MARC1->field(109)->subfield('b'), 'Subfield not overwritten in loose mode'); |
130 |
is( $biblio1->field(109)->subfield('b'), $MARC1->field(109)->subfield('b'), 'Subfield not overwritten in loose mode'); |
Lines 134-142
subtest 'Test merge A1 to modified A1, test strict mode' => sub {
Link Here
|
134 |
$index = 0; |
136 |
$index = 0; |
135 |
$rv = C4::AuthoritiesMarc::merge( $authid1, $auth1old, $authid1, $auth1new ); |
137 |
$rv = C4::AuthoritiesMarc::merge( $authid1, $auth1old, $authid1, $auth1new ); |
136 |
$biblio1 = GetMarcBiblio($biblionumber1); |
138 |
$biblio1 = GetMarcBiblio($biblionumber1); |
137 |
$biblio1->delete_fields( $biblio1->field('100') ); # quick fix for UNIMARC |
|
|
138 |
is( $biblio1->field(109)->subfield('b'), undef, 'Subfield overwritten in strict mode' ); |
139 |
is( $biblio1->field(109)->subfield('b'), undef, 'Subfield overwritten in strict mode' ); |
139 |
is( $biblio1->fields, scalar( $MARC1->fields ) - 1, 'strict mode should remove a duplicate 609' ); |
140 |
compare_fields( $MARC1, $biblio1, { 609 => 1 }, 'count' ); |
|
|
141 |
my @old609 = $MARC1->field('609'); |
142 |
my @new609 = $biblio1->field('609'); |
143 |
is( scalar @new609, @old609 - 1, 'strict mode should remove a duplicate 609' ); |
140 |
is( $biblio1->field(609)->subfields, |
144 |
is( $biblio1->field(609)->subfields, |
141 |
scalar($auth1new->field('109')->subfields) + 1, |
145 |
scalar($auth1new->field('109')->subfields) + 1, |
142 |
'Check number of subfields in strict mode for the remaining 609' ); |
146 |
'Check number of subfields in strict mode for the remaining 609' ); |
Lines 173-179
subtest 'Test merge A1 to B1 (changing authtype)' => sub {
Link Here
|
173 |
); |
177 |
); |
174 |
my ( $biblionumber ) = C4::Biblio::AddBiblio( $marc, '' ); |
178 |
my ( $biblionumber ) = C4::Biblio::AddBiblio( $marc, '' ); |
175 |
my $oldbiblio = C4::Biblio::GetMarcBiblio( $biblionumber ); |
179 |
my $oldbiblio = C4::Biblio::GetMarcBiblio( $biblionumber ); |
176 |
$oldbiblio->delete_fields( $oldbiblio->field('100') ); # fix for UNIMARC |
|
|
177 |
|
180 |
|
178 |
# Time to merge |
181 |
# Time to merge |
179 |
@zebrarecords = ( $marc ); |
182 |
@zebrarecords = ( $marc ); |
Lines 183-194
subtest 'Test merge A1 to B1 (changing authtype)' => sub {
Link Here
|
183 |
|
186 |
|
184 |
# Get new marc record for compares |
187 |
# Get new marc record for compares |
185 |
my $newbiblio = C4::Biblio::GetMarcBiblio( $biblionumber ); |
188 |
my $newbiblio = C4::Biblio::GetMarcBiblio( $biblionumber ); |
186 |
$newbiblio->delete_fields( $newbiblio->field('100') ); # fix for UNIMARC |
189 |
compare_fields( $oldbiblio, $newbiblio, {}, 'count' ); |
187 |
compare_field_count( $oldbiblio, $newbiblio ); |
|
|
188 |
# Exclude 109/609 and 112/612 in comparing order |
190 |
# Exclude 109/609 and 112/612 in comparing order |
189 |
compare_field_order( $oldbiblio, $newbiblio, |
191 |
my $excl = { '109' => 1, '112' => 1, '609' => 1, '612' => 1 }; |
190 |
{ '109' => 1, '112' => 1, '609' => 1, '612' => 1 }, |
192 |
compare_fields( $oldbiblio, $newbiblio, $excl, 'order' ); |
191 |
); |
|
|
192 |
# Check position of 612s in the new record |
193 |
# Check position of 612s in the new record |
193 |
my $full_order = join q/,/, map { $_->tag } $newbiblio->fields; |
194 |
my $full_order = join q/,/, map { $_->tag } $newbiblio->fields; |
194 |
is( $full_order =~ /611(,612){3}/, 1, 'Check position of all 612s' ); |
195 |
is( $full_order =~ /611(,612){3}/, 1, 'Check position of all 612s' ); |
Lines 303-321
sub modify_framework {
Link Here
|
303 |
return ( $authtype1->{authtypecode}, $authtype2->{authtypecode} ); |
304 |
return ( $authtype1->{authtypecode}, $authtype2->{authtypecode} ); |
304 |
} |
305 |
} |
305 |
|
306 |
|
306 |
sub compare_field_count { |
307 |
sub compare_fields { # mode parameter: order or count |
307 |
my ( $oldmarc, $newmarc ) = @_; |
308 |
my ( $oldmarc, $newmarc, $exclude, $mode ) = @_; |
308 |
my $t; |
|
|
309 |
is( scalar $newmarc->fields, $t = $oldmarc->fields, "Number of fields still equal to $t" ); |
310 |
} |
311 |
|
312 |
sub compare_field_order { |
313 |
my ( $oldmarc, $newmarc, $exclude ) = @_; |
314 |
$exclude //= {}; |
309 |
$exclude //= {}; |
|
|
310 |
if( C4::Context->preference('marcflavour') eq 'UNIMARC' ) { |
311 |
# By default exclude field 100 from comparison in UNIMARC. |
312 |
# Will have been added by ModBiblio in merge. |
313 |
$exclude->{100} = 1; |
314 |
} |
315 |
my @oldfields = map { $exclude->{$_->tag} ? () : $_->tag } $oldmarc->fields; |
315 |
my @oldfields = map { $exclude->{$_->tag} ? () : $_->tag } $oldmarc->fields; |
316 |
my @newfields = map { $exclude->{$_->tag} ? () : $_->tag } $newmarc->fields; |
316 |
my @newfields = map { $exclude->{$_->tag} ? () : $_->tag } $newmarc->fields; |
317 |
is( ( join q/,/, @newfields ), ( join q/,/, @oldfields ), |
317 |
|
318 |
'Order of fields unchanged' ); |
318 |
if( $mode eq 'count' ) { |
|
|
319 |
my $t; |
320 |
is( scalar @newfields, $t = @oldfields, "Number of fields still equal to $t" ); |
321 |
} elsif( $mode eq 'order' ) { |
322 |
is( ( join q/,/, @newfields ), ( join q/,/, @oldfields ), 'Order of fields unchanged' ); |
323 |
} |
319 |
} |
324 |
} |
320 |
|
325 |
|
321 |
$schema->storage->txn_rollback; |
326 |
$schema->storage->txn_rollback; |
322 |
- |
|
|