From 412d27854ac29b01b98a49dfa923d39fb92187aa Mon Sep 17 00:00:00 2001
From: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>
Date: Mon, 19 Mar 2018 14:14:39 +0100
Subject: [PATCH] Bug 20310: Introduce Koha::Biblio->host_record
Content-Type: text/plain; charset=utf-8

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 <m.de.rooy@rijksmuseum.nl>
---
 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 830b9c4d73..6b4a21ef0f 100644
--- a/Koha/Biblio.pm
+++ b/Koha/Biblio.pm
@@ -816,6 +816,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 <http://www.gnu.org/licenses>.
+
+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.11.0