From 2a4a8266efe150241727716aa263d91efcc33038 Mon Sep 17 00:00:00 2001 From: Marcel de Rooy Date: Mon, 19 Mar 2018 14:14:39 +0100 Subject: [PATCH] Bug 20310: Introduce Koha::Biblio->host_record This is a more generic method that allows you to get to the host record as defined in MARC21 field 773$w. This control number is looked up in the search engine (MARC21 field 001). Note: The current implementation is based on MARC21 and does not change behavior for UNIMARC. This includes the follow-up originally submitted separately on Bugzilla, dealing with multiple 773 fields. Test plan: Run t/db_dependent/Koha/Biblio/host_record.t Signed-off-by: Marcel de Rooy Signed-off-by: Martin Renvoize Signed-off-by: Nick Clemens Signed-off-by: Jonathan Druart --- Koha/Biblio.pm | 57 +++++++++++++ t/db_dependent/Koha/Biblio/host_record.t | 102 +++++++++++++++++++++++ 2 files changed, 159 insertions(+) create mode 100644 t/db_dependent/Koha/Biblio/host_record.t diff --git a/Koha/Biblio.pm b/Koha/Biblio.pm index 02d2aba04d..76efc062b3 100644 --- a/Koha/Biblio.pm +++ b/Koha/Biblio.pm @@ -891,6 +891,63 @@ sub to_api_mapping { }; } +=head3 host_record + + $host = $biblio->host_record; + # OR: + ( $host, $relatedparts ) = $biblio->host_record; + + Returns host biblio record from MARC21 773 (undef if no 773 present). + It looks at the first 773 field with MARCorgCode or only a control + number. Complete $w or numeric part is used to search host record. + The optional parameter no_items triggers a check if $biblio has items. + If there are, the sub returns undef. + Called in list context, it also returns 773$g (related parts). + +=cut + +sub host_record { + my ($self, $params) = @_; + my $no_items = $params->{no_items}; + return if C4::Context->preference('marcflavour') eq 'UNIMARC'; # TODO + return if $params->{no_items} && $self->items->count > 0; + + my $record; + eval { $record = $self->metadata->record }; + return if !$record; + + # We pick the first $w with your MARCOrgCode or the first $w that has no + # code (between parentheses) at all. + my $orgcode = C4::Context->preference('MARCOrgCode') // q{}; + my $hostfld; + foreach my $f ( $record->field('773') ) { + my $w = $f->subfield('w') or next; + if( $w =~ /^\($orgcode\)\s*(\d+)/i or $w =~ /^\d+/ ) { + $hostfld = $f; + last; + } + } + return if !$hostfld; + my $rcn = $hostfld->subfield('w'); + + # Look for control number with/without orgcode + my $engine = Koha::SearchEngine::Search->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX }); + my $bibno; + for my $try (1..2) { + my ( $error, $results, $total_hits ) = $engine->simple_search_compat( 'Control-number='.$rcn, 0,1 ); + if( !$error and $total_hits == 1 ) { + $bibno = $engine->extract_biblionumber( $results->[0] ); + last; + } + # Extract number from $w (remove orgcode) for second try + $rcn= $1 if $try == 1 && $rcn =~ /\)\s*(\d+)/; + } + if( $bibno ) { + my $host = Koha::Biblios->find($bibno) or return; + return wantarray ? ( $host, $hostfld->subfield('g') ) : $host; + } +} + =head2 Internal methods =head3 type diff --git a/t/db_dependent/Koha/Biblio/host_record.t b/t/db_dependent/Koha/Biblio/host_record.t new file mode 100644 index 0000000000..59b9f139e6 --- /dev/null +++ b/t/db_dependent/Koha/Biblio/host_record.t @@ -0,0 +1,102 @@ +#!/usr/bin/perl + +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . + +use Modern::Perl; + +use Test::More tests => 1; +use Data::Dumper qw/Dumper/; +use MARC::Field; +use MARC::Record; +use Test::MockModule; +use Test::MockObject; + +use t::lib::TestBuilder; +use t::lib::Mocks; +use Koha::Database; +use Koha::Biblios; +use C4::Biblio; + + +my $schema = Koha::Database->new->schema; +$schema->storage->txn_begin; +our $builder = t::lib::TestBuilder->new; + +subtest 'host_record' => sub { + plan tests => 11; + + t::lib::Mocks::mock_preference( 'marcflavour', 'MARC21' ); + t::lib::Mocks::mock_preference( 'MARCOrgCode', 'xyz' ); + + my $bib1 = $builder->build_object({ class => 'Koha::Biblios' }); + my $bib2 = $builder->build_object({ class => 'Koha::Biblios' }); + my $marc = MARC::Record->new; + my $results = []; + + # Lets mock! Simulate search engine response and biblio metadata call. + my $metadata = Test::MockObject->new; + $metadata->mock( 'record', sub { return $marc; } ); + my $meta_mod = Test::MockModule->new( 'Koha::Biblio' ); + $meta_mod->mock( 'metadata', sub { return $metadata; } ); + my $engine = Test::MockObject->new; + $engine->mock( 'simple_search_compat', sub { return ( undef, $results, scalar @$results ); } ); + $engine->mock( 'extract_biblionumber', sub { return $results->[0]; } ); + my $search_mod = Test::MockModule->new( 'Koha::SearchEngine::Search' ); + $search_mod->mock( 'new', sub { return $engine; } ); + + # Case 1: Search engine does not return any results on controlnumber + is( $bib1->host_record, undef, 'Empty MARC record' ); + $marc->append_fields( + MARC::Field->new( '773', '', '', g => 'relpart', w => '(xyz)123' ), + ); + is( $bib1->host_record, undef, '773 looks fine, but no search results' ); + + # Case 2: Search engine returns (at maximum) one result + $results = [ $bib1->biblionumber ]; # will be found because 773w is in shape + my $host = $bib1->host_record; + is( ref( $host ), 'Koha::Biblio', 'Correct object returned' ); + is( $host->biblionumber, $bib1->biblionumber, 'Check biblionumber' ); + $marc->field('773')->update( w => '(xyz) bad data' ); # causes no results + $host = $bib1->host_record; + is( $bib1->host_record, undef, 'No results for bad 773' ); + # Add second 773 + $marc->append_fields( MARC::Field->new( '773', '', '', g => 'relpart2', w => '234' ) ); + $host = $bib1->host_record; + is( $host->biblionumber, $bib1->biblionumber, 'Result triggered by second 773' ); + # Replace orgcode + ($marc->field('773'))[1]->update( w => '(abc)345' ); + is( $bib1->host_record, undef, 'No results for two 773s' ); + # Test no_items flag + ($marc->field('773'))[1]->update( w => '234' ); # restore + $host = $bib1->host_record({ no_items => 1 }); + is( $host->biblionumber, $bib1->biblionumber, 'Record found with no_items' ); + $builder->build({ source => 'Item', value => { biblionumber => $bib1->biblionumber } }); + is( $bib1->host_record({ no_items => 1 }), undef, 'Record not found with no_items flag after adding one item' ); + # Test list context + my @temp = $bib1->host_record; + is( $temp[1], 'relpart2', 'Return $g in list context' ); + + # Case 3: Search engine returns more results + $results = [ 1, 2 ]; + is( $bib1->host_record, undef, 'host_record returns undef for non-unique control number' ); +}; + +sub mocked_search { + my $results = shift; + return ( undef, $results, scalar @$results ); +} + +$schema->storage->txn_rollback(); -- 2.39.5