View | Details | Raw Unified | Return to bug 17950
Collapse All | Expand All

(-)a/t/db_dependent/Authorities/Merge.t (-32 / +36 lines)
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
- 

Return to bug 17950