Jonathan Druart
08c03af2ae
Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl> Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io> Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
955 lines
25 KiB
Perl
955 lines
25 KiB
Perl
package Koha::Biblio;
|
|
|
|
# Copyright ByWater Solutions 2014
|
|
#
|
|
# 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 List::MoreUtils qw( any );
|
|
use URI;
|
|
use URI::Escape qw( uri_escape_utf8 );
|
|
|
|
use C4::Koha qw( GetNormalizedISBN );
|
|
use C4::XSLT qw( transformMARCXML4XSLT );
|
|
|
|
use Koha::Database;
|
|
use Koha::DateUtils qw( dt_from_string );
|
|
|
|
use base qw(Koha::Object);
|
|
|
|
use Koha::Acquisition::Orders;
|
|
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
|
|
|
|
Koha::Biblio - Koha Biblio Object class
|
|
|
|
=head1 API
|
|
|
|
=head2 Class Methods
|
|
|
|
=cut
|
|
|
|
=head3 store
|
|
|
|
Overloaded I<store> method to set default values
|
|
|
|
=cut
|
|
|
|
sub store {
|
|
my ( $self ) = @_;
|
|
|
|
$self->datecreated( dt_from_string ) unless $self->datecreated;
|
|
|
|
return $self->SUPER::store;
|
|
}
|
|
|
|
=head3 metadata
|
|
|
|
my $metadata = $biblio->metadata();
|
|
|
|
Returns a Koha::Biblio::Metadata object
|
|
|
|
=cut
|
|
|
|
sub metadata {
|
|
my ( $self ) = @_;
|
|
|
|
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
|
|
|
|
my $bool = $biblio->can_article_request( $borrower );
|
|
|
|
Returns true if article requests can be made for this record
|
|
|
|
$borrower must be a Koha::Patron object
|
|
|
|
=cut
|
|
|
|
sub can_article_request {
|
|
my ( $self, $borrower ) = @_;
|
|
|
|
my $rule = $self->article_request_type($borrower);
|
|
return q{} if $rule eq 'item_only' && !$self->items()->count();
|
|
return 1 if $rule && $rule ne 'no';
|
|
|
|
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 );
|
|
|
|
Returns the article request type based on items, or on the record
|
|
itself if there are no items.
|
|
|
|
$borrower must be a Koha::Patron object
|
|
|
|
=cut
|
|
|
|
sub article_request_type {
|
|
my ( $self, $borrower ) = @_;
|
|
|
|
return q{} unless $borrower;
|
|
|
|
my $rule = $self->article_request_type_for_items( $borrower );
|
|
return $rule if $rule;
|
|
|
|
# If the record has no items that are requestable, go by the record itemtype
|
|
$rule = $self->article_request_type_for_bib($borrower);
|
|
return $rule if $rule;
|
|
|
|
return q{};
|
|
}
|
|
|
|
=head3 article_request_type_for_bib
|
|
|
|
my $type = $biblio->article_request_type_for_bib
|
|
|
|
Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record
|
|
|
|
=cut
|
|
|
|
sub article_request_type_for_bib {
|
|
my ( $self, $borrower ) = @_;
|
|
|
|
return q{} unless $borrower;
|
|
|
|
my $borrowertype = $borrower->categorycode;
|
|
my $itemtype = $self->itemtype();
|
|
|
|
my $rule = Koha::CirculationRules->get_effective_rule(
|
|
{
|
|
rule_name => 'article_requests',
|
|
categorycode => $borrowertype,
|
|
itemtype => $itemtype,
|
|
}
|
|
);
|
|
|
|
return q{} unless $rule;
|
|
return $rule->rule_value || q{}
|
|
}
|
|
|
|
=head3 article_request_type_for_items
|
|
|
|
my $type = $biblio->article_request_type_for_items
|
|
|
|
Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record's items
|
|
|
|
If there is a conflict where some items are 'bib_only' and some are 'item_only', 'bib_only' will be returned.
|
|
|
|
=cut
|
|
|
|
sub article_request_type_for_items {
|
|
my ( $self, $borrower ) = @_;
|
|
|
|
my $counts;
|
|
foreach my $item ( $self->items()->as_list() ) {
|
|
my $rule = $item->article_request_type($borrower);
|
|
return $rule if $rule eq 'bib_only'; # we don't need to go any further
|
|
$counts->{$rule}++;
|
|
}
|
|
|
|
return 'item_only' if $counts->{item_only};
|
|
return 'yes' if $counts->{yes};
|
|
return 'no' if $counts->{no};
|
|
return q{};
|
|
}
|
|
|
|
=head3 article_requests
|
|
|
|
my $article_requests = $biblio->article_requests
|
|
|
|
Returns the article requests associated with this biblio
|
|
|
|
=cut
|
|
|
|
sub article_requests {
|
|
my ( $self ) = @_;
|
|
|
|
return Koha::ArticleRequests->_new_from_dbic( scalar $self->_result->article_requests );
|
|
}
|
|
|
|
=head3 items
|
|
|
|
my $items = $biblio->items();
|
|
|
|
Returns the related Koha::Items object for this biblio
|
|
|
|
=cut
|
|
|
|
sub items {
|
|
my ($self) = @_;
|
|
|
|
my $items_rs = $self->_result->items;
|
|
|
|
return Koha::Items->_new_from_dbic( $items_rs );
|
|
}
|
|
|
|
=head3 host_items
|
|
|
|
my $host_items = $biblio->host_items();
|
|
|
|
Return the host items (easy analytical record)
|
|
|
|
=cut
|
|
|
|
sub host_items {
|
|
my ($self) = @_;
|
|
|
|
return Koha::Items->new->empty
|
|
unless C4::Context->preference('EasyAnalyticalRecords');
|
|
|
|
my $marcflavour = C4::Context->preference("marcflavour");
|
|
my $analyticfield = '773';
|
|
if ( $marcflavour eq 'MARC21' ) {
|
|
$analyticfield = '773';
|
|
}
|
|
elsif ( $marcflavour eq 'UNIMARC' ) {
|
|
$analyticfield = '461';
|
|
}
|
|
my $marc_record = $self->metadata->record;
|
|
my @itemnumbers;
|
|
foreach my $field ( $marc_record->field($analyticfield) ) {
|
|
push @itemnumbers, $field->subfield('9');
|
|
}
|
|
|
|
return Koha::Items->search( { itemnumber => { -in => \@itemnumbers } } );
|
|
}
|
|
|
|
=head3 itemtype
|
|
|
|
my $itemtype = $biblio->itemtype();
|
|
|
|
Returns the itemtype for this record.
|
|
|
|
=cut
|
|
|
|
sub itemtype {
|
|
my ( $self ) = @_;
|
|
|
|
return $self->biblioitem()->itemtype();
|
|
}
|
|
|
|
=head3 holds
|
|
|
|
my $holds = $biblio->holds();
|
|
|
|
return the current holds placed on this record
|
|
|
|
=cut
|
|
|
|
sub holds {
|
|
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
|
|
|
|
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
|
|
|
|
my $field = $self->biblioitem()->itemtype
|
|
|
|
Returns the related Koha::Biblioitem object for this Biblio object
|
|
|
|
=cut
|
|
|
|
sub biblioitem {
|
|
my ($self) = @_;
|
|
|
|
$self->{_biblioitem} ||= Koha::Biblioitems->find( { biblionumber => $self->biblionumber() } );
|
|
|
|
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( '&',
|
|
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 .= '&';
|
|
}
|
|
$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'));
|
|
my $record = $self->metadata->record;
|
|
$record = transformMARCXML4XSLT( $self->biblionumber, $record, $opac );
|
|
|
|
foreach my $field ( $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
|
|
|
|
sub _type {
|
|
return 'Biblio';
|
|
}
|
|
|
|
=head1 AUTHOR
|
|
|
|
Kyle M Hall <kyle@bywatersolutions.com>
|
|
|
|
=cut
|
|
|
|
1;
|