|
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 |
- |
|
|