|
Lines 4-10
Link Here
|
| 4 |
|
4 |
|
| 5 |
use Modern::Perl; |
5 |
use Modern::Perl; |
| 6 |
|
6 |
|
| 7 |
use Test::More tests => 10; |
7 |
use Test::More tests => 11; |
| 8 |
|
8 |
|
| 9 |
use Getopt::Long; |
9 |
use Getopt::Long; |
| 10 |
use MARC::Record; |
10 |
use MARC::Record; |
|
Lines 21-27
use Koha::Biblios;
Link Here
|
| 21 |
use Koha::Database; |
21 |
use Koha::Database; |
| 22 |
|
22 |
|
| 23 |
BEGIN { |
23 |
BEGIN { |
| 24 |
use_ok('C4::AuthoritiesMarc', qw( merge AddAuthority compare_fields DelAuthority )); |
24 |
use_ok('C4::AuthoritiesMarc', qw( merge AddAuthority compare_fields DelAuthority ModAuthority )); |
| 25 |
} |
25 |
} |
| 26 |
|
26 |
|
| 27 |
# Optionally change marc flavour |
27 |
# Optionally change marc flavour |
|
Lines 245-250
subtest 'Test merge A1 to B1 (changing authtype)' => sub {
Link Here
|
| 245 |
'Check 612x' ); |
245 |
'Check 612x' ); |
| 246 |
}; |
246 |
}; |
| 247 |
|
247 |
|
|
|
248 |
subtest 'Test update A with modified heading tag (changing authtype)' => sub { |
| 249 |
# Bug 19693 |
| 250 |
# This would happen rarely when updating authorities from authority file |
| 251 |
# when the tag of a heading field is being changed (and thus also |
| 252 |
# the authtype) |
| 253 |
plan tests => 13; |
| 254 |
|
| 255 |
# Get back to loose mode now |
| 256 |
t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose'); |
| 257 |
|
| 258 |
# create an auth rec |
| 259 |
my $auth1 = MARC::Record->new; |
| 260 |
$auth1->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'George Orwell', b => 'bb' )); |
| 261 |
my $authid1 = AddAuthority( $auth1, undef, $authtype1 ); |
| 262 |
|
| 263 |
# create a biblio with one 109 and two 609s to be touched |
| 264 |
# seems exceptional see bug 13760 comment10 |
| 265 |
my $marc = MARC::Record->new; |
| 266 |
$marc->append_fields( |
| 267 |
MARC::Field->new( '003', 'some_003' ), |
| 268 |
MARC::Field->new( '109', '', '', a => 'G. Orwell', b => 'bb', d => 'd', 9 => $authid1 ), |
| 269 |
MARC::Field->new( '245', '', '', a => 'My title' ), |
| 270 |
MARC::Field->new( '609', '', '', a => 'Orwell', 9 => "$authid1" ), |
| 271 |
MARC::Field->new( '609', '', '', a => 'Orwell', x => 'xx', 9 => "$authid1" ), |
| 272 |
MARC::Field->new( '611', '', '', a => 'Added for testing order' ), |
| 273 |
MARC::Field->new( '612', '', '', a => 'unrelated', 9 => 'other' ), |
| 274 |
); |
| 275 |
my ( $biblionumber ) = C4::Biblio::AddBiblio( $marc, '' ); |
| 276 |
my $oldbiblio = Koha::Biblios->find($biblionumber)->metadata->record; |
| 277 |
|
| 278 |
# Time to merge |
| 279 |
@linkedrecords = ( $biblionumber ); |
| 280 |
my $auth2 = MARC::Record->new; |
| 281 |
$auth2->append_fields( MARC::Field->new( '112', '0', '0', 'a' => 'Batman', c => 'cc' )); |
| 282 |
my $authid2 = ModAuthority($authid1, $auth2, $authtype2 ); |
| 283 |
# inside ModAuthority the following is executed: |
| 284 |
# merge({ mergefrom => $authid1, MARCfrom => $auth1, mergeto => $authid1, MARCto => $auth2 }); |
| 285 |
is( $authid2, $authid1, 'authid after ModAuthority OK' ); |
| 286 |
|
| 287 |
# Get new marc record for compares |
| 288 |
my $newbiblio = Koha::Biblios->find($biblionumber)->metadata->record; |
| 289 |
compare_fields( $oldbiblio, $newbiblio, {}, 'count' ); |
| 290 |
# Exclude 109/609 and 112/612 in comparing order |
| 291 |
my $excl = { '109' => 1, '112' => 1, '609' => 1, '612' => 1 }; |
| 292 |
compare_fields( $oldbiblio, $newbiblio, $excl, 'order' ); |
| 293 |
# Check position of 612s in the new record |
| 294 |
my $full_order = join q/,/, map { $_->tag } $newbiblio->fields; |
| 295 |
is( $full_order =~ /611(,612){3}/, 1, 'Check position of all 612s' ); |
| 296 |
|
| 297 |
# Check some fields |
| 298 |
is( $newbiblio->field('003')->data, |
| 299 |
$oldbiblio->field('003')->data, |
| 300 |
'Check contents of a control field not expected to be touched' ); |
| 301 |
is( $newbiblio->subfield( '245', 'a' ), |
| 302 |
$oldbiblio->subfield( '245', 'a' ), |
| 303 |
'Check contents of a data field not expected to be touched' ); |
| 304 |
is( $newbiblio->subfield( '112', 'a' ), |
| 305 |
$auth2->subfield( '112', 'a' ), 'Check modified 112a' ); |
| 306 |
is( $newbiblio->subfield( '112', 'c' ), |
| 307 |
$auth2->subfield( '112', 'c' ), 'Check new 112c' ); |
| 308 |
|
| 309 |
# Check 112b; this subfield was cleared when moving from 109 to 112 |
| 310 |
# Note that this fix only applies to the current loose mode only |
| 311 |
is( $newbiblio->subfield( '112', 'b' ), undef, |
| 312 |
'Merge respects a cleared subfield in loose mode' ); |
| 313 |
|
| 314 |
# Check the original 612 |
| 315 |
is( ( $newbiblio->field('612') )[0]->subfield( 'a' ), |
| 316 |
$oldbiblio->subfield( '612', 'a' ), 'Check untouched 612a' ); |
| 317 |
# Check second 612 |
| 318 |
is( ( $newbiblio->field('612') )[1]->subfield( 'a' ), |
| 319 |
$auth2->subfield( '112', 'a' ), 'Check second touched 612a' ); |
| 320 |
# Check second new 612ax (in LOOSE mode) |
| 321 |
is( ( $newbiblio->field('612') )[2]->subfield( 'a' ), |
| 322 |
$auth2->subfield( '112', 'a' ), 'Check touched 612a' ); |
| 323 |
is( ( $newbiblio->field('612') )[2]->subfield( 'x' ), |
| 324 |
( $oldbiblio->field('609') )[1]->subfield('x'), |
| 325 |
'Check 612x' ); |
| 326 |
}; |
| 327 |
|
| 248 |
subtest 'Merging authorities should handle deletes (BZ 18070)' => sub { |
328 |
subtest 'Merging authorities should handle deletes (BZ 18070)' => sub { |
| 249 |
plan tests => 2; |
329 |
plan tests => 2; |
| 250 |
|
330 |
|
| 251 |
- |
|
|