use Modern::Perl;
-use Test::More tests => 4;
+use Test::More tests => 7;
+use Getopt::Long;
use MARC::Record;
use Test::MockModule;
-use Test::MockObject;
use t::lib::Mocks;
use t::lib::TestBuilder;
use C4::Biblio;
+use Koha::Authorities;
+use Koha::Authority::MergeRequests;
use Koha::Database;
BEGIN {
use_ok('C4::AuthoritiesMarc');
}
+# Optionally change marc flavour
+my $marcflavour;
+GetOptions( 'flavour:s' => \$marcflavour );
+t::lib::Mocks::mock_preference( 'marcflavour', $marcflavour ) if $marcflavour;
+
my $schema = Koha::Database->new->schema;
$schema->storage->txn_begin;
-my $dbh = C4::Context->dbh;
-
-# Some advanced mocking :)
-my ( @zebrarecords, $index );
-my $context_mod = Test::MockModule->new( 'C4::Context' );
-my $search_mod = Test::MockModule->new( 'C4::Search' );
-my $zoom_mod = Test::MockModule->new( 'ZOOM::Query::CCL2RPN', no_auto => 1 );
-my $conn_obj = Test::MockObject->new;
-my $zoom_obj = Test::MockObject->new;
-my $zoom_record_obj = Test::MockObject->new;
-set_mocks();
-# Framework operations
-my ( $authtype1, $authtype2 ) = modify_framework();
+# Global variables, mocking and framework modifications
+our @linkedrecords;
+my $mocks = set_mocks();
+our ( $authtype1, $authtype2 ) = modify_framework();
+
+subtest 'Test postponed merge feature' => sub {
+ plan tests => 6;
+
+ # Set limit to zero, and call merge a few times
+ t::lib::Mocks::mock_preference('AuthorityMergeLimit', 0);
+ my $auth1 = t::lib::TestBuilder->new->build({ source => 'AuthHeader' });
+ my $cnt = Koha::Authority::MergeRequests->count;
+ merge({ mergefrom => '0' });
+ is( Koha::Authority::MergeRequests->count, $cnt, 'No merge request added as expected' );
+ merge({ mergefrom => $auth1->{authid} });
+ is( Koha::Authority::MergeRequests->count, $cnt, 'No merge request added since we have zero hits' );
+ @linkedrecords = ( 1, 2 ); # these biblionumbers do not matter
+ merge({ mergefrom => $auth1->{authid} });
+ is( Koha::Authority::MergeRequests->count, $cnt + 1, 'Merge request added as expected' );
+
+ # Set limit to two (starting with two records)
+ t::lib::Mocks::mock_preference('AuthorityMergeLimit', 2);
+ merge({ mergefrom => $auth1->{authid} });
+ is( Koha::Authority::MergeRequests->count, $cnt + 1, 'No merge request added as we do not exceed the limit' );
+ @linkedrecords = ( 1, 2, 3 ); # these biblionumbers do not matter
+ merge({ mergefrom => $auth1->{authid} });
+ is( Koha::Authority::MergeRequests->count, $cnt + 2, 'Merge request added as we do exceed the limit again' );
+ # Now override
+ merge({ mergefrom => $auth1->{authid}, override_limit => 1 });
+ is( Koha::Authority::MergeRequests->count, $cnt + 2, 'No merge request added as we did override' );
+
+ # Set merge limit high enough for the other subtests
+ t::lib::Mocks::mock_preference('AuthorityMergeLimit', 1000);
+};
subtest 'Test merge A1 to A2 (within same authtype)' => sub {
# Tests originate from bug 11700
plan tests => 9;
+ # Start in loose mode, although it actually does not matter here
+ t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose');
+
# Add two authority records
my $auth1 = MARC::Record->new;
$auth1->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'George Orwell' ));
my ( $biblionumber2 ) = AddBiblio($biblio2, '');
# Time to merge
- @zebrarecords = ( $biblio1, $biblio2 );
- $index = 0;
- my $rv = C4::AuthoritiesMarc::merge( $authid2, $auth2, $authid1, $auth1 );
+ @linkedrecords = ( $biblionumber1, $biblionumber2 );
+ my $rv = C4::AuthoritiesMarc::merge({ mergefrom => $authid2, MARCfrom => $auth2, mergeto => $authid1, MARCto => $auth1 });
is( $rv, 1, 'We expect one biblio record (out of two) to be updated' );
# Check the results
- my $newbiblio1 = GetMarcBiblio($biblionumber1);
- $newbiblio1->delete_fields( $newbiblio1->field('100') ); # fix for UNIMARC
- compare_field_count( $biblio1, $newbiblio1 );
- compare_field_order( $biblio1, $newbiblio1 );
+ my $newbiblio1 = GetMarcBiblio({ biblionumber => $biblionumber1 });
+ compare_fields( $biblio1, $newbiblio1, {}, 'count' );
+ compare_fields( $biblio1, $newbiblio1, {}, 'order' );
is( $newbiblio1->subfield('609', '9'), $authid1, 'Check biblio1 609$9' );
is( $newbiblio1->subfield('609', 'a'), 'George Orwell',
'Check biblio1 609$a' );
- my $newbiblio2 = GetMarcBiblio($biblionumber2);
- $newbiblio2->delete_fields( $newbiblio2->field('100') ); # fix for UNIMARC
- compare_field_count( $biblio2, $newbiblio2 );
- compare_field_order( $biblio2, $newbiblio2 );
+ my $newbiblio2 = GetMarcBiblio({ biblionumber => $biblionumber2 });
+ compare_fields( $biblio2, $newbiblio2, {}, 'count' );
+ compare_fields( $biblio2, $newbiblio2, {}, 'order' );
is( $newbiblio2->subfield('609', '9'), $authid1, 'Check biblio2 609$9' );
is( $newbiblio2->subfield('609', 'a'), 'George Orwell',
'Check biblio2 609$a' );
};
-subtest 'Test merge A1 to modified A1' => sub {
+subtest 'Test merge A1 to modified A1, test strict mode' => sub {
# Tests originate from bug 11700
- plan tests => 11;
+ plan tests => 12;
# Simulate modifying an authority from auth1old to auth1new
my $auth1old = MARC::Record->new;
my ( $biblionumber1 ) = AddBiblio( $MARC1, '');
my ( $biblionumber2 ) = AddBiblio( $MARC2, '');
- # Time to merge
- @zebrarecords = ( $MARC1, $MARC2 );
- $index = 0;
+ # Time to merge in loose mode first
+ @linkedrecords = ( $biblionumber1, $biblionumber2 );
t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose');
- my $rv = C4::AuthoritiesMarc::merge( $authid1, $auth1old, $authid1, $auth1new );
+ my $rv = C4::AuthoritiesMarc::merge({ mergefrom => $authid1, MARCfrom => $auth1old, mergeto => $authid1, MARCto => $auth1new });
is( $rv, 2, 'Both records are updated now' );
#Check the results
- my $biblio1 = GetMarcBiblio($biblionumber1);
- $biblio1->delete_fields( $biblio1->field('100') ); # quick fix for UNIMARC
- compare_field_count( $MARC1, $biblio1 );
- compare_field_order( $MARC1, $biblio1 );
+ my $biblio1 = GetMarcBiblio({ biblionumber => $biblionumber1 });
+ compare_fields( $MARC1, $biblio1, {}, 'count' );
+ compare_fields( $MARC1, $biblio1, {}, 'order' );
is( $auth1new->field(109)->subfield('a'), $biblio1->field(109)->subfield('a'), 'Record1 values updated correctly' );
- my $biblio2 = GetMarcBiblio( $biblionumber2 );
- $biblio2->delete_fields( $biblio2->field('100') ); # quick fix for UNIMARC
- compare_field_count( $MARC2, $biblio2 );
- compare_field_order( $MARC2, $biblio2 );
+ my $biblio2 = GetMarcBiblio({ biblionumber => $biblionumber2 });
+ compare_fields( $MARC2, $biblio2, {}, 'count' );
+ compare_fields( $MARC2, $biblio2, {}, 'order' );
is( $auth1new->field(109)->subfield('a'), $biblio2->field(109)->subfield('a'), 'Record2 values updated correctly' );
# This is only true in loose mode:
is( $biblio1->field(109)->subfield('b'), $MARC1->field(109)->subfield('b'), 'Subfield not overwritten in loose mode');
# Merge again in strict mode
t::lib::Mocks::mock_preference('AuthorityMergeMode', 'strict');
ModBiblio( $MARC1, $biblionumber1, '' );
- @zebrarecords = ( $MARC1 );
- $index = 0;
- $rv = C4::AuthoritiesMarc::merge( $authid1, $auth1old, $authid1, $auth1new );
- $biblio1 = GetMarcBiblio($biblionumber1);
+ @linkedrecords = ( $biblionumber1 );
+ $rv = C4::AuthoritiesMarc::merge({ mergefrom => $authid1, MARCfrom => $auth1old, mergeto => $authid1, MARCto => $auth1new });
+ $biblio1 = GetMarcBiblio({ biblionumber => $biblionumber1 });
is( $biblio1->field(109)->subfield('b'), undef, 'Subfield overwritten in strict mode' );
- is( $biblio1->fields, scalar( $MARC1->fields ) - 1, 'strict mode should remove a duplicate 609' );
+ compare_fields( $MARC1, $biblio1, { 609 => 1 }, 'count' );
+ my @old609 = $MARC1->field('609');
+ my @new609 = $biblio1->field('609');
+ is( scalar @new609, @old609 - 1, 'strict mode should remove a duplicate 609' );
is( $biblio1->field(609)->subfields,
scalar($auth1new->field('109')->subfields) + 1,
'Check number of subfields in strict mode for the remaining 609' );
# Note: the +1 comes from the added subfield $9 in the biblio
- t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose');
};
subtest 'Test merge A1 to B1 (changing authtype)' => sub {
# Tests were aimed for bug 9988, moved to 17909 in adjusted form
# Would not encourage this type of merge, but we should test what we offer
-# The merge routine still needs the fixes on bug 17913
plan tests => 13;
+ # Get back to loose mode now
+ t::lib::Mocks::mock_preference('AuthorityMergeMode', 'loose');
+
# create two auth recs of different type
my $auth1 = MARC::Record->new;
$auth1->append_fields( MARC::Field->new( '109', '0', '0', 'a' => 'George Orwell', b => 'bb' ));
MARC::Field->new( '612', '', '', a => 'unrelated', 9 => 'other' ),
);
my ( $biblionumber ) = C4::Biblio::AddBiblio( $marc, '' );
- my $oldbiblio = C4::Biblio::GetMarcBiblio( $biblionumber );
- $oldbiblio->delete_fields( $oldbiblio->field('100') ); # fix for UNIMARC
+ my $oldbiblio = C4::Biblio::GetMarcBiblio({ biblionumber => $biblionumber });
# Time to merge
- @zebrarecords = ( $marc );
- $index = 0;
- my $retval = C4::AuthoritiesMarc::merge( $authid1, $auth1, $authid2, $auth2 );
+ @linkedrecords = ( $biblionumber );
+ my $retval = C4::AuthoritiesMarc::merge({ mergefrom => $authid1, MARCfrom => $auth1, mergeto => $authid2, MARCto => $auth2 });
is( $retval, 1, 'We touched only one biblio' );
# Get new marc record for compares
- my $newbiblio = C4::Biblio::GetMarcBiblio( $biblionumber );
- $newbiblio->delete_fields( $newbiblio->field('100') ); # fix for UNIMARC
- compare_field_count( $oldbiblio, $newbiblio );
+ my $newbiblio = C4::Biblio::GetMarcBiblio({ biblionumber => $biblionumber });
+ compare_fields( $oldbiblio, $newbiblio, {}, 'count' );
# Exclude 109/609 and 112/612 in comparing order
- compare_field_order( $oldbiblio, $newbiblio,
- { '109' => 1, '112' => 1, '609' => 1, '612' => 1 },
- );
+ my $excl = { '109' => 1, '112' => 1, '609' => 1, '612' => 1 };
+ compare_fields( $oldbiblio, $newbiblio, $excl, 'order' );
# Check position of 612s in the new record
my $full_order = join q/,/, map { $_->tag } $newbiblio->fields;
is( $full_order =~ /611(,612){3}/, 1, 'Check position of all 612s' );
'Check 612x' );
};
+subtest 'Merging authorities should handle deletes (BZ 18070)' => sub {
+ plan tests => 2;
+
+ # Add authority and linked biblio, delete authority
+ my $auth1 = MARC::Record->new;
+ $auth1->append_fields( MARC::Field->new( '109', '', '', 'a' => 'DEL'));
+ my $authid1 = AddAuthority( $auth1, undef, $authtype1 );
+ my $bib1 = MARC::Record->new;
+ $bib1->append_fields(
+ MARC::Field->new( '245', '', '', a => 'test DEL' ),
+ MARC::Field->new( '609', '', '', a => 'DEL', 9 => "$authid1" ),
+ );
+ my ( $biblionumber ) = C4::Biblio::AddBiblio( $bib1, '' );
+ @linkedrecords = ( $biblionumber );
+ DelAuthority({ authid => $authid1 }); # this triggers a merge call
+
+ # See what happened in the biblio record
+ my $marc1 = C4::Biblio::GetMarcBiblio({ biblionumber => $biblionumber });
+ is( $marc1->field('609'), undef, 'Field 609 should be gone too' );
+
+ # Now we simulate the delete as done in the cron job
+ # First, restore auth1 and add 609 back in bib1
+ $auth1 = MARC::Record->new;
+ $auth1->append_fields( MARC::Field->new( '109', '', '', 'a' => 'DEL'));
+ $authid1 = AddAuthority( $auth1, undef, $authtype1 );
+ $marc1->append_fields(
+ MARC::Field->new( '609', '', '', a => 'DEL', 9 => "$authid1" ),
+ );
+ ModBiblio( $marc1, $biblionumber, '' );
+ # Instead of going through DelAuthority, we manually delete the auth
+ # record and call merge afterwards.
+ # This mimics deleting an authority and calling merge later in the
+ # merge cron job.
+ # We use the biblionumbers parameter here and unmock linked_biblionumbers.
+ C4::Context->dbh->do( "DELETE FROM auth_header WHERE authid=?", undef, $authid1 );
+ @linkedrecords = ();
+ $mocks->{auth_mod}->unmock_all;
+ merge({ mergefrom => $authid1, biblionumbers => [ $biblionumber ] });
+ # Final check
+ $marc1 = C4::Biblio::GetMarcBiblio({ biblionumber => $biblionumber });
+ is( $marc1->field('609'), undef, 'Merge removed the 609 again even after deleting the authority record' );
+};
+
+subtest "Test some specific postponed merge issues" => sub {
+ plan tests => 4;
+
+ my $authmarc = MARC::Record->new;
+ $authmarc->append_fields( MARC::Field->new( '109', '', '', 'a' => 'aa', b => 'bb' ));
+ my $oldauthmarc = MARC::Record->new;
+ $oldauthmarc->append_fields( MARC::Field->new( '112', '', '', c => 'cc' ));
+ my $id = AddAuthority( $authmarc, undef, $authtype1 );
+ my $biblio = MARC::Record->new;
+ $biblio->append_fields(
+ MARC::Field->new( '109', '', '', a => 'a1', 9 => $id ),
+ MARC::Field->new( '612', '', '', a => 'a2', c => 'cc', 9 => $id+1 ),
+ MARC::Field->new( '612', '', '', a => 'a3', 9 => $id+2 ),
+ );
+ my ( $biblionumber ) = C4::Biblio::AddBiblio( $biblio, '' );
+
+ # Merge A to B postponed, A is deleted (simulated by id+1)
+ # This proves the !authtypefrom condition in sub merge
+ # Additionally, we test clearing subfield
+ merge({ mergefrom => $id + 1, MARCfrom => $oldauthmarc, mergeto => $id, MARCto => $authmarc, biblionumbers => [ $biblionumber ] });
+ $biblio = C4::Biblio::GetMarcBiblio({ biblionumber => $biblionumber });
+ is( $biblio->subfield('609', '9'), $id, '612 moved to 609' );
+ is( $biblio->subfield('609', 'c'), undef, '609c cleared correctly' );
+
+ # Merge A to B postponed, delete B immediately (hits B < hits A)
+ # This proves the !@record_to test in sub merge
+ merge({ mergefrom => $id + 2, mergeto => $id + 1, MARCto => undef, biblionumbers => [ $biblionumber ] });
+ $biblio = C4::Biblio::GetMarcBiblio({ biblionumber => $biblionumber });
+ is( $biblio->field('612'), undef, 'Last 612 must be gone' );
+
+ # Show that we 'need' skip_merge; this example is far-fetched.
+ # We *prove* by contradiction.
+ # Suppose: Merge A to B postponed, and delete A would merge rightaway.
+ # (You would need some special race condition with merge.pl to do so.)
+ # The modify merge would be useless after that.
+ @linkedrecords = ( $biblionumber );
+ my $restored_mocks = set_mocks();
+ DelAuthority({ authid => $id, skip_merge => 1 }); # delete A
+ $restored_mocks->{auth_mod}->unmock_all;
+ $biblio = C4::Biblio::GetMarcBiblio({ biblionumber => $biblionumber });
+ is( $biblio->subfield('109', '9'), $id, 'If the 109 is no longer present, another modify merge would not bring it back' );
+};
+
sub set_mocks {
- # Mock ZOOM objects: They do nothing actually
- # Get new_record_from_zebra to return the records
+ # After we removed the Zebra code from merge, we only need to mock
+ # get_usage_count and linked_biblionumbers here.
- $context_mod->mock( 'Zconn', sub { $conn_obj; } );
- $search_mod->mock( 'new_record_from_zebra', sub {
- return if $index >= @zebrarecords;
- return $zebrarecords[ $index++ ];
+ my $mocks;
+ $mocks->{auth_mod} = Test::MockModule->new( 'Koha::Authorities' );
+ $mocks->{auth_mod}->mock( 'get_usage_count', sub {
+ return scalar @linkedrecords;
+ });
+ $mocks->{auth_mod}->mock( 'linked_biblionumbers', sub {
+ return @linkedrecords;
});
- $zoom_mod->mock( 'new', sub {} );
-
- $conn_obj->mock( 'search', sub { $zoom_obj; } );
- $zoom_obj->mock( 'destroy', sub {} );
- $zoom_obj->mock( 'record', sub { $zoom_record_obj; } );
- $zoom_obj->mock( 'search', sub {} );
- $zoom_obj->mock( 'size', sub { @zebrarecords } );
- $zoom_record_obj->mock( 'raw', sub {} );
+ return $mocks;
}
sub modify_framework {
return ( $authtype1->{authtypecode}, $authtype2->{authtypecode} );
}
-sub compare_field_count {
- my ( $oldmarc, $newmarc ) = @_;
- my $t;
- is( scalar $newmarc->fields, $t = $oldmarc->fields, "Number of fields still equal to $t" );
-}
-
-sub compare_field_order {
- my ( $oldmarc, $newmarc, $exclude ) = @_;
+sub compare_fields { # mode parameter: order or count
+ my ( $oldmarc, $newmarc, $exclude, $mode ) = @_;
$exclude //= {};
+ if( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
+ # By default exclude field 100 from comparison in UNIMARC.
+ # Will have been added by ModBiblio in merge.
+ $exclude->{100} = 1;
+ }
my @oldfields = map { $exclude->{$_->tag} ? () : $_->tag } $oldmarc->fields;
my @newfields = map { $exclude->{$_->tag} ? () : $_->tag } $newmarc->fields;
- is( ( join q/,/, @newfields ), ( join q/,/, @oldfields ),
- 'Order of fields unchanged' );
+
+ if( $mode eq 'count' ) {
+ my $t;
+ is( scalar @newfields, $t = @oldfields, "Number of fields still equal to $t" );
+ } elsif( $mode eq 'order' ) {
+ is( ( join q/,/, @newfields ), ( join q/,/, @oldfields ), 'Order of fields unchanged' );
+ }
}
$schema->storage->txn_rollback;
projects / srvgit / blobdiff