Bug 17600: Standardize our EXPORT_OK
[srvgit] / Koha / Biblio.pm
index d5ca370..26ee7ab 100644 (file)
@@ -4,34 +4,43 @@ package Koha::Biblio;
 #
 # 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 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.
+# 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, write to the Free Software Foundation, Inc.,
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+# 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 Carp;
+use List::MoreUtils qw( any );
+use URI;
+use URI::Escape qw( uri_escape_utf8 );
 
-use C4::Biblio qw( GetRecordValue GetMarcBiblio GetFrameworkCode );
+use C4::Koha qw( GetNormalizedISBN );
 
 use Koha::Database;
+use Koha::DateUtils qw( dt_from_string );
 
 use base qw(Koha::Object);
 
-use Koha::Items;
-use Koha::Biblioitems;
-use Koha::ArticleRequests;
+use Koha::Acquisition::Orders;
 use Koha::ArticleRequest::Status;
-use Koha::IssuingRules;
+use Koha::ArticleRequests;
+use Koha::Biblio::Metadatas;
+use Koha::Biblioitems;
+use Koha::CirculationRules;
+use Koha::Item::Transfer::Limits;
+use Koha::Items;
+use Koha::Libraries;
+use Koha::Suggestions;
+use Koha::Subscriptions;
 
 =head1 NAME
 
@@ -43,20 +52,64 @@ Koha::Biblio - Koha Biblio Object class
 
 =cut
 
-=head3 subtitles
+=head3 store
+
+Overloaded I<store> method to set default values
+
+=cut
+
+sub store {
+    my ( $self ) = @_;
+
+    $self->datecreated( dt_from_string ) unless $self->datecreated;
 
-my @subtitles = $biblio->subtitles();
+    return $self->SUPER::store;
+}
+
+=head3 metadata
 
-Returns list of subtitles for a record.
+my $metadata = $biblio->metadata();
 
-Keyword to MARC mapping for subtitle must be set for this method to return any possible values.
+Returns a Koha::Biblio::Metadata object
 
 =cut
 
-sub subtitles {
+sub metadata {
     my ( $self ) = @_;
 
-    return map { $_->{subfield} } @{ GetRecordValue( 'subtitle', GetMarcBiblio( $self->id ), $self->frameworkcode ) };
+    my $metadata = $self->_result->metadata;
+    return Koha::Biblio::Metadata->_new_from_dbic($metadata);
+}
+
+=head3 orders
+
+my $orders = $biblio->orders();
+
+Returns a Koha::Acquisition::Orders object
+
+=cut
+
+sub orders {
+    my ( $self ) = @_;
+
+    my $orders = $self->_result->orders;
+    return Koha::Acquisition::Orders->_new_from_dbic($orders);
+}
+
+=head3 active_orders
+
+my $active_orders = $biblio->active_orders();
+
+Returns the active acquisition orders related to this biblio.
+An order is considered active when it is not cancelled (i.e. when datecancellation
+is not undef).
+
+=cut
+
+sub active_orders {
+    my ( $self ) = @_;
+
+    return $self->orders->search({ datecancellationprinted => undef });
 }
 
 =head3 can_article_request
@@ -79,6 +132,133 @@ sub can_article_request {
     return q{};
 }
 
+=head3 can_be_transferred
+
+$biblio->can_be_transferred({ to => $to_library, from => $from_library })
+
+Checks if at least one item of a biblio can be transferred to given library.
+
+This feature is controlled by two system preferences:
+UseBranchTransferLimits to enable / disable the feature
+BranchTransferLimitsType to use either an itemnumber or ccode as an identifier
+                         for setting the limitations
+
+Performance-wise, it is recommended to use this method for a biblio instead of
+iterating each item of a biblio with Koha::Item->can_be_transferred().
+
+Takes HASHref that can have the following parameters:
+    MANDATORY PARAMETERS:
+    $to   : Koha::Library
+    OPTIONAL PARAMETERS:
+    $from : Koha::Library # if given, only items from that
+                          # holdingbranch are considered
+
+Returns 1 if at least one of the item of a biblio can be transferred
+to $to_library, otherwise 0.
+
+=cut
+
+sub can_be_transferred {
+    my ($self, $params) = @_;
+
+    my $to   = $params->{to};
+    my $from = $params->{from};
+
+    return 1 unless C4::Context->preference('UseBranchTransferLimits');
+    my $limittype = C4::Context->preference('BranchTransferLimitsType');
+
+    my $items;
+    foreach my $item_of_bib ($self->items->as_list) {
+        next unless $item_of_bib->holdingbranch;
+        next if $from && $from->branchcode ne $item_of_bib->holdingbranch;
+        return 1 if $item_of_bib->holdingbranch eq $to->branchcode;
+        my $code = $limittype eq 'itemtype'
+            ? $item_of_bib->effective_itemtype
+            : $item_of_bib->ccode;
+        return 1 unless $code;
+        $items->{$code}->{$item_of_bib->holdingbranch} = 1;
+    }
+
+    # At this point we will have a HASHref containing each itemtype/ccode that
+    # this biblio has, inside which are all of the holdingbranches where those
+    # items are located at. Then, we will query Koha::Item::Transfer::Limits to
+    # find out whether a transfer limits for such $limittype from any of the
+    # listed holdingbranches to the given $to library exist. If at least one
+    # holdingbranch for that $limittype does not have a transfer limit to given
+    # $to library, then we know that the transfer is possible.
+    foreach my $code (keys %{$items}) {
+        my @holdingbranches = keys %{$items->{$code}};
+        return 1 if Koha::Item::Transfer::Limits->search({
+            toBranch => $to->branchcode,
+            fromBranch => { 'in' => \@holdingbranches },
+            $limittype => $code
+        }, {
+            group_by => [qw/fromBranch/]
+        })->count == scalar(@holdingbranches) ? 0 : 1;
+    }
+
+    return 0;
+}
+
+
+=head3 pickup_locations
+
+    my $pickup_locations = $biblio->pickup_locations( {patron => $patron } );
+
+Returns a Koha::Libraries set of possible pickup locations for this biblio's items,
+according to patron's home library (if patron is defined and holds are allowed
+only from hold groups) and if item can be transferred to each pickup location.
+
+=cut
+
+sub pickup_locations {
+    my ( $self, $params ) = @_;
+
+    my $patron = $params->{patron};
+
+    my @pickup_locations;
+    foreach my $item_of_bib ( $self->items->as_list ) {
+        push @pickup_locations,
+          $item_of_bib->pickup_locations( { patron => $patron } )
+          ->_resultset->get_column('branchcode')->all;
+    }
+
+    return Koha::Libraries->search(
+        { branchcode => { '-in' => \@pickup_locations } }, { order_by => ['branchname'] } );
+}
+
+=head3 hidden_in_opac
+
+    my $bool = $biblio->hidden_in_opac({ [ rules => $rules ] })
+
+Returns true if the biblio matches the hidding criteria defined in $rules.
+Returns false otherwise. It involves the I<OpacHiddenItems> and
+I<OpacHiddenItemsHidesRecord> system preferences.
+
+Takes HASHref that can have the following parameters:
+    OPTIONAL PARAMETERS:
+    $rules : { <field> => [ value_1, ... ], ... }
+
+Note: $rules inherits its structure from the parsed YAML from reading
+the I<OpacHiddenItems> system preference.
+
+=cut
+
+sub hidden_in_opac {
+    my ( $self, $params ) = @_;
+
+    my $rules = $params->{rules} // {};
+
+    my @items = $self->items->as_list;
+
+    return 0 unless @items; # Do not hide if there is no item
+
+    # Ok, there are items, don't even try the rules unless OpacHiddenItemsHidesRecord
+    return 0 unless C4::Context->preference('OpacHiddenItemsHidesRecord');
+
+    return !(any { !$_->hidden_in_opac({ rules => $rules }) } @items);
+}
+
 =head3 article_request_type
 
 my $type = $biblio->article_request_type( $borrower );
@@ -121,10 +301,16 @@ sub article_request_type_for_bib {
     my $borrowertype = $borrower->categorycode;
     my $itemtype     = $self->itemtype();
 
-    my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule({ categorycode => $borrowertype, itemtype => $itemtype });
+    my $rule = Koha::CirculationRules->get_effective_rule(
+        {
+            rule_name    => 'article_requests',
+            categorycode => $borrowertype,
+            itemtype     => $itemtype,
+        }
+    );
 
-    return q{} unless $issuing_rule;
-    return $issuing_rule->article_requests || q{}
+    return q{} unless $rule;
+    return $rule->rule_value || q{}
 }
 
 =head3 article_request_type_for_items
@@ -219,20 +405,18 @@ sub article_requests_finished {
 
 =head3 items
 
-my @items = $biblio->items();
 my $items = $biblio->items();
 
-Returns the related Koha::Items object for this biblio in scalar context,
-or list of Koha::Item objects in list context.
+Returns the related Koha::Items object for this biblio
 
 =cut
 
 sub items {
     my ($self) = @_;
 
-    $self->{_items} ||= Koha::Items->search( { biblionumber => $self->biblionumber() } );
+    my $items_rs = $self->_result->items;
 
-    return wantarray ? $self->{_items}->as_list : $self->{_items};
+    return Koha::Items->_new_from_dbic( $items_rs );
 }
 
 =head3 itemtype
@@ -258,10 +442,26 @@ return the current holds placed on this record
 =cut
 
 sub holds {
-    my ( $self ) = @_;
+    my ( $self, $params, $attributes ) = @_;
+    $attributes->{order_by} = 'priority' unless exists $attributes->{order_by};
+    my $hold_rs = $self->_result->reserves->search( $params, $attributes );
+    return Koha::Holds->_new_from_dbic($hold_rs);
+}
+
+=head3 current_holds
+
+my $holds = $biblio->current_holds
 
-    my $holds_rs = $self->_result->reserves;
-    return Koha::Holds->_new_from_dbic( $holds_rs );
+Return the holds placed on this bibliographic record.
+It does not include future holds.
+
+=cut
+
+sub current_holds {
+    my ($self) = @_;
+    my $dtf = Koha::Database->new->schema->storage->datetime_parser;
+    return $self->holds(
+        { reservedate => { '<=' => $dtf->format_date(dt_from_string) } } );
 }
 
 =head3 biblioitem
@@ -280,6 +480,480 @@ sub biblioitem {
     return $self->{_biblioitem};
 }
 
+=head3 suggestions
+
+my $suggestions = $self->suggestions
+
+Returns the related Koha::Suggestions object for this Biblio object
+
+=cut
+
+sub suggestions {
+    my ($self) = @_;
+
+    my $suggestions_rs = $self->_result->suggestions;
+    return Koha::Suggestions->_new_from_dbic( $suggestions_rs );
+}
+
+=head3 subscriptions
+
+my $subscriptions = $self->subscriptions
+
+Returns the related Koha::Subscriptions object for this Biblio object
+
+=cut
+
+sub subscriptions {
+    my ($self) = @_;
+
+    $self->{_subscriptions} ||= Koha::Subscriptions->search( { biblionumber => $self->biblionumber } );
+
+    return $self->{_subscriptions};
+}
+
+=head3 has_items_waiting_or_intransit
+
+my $itemsWaitingOrInTransit = $biblio->has_items_waiting_or_intransit
+
+Tells if this bibliographic record has items waiting or in transit.
+
+=cut
+
+sub has_items_waiting_or_intransit {
+    my ( $self ) = @_;
+
+    if ( Koha::Holds->search({ biblionumber => $self->id,
+                               found => ['W', 'T'] })->count ) {
+        return 1;
+    }
+
+    foreach my $item ( $self->items->as_list ) {
+        return 1 if $item->get_transfer;
+    }
+
+    return 0;
+}
+
+=head2 get_coins
+
+my $coins = $biblio->get_coins;
+
+Returns the COinS (a span) which can be included in a biblio record
+
+=cut
+
+sub get_coins {
+    my ( $self ) = @_;
+
+    my $record = $self->metadata->record;
+
+    my $pos7 = substr $record->leader(), 7, 1;
+    my $pos6 = substr $record->leader(), 6, 1;
+    my $mtx;
+    my $genre;
+    my ( $aulast, $aufirst ) = ( '', '' );
+    my @authors;
+    my $title;
+    my $hosttitle;
+    my $pubyear   = '';
+    my $isbn      = '';
+    my $issn      = '';
+    my $publisher = '';
+    my $pages     = '';
+    my $titletype = '';
+
+    # For the purposes of generating COinS metadata, LDR/06-07 can be
+    # considered the same for UNIMARC and MARC21
+    my $fmts6 = {
+        'a' => 'book',
+        'b' => 'manuscript',
+        'c' => 'book',
+        'd' => 'manuscript',
+        'e' => 'map',
+        'f' => 'map',
+        'g' => 'film',
+        'i' => 'audioRecording',
+        'j' => 'audioRecording',
+        'k' => 'artwork',
+        'l' => 'document',
+        'm' => 'computerProgram',
+        'o' => 'document',
+        'r' => 'document',
+    };
+    my $fmts7 = {
+        'a' => 'journalArticle',
+        's' => 'journal',
+    };
+
+    $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
+
+    if ( $genre eq 'book' ) {
+            $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
+    }
+
+    ##### We must transform mtx to a valable mtx and document type ####
+    if ( $genre eq 'book' ) {
+            $mtx = 'book';
+            $titletype = 'b';
+    } elsif ( $genre eq 'journal' ) {
+            $mtx = 'journal';
+            $titletype = 'j';
+    } elsif ( $genre eq 'journalArticle' ) {
+            $mtx   = 'journal';
+            $genre = 'article';
+            $titletype = 'a';
+    } else {
+            $mtx = 'dc';
+    }
+
+    if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
+
+        # Setting datas
+        $aulast  = $record->subfield( '700', 'a' ) || '';
+        $aufirst = $record->subfield( '700', 'b' ) || '';
+        push @authors, "$aufirst $aulast" if ($aufirst or $aulast);
+
+        # others authors
+        if ( $record->field('200') ) {
+            for my $au ( $record->field('200')->subfield('g') ) {
+                push @authors, $au;
+            }
+        }
+
+        $title     = $record->subfield( '200', 'a' );
+        my $subfield_210d = $record->subfield('210', 'd');
+        if ($subfield_210d and $subfield_210d =~ /(\d{4})/) {
+            $pubyear = $1;
+        }
+        $publisher = $record->subfield( '210', 'c' ) || '';
+        $isbn      = $record->subfield( '010', 'a' ) || '';
+        $issn      = $record->subfield( '011', 'a' ) || '';
+    } else {
+
+        # MARC21 need some improve
+
+        # Setting datas
+        if ( $record->field('100') ) {
+            push @authors, $record->subfield( '100', 'a' );
+        }
+
+        # others authors
+        if ( $record->field('700') ) {
+            for my $au ( $record->field('700')->subfield('a') ) {
+                push @authors, $au;
+            }
+        }
+        $title = $record->field('245');
+        $title &&= $title->as_string('ab');
+        if ($titletype eq 'a') {
+            $pubyear   = $record->field('008') || '';
+            $pubyear   = substr($pubyear->data(), 7, 4) if $pubyear;
+            $isbn      = $record->subfield( '773', 'z' ) || '';
+            $issn      = $record->subfield( '773', 'x' ) || '';
+            $hosttitle = $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{};
+            my @rels = $record->subfield( '773', 'g' );
+            $pages = join(', ', @rels);
+        } else {
+            $pubyear   = $record->subfield( '260', 'c' ) || '';
+            $publisher = $record->subfield( '260', 'b' ) || '';
+            $isbn      = $record->subfield( '020', 'a' ) || '';
+            $issn      = $record->subfield( '022', 'a' ) || '';
+        }
+
+    }
+
+    my @params = (
+        [ 'ctx_ver', 'Z39.88-2004' ],
+        [ 'rft_val_fmt', "info:ofi/fmt:kev:mtx:$mtx" ],
+        [ ($mtx eq 'dc' ? 'rft.type' : 'rft.genre'), $genre ],
+        [ "rft.${titletype}title", $title ],
+    );
+
+    # rft.title is authorized only once, so by checking $titletype
+    # we ensure that rft.title is not already in the list.
+    if ($hosttitle and $titletype) {
+        push @params, [ 'rft.title', $hosttitle ];
+    }
+
+    push @params, (
+        [ 'rft.isbn', $isbn ],
+        [ 'rft.issn', $issn ],
+    );
+
+    # If it's a subscription, these informations have no meaning.
+    if ($genre ne 'journal') {
+        push @params, (
+            [ 'rft.aulast', $aulast ],
+            [ 'rft.aufirst', $aufirst ],
+            (map { [ 'rft.au', $_ ] } @authors),
+            [ 'rft.pub', $publisher ],
+            [ 'rft.date', $pubyear ],
+            [ 'rft.pages', $pages ],
+        );
+    }
+
+    my $coins_value = join( '&amp;',
+        map { $$_[1] ? $$_[0] . '=' . uri_escape_utf8( $$_[1] ) : () } @params );
+
+    return $coins_value;
+}
+
+=head2 get_openurl
+
+my $url = $biblio->get_openurl;
+
+Returns url for OpenURL resolver set in OpenURLResolverURL system preference
+
+=cut
+
+sub get_openurl {
+    my ( $self ) = @_;
+
+    my $OpenURLResolverURL = C4::Context->preference('OpenURLResolverURL');
+
+    if ($OpenURLResolverURL) {
+        my $uri = URI->new($OpenURLResolverURL);
+
+        if (not defined $uri->query) {
+            $OpenURLResolverURL .= '?';
+        } else {
+            $OpenURLResolverURL .= '&amp;';
+        }
+        $OpenURLResolverURL .= $self->get_coins;
+    }
+
+    return $OpenURLResolverURL;
+}
+
+=head3 is_serial
+
+my $serial = $biblio->is_serial
+
+Return boolean true if this bibbliographic record is continuing resource
+
+=cut
+
+sub is_serial {
+    my ( $self ) = @_;
+
+    return 1 if $self->serial;
+
+    my $record = $self->metadata->record;
+    return 1 if substr($record->leader, 7, 1) eq 's';
+
+    return 0;
+}
+
+=head3 custom_cover_image_url
+
+my $image_url = $biblio->custom_cover_image_url
+
+Return the specific url of the cover image for this bibliographic record.
+It is built regaring the value of the system preference CustomCoverImagesURL
+
+=cut
+
+sub custom_cover_image_url {
+    my ( $self ) = @_;
+    my $url = C4::Context->preference('CustomCoverImagesURL');
+    if ( $url =~ m|{isbn}| ) {
+        my $isbn = $self->biblioitem->isbn;
+        return unless $isbn;
+        $url =~ s|{isbn}|$isbn|g;
+    }
+    if ( $url =~ m|{normalized_isbn}| ) {
+        my $normalized_isbn = C4::Koha::GetNormalizedISBN($self->biblioitem->isbn);
+        return unless $normalized_isbn;
+        $url =~ s|{normalized_isbn}|$normalized_isbn|g;
+    }
+    if ( $url =~ m|{issn}| ) {
+        my $issn = $self->biblioitem->issn;
+        return unless $issn;
+        $url =~ s|{issn}|$issn|g;
+    }
+
+    my $re = qr|{(?<field>\d{3})\$(?<subfield>.)}|;
+    if ( $url =~ $re ) {
+        my $field = $+{field};
+        my $subfield = $+{subfield};
+        my $marc_record = $self->metadata->record;
+        my $value = $marc_record->subfield($field, $subfield);
+        return unless $value;
+        $url =~ s|$re|$value|;
+    }
+
+    return $url;
+}
+
+=head3 cover_images
+
+Return the cover images associated with this biblio.
+
+=cut
+
+sub cover_images {
+    my ( $self ) = @_;
+
+    my $cover_images_rs = $self->_result->cover_images;
+    return unless $cover_images_rs;
+    return Koha::CoverImages->_new_from_dbic($cover_images_rs);
+}
+
+=head3 get_marc_notes
+
+    $marcnotesarray = $biblio->get_marc_notes({ marcflavour => $marcflavour });
+
+Get all notes from the MARC record and returns them in an array.
+The notes are stored in different fields depending on MARC flavour.
+MARC21 5XX $u subfields receive special attention as they are URIs.
+
+=cut
+
+sub get_marc_notes {
+    my ( $self, $params ) = @_;
+
+    my $marcflavour = $params->{marcflavour};
+    my $opac = $params->{opac};
+
+    my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
+    my @marcnotes;
+
+    #MARC21 specs indicate some notes should be private if first indicator 0
+    my %maybe_private = (
+        541 => 1,
+        542 => 1,
+        561 => 1,
+        583 => 1,
+        590 => 1
+    );
+
+    my %hiddenlist = map { $_ => 1 }
+        split( /,/, C4::Context->preference('NotesToHide'));
+    foreach my $field ( $self->metadata->record->field($scope) ) {
+        my $tag = $field->tag();
+        next if $hiddenlist{ $tag };
+        next if $opac && $maybe_private{$tag} && !$field->indicator(1);
+        if( $marcflavour ne 'UNIMARC' && $field->subfield('u') ) {
+            # Field 5XX$u always contains URI
+            # Examples: 505u, 506u, 510u, 514u, 520u, 530u, 538u, 540u, 542u, 552u, 555u, 561u, 563u, 583u
+            # We first push the other subfields, then all $u's separately
+            # Leave further actions to the template (see e.g. opac-detail)
+            my $othersub =
+                join '', ( 'a' .. 't', 'v' .. 'z', '0' .. '9' ); # excl 'u'
+            push @marcnotes, { marcnote => $field->as_string($othersub) };
+            foreach my $sub ( $field->subfield('u') ) {
+                $sub =~ s/^\s+|\s+$//g; # trim
+                push @marcnotes, { marcnote => $sub };
+            }
+        } else {
+            push @marcnotes, { marcnote => $field->as_string() };
+        }
+    }
+    return \@marcnotes;
+}
+
+=head3 to_api
+
+    my $json = $biblio->to_api;
+
+Overloaded method that returns a JSON representation of the Koha::Biblio object,
+suitable for API output. The related Koha::Biblioitem object is merged as expected
+on the API.
+
+=cut
+
+sub to_api {
+    my ($self, $args) = @_;
+
+    my $response = $self->SUPER::to_api( $args );
+    my $biblioitem = $self->biblioitem->to_api;
+
+    return { %$response, %$biblioitem };
+}
+
+=head3 to_api_mapping
+
+This method returns the mapping for representing a Koha::Biblio object
+on the API.
+
+=cut
+
+sub to_api_mapping {
+    return {
+        biblionumber     => 'biblio_id',
+        frameworkcode    => 'framework_id',
+        unititle         => 'uniform_title',
+        seriestitle      => 'series_title',
+        copyrightdate    => 'copyright_date',
+        datecreated      => 'creation_date'
+    };
+}
+
+=head3 get_marc_host
+
+    $host = $biblio->get_marc_host;
+    # OR:
+    ( $host, $relatedparts ) = $biblio->get_marc_host;
+
+    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 get_marc_host {
+    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;
+        }
+        # Add or remove orgcode for second try
+        if( $try == 1 && $rcn =~ /\)\s*(\d+)/ ) {
+            $rcn = $1; # number only
+        } elsif( $try == 1 && $rcn =~ /^\d+/ ) {
+            $rcn = "($orgcode)$rcn";
+        } else {
+            last;
+        }
+    }
+    if( $bibno ) {
+        my $host = Koha::Biblios->find($bibno) or return;
+        return wantarray ? ( $host, $hostfld->subfield('g') ) : $host;
+    }
+}
+
+=head2 Internal methods
+
 =head3 type
 
 =cut