2525 lines
72 KiB
Perl
2525 lines
72 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 <https://www.gnu.org/licenses>.
|
|
|
|
use Modern::Perl;
|
|
|
|
use List::MoreUtils qw( any );
|
|
use Scalar::Util qw( blessed );
|
|
use URI;
|
|
use URI::Escape qw( uri_escape_utf8 );
|
|
use Try::Tiny;
|
|
|
|
use C4::Koha qw( GetNormalizedISBN );
|
|
use C4::Biblio qw( DelBiblio );
|
|
use C4::Serials qw( CountSubscriptionFromBiblionumber );
|
|
use C4::Reserves qw( MergeHolds );
|
|
use C4::Acquisition qw( ModOrder GetOrdersByBiblionumber );
|
|
|
|
use Koha::Database;
|
|
use Koha::DateUtils qw( dt_from_string );
|
|
use Koha::Exception;
|
|
|
|
use base qw(Koha::Object);
|
|
|
|
use Koha::Acquisition::Orders;
|
|
use Koha::ArticleRequests;
|
|
use Koha::Biblio::Metadatas;
|
|
use Koha::Biblio::Metadata::Extractor;
|
|
use Koha::Biblio::ItemGroups;
|
|
use Koha::Biblioitems;
|
|
use Koha::BiblioFrameworks;
|
|
use Koha::Cache::Memory::Lite;
|
|
use Koha::Bookings;
|
|
use Koha::Checkouts;
|
|
use Koha::CirculationRules;
|
|
use Koha::Exceptions;
|
|
use Koha::ILL::Requests;
|
|
use Koha::Item::Transfer::Limits;
|
|
use Koha::Items;
|
|
use Koha::Libraries;
|
|
use Koha::Old::Checkouts;
|
|
use Koha::Old::Holds;
|
|
use Koha::Ratings;
|
|
use Koha::Recalls;
|
|
use Koha::RecordProcessor;
|
|
use Koha::Suggestions;
|
|
use Koha::Subscriptions;
|
|
use Koha::SearchEngine;
|
|
use Koha::SearchEngine::Search;
|
|
use Koha::SearchEngine::QueryBuilder;
|
|
use Koha::Tickets;
|
|
|
|
=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 record
|
|
|
|
my $record = $biblio->record();
|
|
|
|
Returns a Marc::Record object
|
|
|
|
=cut
|
|
|
|
sub record {
|
|
my ($self) = @_;
|
|
|
|
return $self->metadata->record;
|
|
}
|
|
|
|
=head3 record_schema
|
|
|
|
my $schema = $biblio->record_schema();
|
|
|
|
Returns the record schema (MARC21, USMARC or UNIMARC).
|
|
|
|
=cut
|
|
|
|
sub record_schema {
|
|
my ($self) = @_;
|
|
|
|
return $self->metadata->schema // C4::Context->preference("marcflavour");
|
|
}
|
|
|
|
=head3 metadata_record
|
|
|
|
my $record = $biblio->metadata_record(
|
|
{
|
|
[
|
|
embed_items => 1 | 0,
|
|
interface => 'opac' | 'intranet',
|
|
patron => $patron,
|
|
expand_coded_fields => 1 | 0
|
|
]
|
|
}
|
|
);
|
|
|
|
Returns the metadata serialized as appropriate for the metadata object
|
|
type. Currently only I<MARC::Record> objects are returned.
|
|
|
|
=cut
|
|
|
|
sub metadata_record {
|
|
my ( $self, $params ) = @_;
|
|
|
|
my $patron = $params->{patron};
|
|
|
|
my $record = $self->metadata->record;
|
|
|
|
if ( $params->{embed_items} or $params->{interface} ) {
|
|
|
|
# There's need for a RecordProcessor, let's do it!
|
|
my @filters;
|
|
my $options = {
|
|
interface => $params->{interface},
|
|
frameworkcode => $self->frameworkcode,
|
|
};
|
|
|
|
if ( $params->{embed_items} ) {
|
|
push @filters, 'EmbedItems';
|
|
if ( $params->{interface} && $params->{interface} eq 'opac' ) {
|
|
$options->{items} = $self->items->filter_by_visible_in_opac(
|
|
{ ( $params->{patron} ? ( patron => $params->{patron} ) : () ) } )->as_list;
|
|
} else {
|
|
$options->{items} = $self->items->as_list;
|
|
}
|
|
}
|
|
|
|
if ( $params->{interface} ) {
|
|
push @filters, 'ViewPolicy';
|
|
}
|
|
|
|
if ( $params->{expand_coded_fields} ) {
|
|
push @filters, 'ExpandCodedFields';
|
|
}
|
|
|
|
my $rp = Koha::RecordProcessor->new(
|
|
{
|
|
filters => \@filters,
|
|
options => $options
|
|
}
|
|
);
|
|
|
|
$rp->process($record);
|
|
}
|
|
|
|
return $record;
|
|
}
|
|
|
|
=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 uncancelled_orders
|
|
|
|
my $uncancelled_orders = $biblio->uncancelled_orders;
|
|
|
|
Returns acquisition orders related to this biblio that are not cancelled.
|
|
|
|
=cut
|
|
|
|
sub uncancelled_orders {
|
|
my ($self) = @_;
|
|
|
|
return $self->orders->filter_out_cancelled;
|
|
}
|
|
|
|
=head3 acq_status
|
|
|
|
print $biblio->acq_status;
|
|
|
|
This status can be:
|
|
- unlinked: not any linked order found in the system
|
|
- acquired: some lines are complete, rest is cancelled
|
|
- cancelled: all lines are cancelled
|
|
- processing: some lines are active or new
|
|
|
|
=cut
|
|
|
|
sub acq_status {
|
|
my ($self) = @_;
|
|
my $orders = $self->orders;
|
|
unless ( $orders->count ) {
|
|
return 'unlinked';
|
|
} elsif ( !$self->uncancelled_orders->count ) {
|
|
return 'cancelled';
|
|
} elsif ( $orders->search( { orderstatus => [ 'new', 'ordered', 'partial' ] } )->count ) {
|
|
return 'processing';
|
|
} else {
|
|
return 'acquired'; # some lines must be complete here
|
|
}
|
|
}
|
|
|
|
=head3 tickets
|
|
|
|
my $tickets = $biblio->tickets();
|
|
|
|
Returns all tickets linked to the biblio
|
|
|
|
=cut
|
|
|
|
sub tickets {
|
|
my ($self) = @_;
|
|
my $rs = $self->_result->tickets;
|
|
return Koha::Tickets->_new_from_dbic($rs);
|
|
}
|
|
|
|
=head3 ill_requests
|
|
|
|
my $ill_requests = $biblio->ill_requests();
|
|
|
|
Returns a Koha::ILL::Requests object
|
|
|
|
=cut
|
|
|
|
sub ill_requests {
|
|
my ($self) = @_;
|
|
|
|
my $ill_requests = $self->_result->ill_requests;
|
|
return Koha::ILL::Requests->_new_from_dbic($ill_requests);
|
|
}
|
|
|
|
=head3 item_groups
|
|
|
|
my $item_groups = $biblio->item_groups();
|
|
|
|
Returns a Koha::Biblio::ItemGroups object
|
|
|
|
=cut
|
|
|
|
sub item_groups {
|
|
my ($self) = @_;
|
|
|
|
my $item_groups = $self->_result->item_groups;
|
|
return Koha::Biblio::ItemGroups->_new_from_dbic($item_groups);
|
|
}
|
|
|
|
=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_edited
|
|
|
|
if ( $biblio->can_be_edited( $patron ) ) { ... }
|
|
|
|
Returns a boolean denoting whether the passed I<$patron> meets the required
|
|
conditions to manually edit the record.
|
|
|
|
=cut
|
|
|
|
sub can_be_edited {
|
|
my ( $self, $patron ) = @_;
|
|
|
|
Koha::Exceptions::MissingParameter->throw( error => "The patron parameter is missing or invalid" )
|
|
unless $patron && ref($patron) eq 'Koha::Patron';
|
|
|
|
my $is_fast_add =
|
|
defined $self->frameworkcode && $self->frameworkcode ne ''
|
|
? Koha::BiblioFrameworks->find( $self->frameworkcode )->is_fast_add
|
|
: 0;
|
|
|
|
my $editcatalogue =
|
|
$is_fast_add
|
|
? [ 'fast_cataloging', 'edit_catalogue' ]
|
|
: 'edit_catalogue';
|
|
|
|
return (
|
|
( $self->metadata->source_allows_editing && $patron->has_permission( { editcatalogue => $editcatalogue } ) )
|
|
|| $patron->has_permission( { editcatalogue => 'edit_locked_records' } ) ) ? 1 : 0;
|
|
}
|
|
|
|
=head3 check_booking
|
|
|
|
my $bookable =
|
|
$biblio->check_booking( { start_date => $datetime, end_date => $datetime, [ booking_id => $booking_id ] } );
|
|
|
|
Returns a boolean denoting whether the passed booking can be made without clashing.
|
|
|
|
Optionally, you may pass a booking id to exclude from the checks; This is helpful when you are updating an existing booking.
|
|
|
|
=cut
|
|
|
|
sub check_booking {
|
|
my ( $self, $params ) = @_;
|
|
|
|
my $start_date = dt_from_string( $params->{start_date} );
|
|
my $end_date = dt_from_string( $params->{end_date} );
|
|
my $booking_id = $params->{booking_id};
|
|
|
|
my $bookable_items = $self->bookable_items;
|
|
my $total_bookable = $bookable_items->count;
|
|
|
|
my $dtf = Koha::Database->new->schema->storage->datetime_parser;
|
|
my $existing_bookings = $self->bookings(
|
|
{
|
|
'-and' => [
|
|
{
|
|
'-or' => [
|
|
start_date => {
|
|
'-between' => [
|
|
$dtf->format_datetime($start_date),
|
|
$dtf->format_datetime($end_date)
|
|
]
|
|
},
|
|
end_date => {
|
|
'-between' => [
|
|
$dtf->format_datetime($start_date),
|
|
$dtf->format_datetime($end_date)
|
|
]
|
|
},
|
|
{
|
|
start_date => { '<' => $dtf->format_datetime($start_date) },
|
|
end_date => { '>' => $dtf->format_datetime($end_date) }
|
|
}
|
|
]
|
|
},
|
|
{ status => { '-not_in' => [ 'cancelled', 'completed' ] } }
|
|
]
|
|
}
|
|
);
|
|
|
|
my $booked_count =
|
|
defined($booking_id)
|
|
? $existing_bookings->search( { booking_id => { '!=' => $booking_id } } )->count
|
|
: $existing_bookings->count;
|
|
|
|
# Only count checkouts on bookable items; checkouts on non-bookable
|
|
# sibling items should not reduce the pool of available bookable items.
|
|
my $bookable_item_ids = [ $bookable_items->reset->get_column('itemnumber') ];
|
|
|
|
my $checkouts = $self->current_checkouts->search(
|
|
{
|
|
date_due => { '>=' => $dtf->format_datetime($start_date) },
|
|
"me.itemnumber" => {
|
|
'-not_in' => $existing_bookings->_resultset->get_column('item_id')->as_query,
|
|
'-in' => $bookable_item_ids,
|
|
},
|
|
|
|
# A checkout linked to the booking under consideration must not
|
|
# block that booking's own updates (see Koha::Item->check_booking)
|
|
(
|
|
defined($booking_id)
|
|
? ( "me.booking_id" => [ undef, { '!=' => $booking_id } ] )
|
|
: ()
|
|
),
|
|
}
|
|
);
|
|
$booked_count += $checkouts->count;
|
|
|
|
return ( ( $total_bookable - $booked_count ) > 0 ) ? 1 : 0;
|
|
}
|
|
|
|
=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 and if item can be transferred to each pickup location.
|
|
|
|
Throws a I<Koha::Exceptions::MissingParameter> exception if the B<mandatory> parameter I<patron>
|
|
is not passed.
|
|
|
|
=cut
|
|
|
|
sub pickup_locations {
|
|
my ( $self, $params ) = @_;
|
|
|
|
Koha::Exceptions::MissingParameter->throw( parameter => 'patron' )
|
|
unless exists $params->{patron};
|
|
|
|
my $patron = $params->{patron};
|
|
|
|
my $memory_cache = Koha::Cache::Memory::Lite->get_instance();
|
|
my @pickup_locations;
|
|
my $location_items;
|
|
foreach my $item ( $self->items->as_list ) {
|
|
my $cache_key = sprintf "Pickup_locations:%s:%s:%s:%s:%s",
|
|
$item->itype, $item->homebranch, $item->holdingbranch, $item->ccode || "", $patron->branchcode || "";
|
|
my $item_pickup_locations = $memory_cache->get_from_cache($cache_key);
|
|
unless ($item_pickup_locations) {
|
|
@{$item_pickup_locations} =
|
|
$item->pickup_locations( { patron => $patron } )->_resultset->get_column('branchcode')->all;
|
|
$memory_cache->set_in_cache( $cache_key, $item_pickup_locations );
|
|
}
|
|
push @pickup_locations, @{$item_pickup_locations};
|
|
for my $location ( @{$item_pickup_locations} ) {
|
|
push @{ $location_items->{$location} }, $item->itemnumber;
|
|
}
|
|
}
|
|
|
|
my $resultSet =
|
|
Koha::Libraries->search( { branchcode => { '-in' => \@pickup_locations } }, { order_by => ['branchname'] } );
|
|
|
|
$resultSet->{_pickup_location_items} = $location_items;
|
|
|
|
return $resultSet;
|
|
}
|
|
|
|
=head3 hidden_in_opac
|
|
|
|
my $bool = $biblio->hidden_in_opac({ [ rules => $rules ] })
|
|
|
|
Returns true if the biblio matches the hiding 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 ) = @_;
|
|
|
|
return 0 unless C4::Context->preference('OpacHiddenItemsHidesRecord');
|
|
|
|
my $rules = $params->{rules} // {};
|
|
|
|
my @items = $self->items->as_list;
|
|
|
|
return 0 unless @items; # Do not hide if there is no item
|
|
|
|
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 current_checkouts
|
|
|
|
my $current_checkouts = $biblio->current_checkouts
|
|
|
|
Returns the current checkouts associated with this biblio
|
|
|
|
=cut
|
|
|
|
sub current_checkouts {
|
|
my ($self) = @_;
|
|
|
|
return Koha::Checkouts->search(
|
|
{ "item.biblionumber" => $self->id },
|
|
{ join => 'item' }
|
|
);
|
|
}
|
|
|
|
=head3 old_checkouts
|
|
|
|
my $old_checkouts = $biblio->old_checkouts
|
|
|
|
Returns the past checkouts associated with this biblio
|
|
|
|
=cut
|
|
|
|
sub old_checkouts {
|
|
my ($self) = @_;
|
|
|
|
return Koha::Old::Checkouts->search(
|
|
{ "item.biblionumber" => $self->id },
|
|
{ join => 'item' }
|
|
);
|
|
}
|
|
|
|
=head3 items
|
|
|
|
my $items = $biblio->items({ [ host_items => 1 ] });
|
|
|
|
The optional param host_items allows you to include 'analytical' items.
|
|
|
|
Returns the related Koha::Items object for this biblio
|
|
|
|
=cut
|
|
|
|
sub items {
|
|
my ( $self, $params ) = @_;
|
|
|
|
my $items_rs = $self->_result->items;
|
|
|
|
return Koha::Items->_new_from_dbic($items_rs)
|
|
unless $params->{host_items} && C4::Context->preference('EasyAnalyticalRecords');
|
|
|
|
my @itemnumbers = $items_rs->get_column('itemnumber')->all;
|
|
my $host_itemnumbers = $self->_host_itemnumbers();
|
|
push @itemnumbers, @{$host_itemnumbers};
|
|
return Koha::Items->search( { "me.itemnumber" => { -in => \@itemnumbers } } );
|
|
}
|
|
|
|
=head3 bookable_items
|
|
|
|
my $bookable_items = $biblio->bookable_items;
|
|
|
|
Returns the related Koha::Items resultset filtered to those items that can be booked.
|
|
|
|
=cut
|
|
|
|
sub bookable_items {
|
|
my ($self) = @_;
|
|
return $self->items->filter_by_bookable;
|
|
}
|
|
|
|
=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 $host_itemnumbers = $self->_host_itemnumbers;
|
|
|
|
return Koha::Items->search( { "me.itemnumber" => { -in => $host_itemnumbers } } );
|
|
}
|
|
|
|
=head3 _host_itemnumbers
|
|
|
|
my $host_itemnumber = $biblio->_host_itemnumbers();
|
|
|
|
Return the itemnumbers for analytical items on this record
|
|
|
|
=cut
|
|
|
|
sub _host_itemnumbers {
|
|
my ($self) = @_;
|
|
|
|
my $marcflavour = C4::Context->preference("marcflavour");
|
|
my $analyticfield = '773';
|
|
if ( $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 \@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->holds->search( $params, $attributes );
|
|
return Koha::Holds->_new_from_dbic($hold_rs);
|
|
}
|
|
|
|
=head3 old_holds
|
|
|
|
my $old_holds = $biblio->old_holds();
|
|
|
|
return the historic holds placed on this record
|
|
|
|
=cut
|
|
|
|
sub old_holds {
|
|
my ( $self, $params, $attributes ) = @_;
|
|
$attributes->{order_by} = 'priority' unless exists $attributes->{order_by};
|
|
my $old_hold_rs = $self->_result->old_reserves->search( $params, $attributes );
|
|
return Koha::Old::Holds->_new_from_dbic($old_hold_rs);
|
|
}
|
|
|
|
=head3 current_holds
|
|
|
|
my $holds = $biblio->current_holds
|
|
|
|
Return the holds placed on this bibliographic record.
|
|
Respects the lookahead days in ConfirmFutureHolds pref.
|
|
|
|
=cut
|
|
|
|
sub current_holds {
|
|
my ($self) = @_;
|
|
my $dtf = Koha::Database->new->schema->storage->datetime_parser;
|
|
my $dt = dt_from_string()->add( days => C4::Context->preference('ConfirmFutureHolds') || 0 );
|
|
return $self->holds( { reservedate => { '<=' => $dtf->format_date($dt) } } );
|
|
}
|
|
|
|
=head3 biblioitem
|
|
|
|
my $field = $self->biblioitem
|
|
|
|
Returns the related Koha::Biblioitem object for this Biblio object
|
|
|
|
=cut
|
|
|
|
sub biblioitem {
|
|
my ($self) = @_;
|
|
return Koha::Biblioitems->find( { biblionumber => $self->biblionumber } );
|
|
}
|
|
|
|
=head3 bookings
|
|
|
|
my $bookings = $item->bookings();
|
|
|
|
Returns the bookings attached to this biblio.
|
|
|
|
=cut
|
|
|
|
sub bookings {
|
|
my ( $self, $params ) = @_;
|
|
my $bookings_rs = $self->_result->bookings->search($params);
|
|
return Koha::Bookings->_new_from_dbic($bookings_rs);
|
|
}
|
|
|
|
=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 get_marc_components
|
|
|
|
my $components = $self->get_marc_components();
|
|
|
|
Returns an array of search results data, which are component parts of
|
|
this object (MARC21 773 points to this)
|
|
|
|
=cut
|
|
|
|
sub get_marc_components {
|
|
my ( $self, $max_results ) = @_;
|
|
|
|
return [] if ( C4::Context->preference('marcflavour') ne 'MARC21' );
|
|
|
|
my ( $searchstr, $sort ) = $self->get_components_query;
|
|
|
|
my $components;
|
|
if ( defined($searchstr) ) {
|
|
my $searcher = Koha::SearchEngine::Search->new( { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
|
|
my ( $error, $results, $facets );
|
|
eval {
|
|
( $error, $results, $facets ) = $searcher->search_compat(
|
|
$searchstr, undef, [$sort], ['biblioserver'], $max_results, 0, undef, undef,
|
|
'ccl', 0
|
|
);
|
|
};
|
|
if ( $error || $@ ) {
|
|
$error //= q{};
|
|
$error .= $@ if $@;
|
|
warn "Warning from search_compat: '$error'";
|
|
$self->add_message(
|
|
{
|
|
type => 'error',
|
|
message => 'component_search',
|
|
payload => $error,
|
|
}
|
|
);
|
|
}
|
|
$components = $results->{biblioserver}->{RECORDS} if defined($results) && $results->{biblioserver}->{hits};
|
|
}
|
|
|
|
return $components // [];
|
|
}
|
|
|
|
=head2 get_components_query
|
|
|
|
Returns a query which can be used to search for all component parts of MARC21 biblios
|
|
|
|
=cut
|
|
|
|
sub get_components_query {
|
|
my ($self) = @_;
|
|
|
|
my $builder = Koha::SearchEngine::QueryBuilder->new( { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
|
|
my $marc = $self->metadata->record;
|
|
my $component_sort_field = C4::Context->preference('ComponentSortField') // "title";
|
|
my $component_sort_order = C4::Context->preference('ComponentSortOrder') // "asc";
|
|
my $sort = $component_sort_field . "_" . $component_sort_order;
|
|
|
|
my $searchstr;
|
|
if ( C4::Context->preference('UseControlNumber') ) {
|
|
my $pf001 = $marc->field('001') || undef;
|
|
|
|
if ( defined($pf001) ) {
|
|
$searchstr = "(";
|
|
my $pf003 = $marc->field('003') || undef;
|
|
|
|
if ( !defined($pf003) ) {
|
|
|
|
# search for 773$w='Host001'
|
|
$searchstr .= "rcn:\"" . $pf001->data() . "\"";
|
|
} else {
|
|
$searchstr .= "(";
|
|
|
|
# search for (773$w='Host001' and 003='Host003') or 773$w='(Host003)Host001'
|
|
$searchstr .= "(rcn:\"" . $pf001->data() . "\" AND cni:\"" . $pf003->data() . "\")";
|
|
$searchstr .= " OR rcn:\"" . $pf003->data() . " " . $pf001->data() . "\"";
|
|
$searchstr .= ")";
|
|
}
|
|
|
|
# limit to monograph and serial component part records
|
|
$searchstr .= " AND (bib-level:a OR bib-level:b)";
|
|
$searchstr .= ")";
|
|
}
|
|
} else {
|
|
my $cleaned_title = $marc->subfield( '245', "a" );
|
|
$cleaned_title =~ tr|/||;
|
|
$cleaned_title = $builder->clean_search_term($cleaned_title);
|
|
$searchstr = qq#Host-item:("$cleaned_title")#;
|
|
}
|
|
my ( $error, $query, $query_str ) = $builder->build_query_compat( undef, [$searchstr], undef, undef, [$sort], 0 );
|
|
if ($error) {
|
|
warn $error;
|
|
return;
|
|
}
|
|
|
|
return ( $query, $query_str, $sort );
|
|
}
|
|
|
|
=head3 get_marc_volumes
|
|
|
|
my $volumes = $self->get_marc_volumes();
|
|
|
|
Returns an array of MARCXML data, which are volumes parts of
|
|
this object (MARC21 773$w or 8xx$w point to this)
|
|
|
|
=cut
|
|
|
|
sub get_marc_volumes {
|
|
my ( $self, $max_results ) = @_;
|
|
|
|
return $self->{_volumes} if defined( $self->{_volumes} );
|
|
|
|
my $searchstr = $self->get_volumes_query;
|
|
|
|
if ( defined($searchstr) ) {
|
|
my $searcher = Koha::SearchEngine::Search->new( { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
|
|
my ( $errors, $results, $total_hits ) = $searcher->simple_search_compat( $searchstr, 0, $max_results );
|
|
$self->{_volumes} =
|
|
( defined($results) && scalar(@$results) ) ? $results : [];
|
|
} else {
|
|
$self->{_volumes} = [];
|
|
}
|
|
|
|
return $self->{_volumes};
|
|
}
|
|
|
|
=head2 get_volumes_query
|
|
|
|
Returns a query which can be used to search for all component parts of MARC21 biblios
|
|
|
|
=cut
|
|
|
|
sub get_volumes_query {
|
|
my ($self) = @_;
|
|
|
|
# MARC21 Only for now
|
|
return if ( C4::Context->preference('marcflavour') ne 'MARC21' );
|
|
|
|
my $marc = $self->metadata->record;
|
|
|
|
# Only build volumes query if we're in a 'Set' record
|
|
# or we have a monographic series.
|
|
# For monographic series the check on LDR 7 in (b or i or s) is omitted
|
|
my $leader19 = substr( $marc->leader, 19, 1 );
|
|
my $pf008 = $marc->field('008') || '';
|
|
my $mseries = ( $pf008 && substr( $pf008->data(), 21, 1 ) eq 'm' ) ? 1 : 0;
|
|
return unless ( $leader19 eq 'a' || $mseries );
|
|
|
|
my $builder = Koha::SearchEngine::QueryBuilder->new( { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
|
|
|
|
my $searchstr;
|
|
if ( C4::Context->preference('UseControlNumber') ) {
|
|
my $pf001 = $marc->field('001') || undef;
|
|
|
|
if ( defined($pf001) ) {
|
|
$searchstr = "(";
|
|
my $pf003 = $marc->field('003') || undef;
|
|
|
|
if ( !defined($pf003) ) {
|
|
|
|
# search for linking_field$w='Host001'
|
|
$searchstr .= "rcn:" . $pf001->data();
|
|
} else {
|
|
$searchstr .= "(";
|
|
|
|
# search for (linking_field$w='Host001' and 003='Host003') or linking_field$w='(Host003)Host001'
|
|
$searchstr .= "(rcn:" . $pf001->data() . " AND cni:" . $pf003->data() . ")";
|
|
$searchstr .= " OR rcn:\"" . $pf003->data() . " " . $pf001->data() . "\"";
|
|
$searchstr .= ")";
|
|
}
|
|
|
|
# exclude monograph and serial component part records
|
|
$searchstr .= " NOT (bib-level:a OR bib-level:b)";
|
|
$searchstr .= ")";
|
|
}
|
|
} else {
|
|
my $cleaned_title = $marc->subfield( '245', "a" );
|
|
$cleaned_title =~ tr|/||;
|
|
$cleaned_title = $builder->clean_search_term($cleaned_title);
|
|
$searchstr = qq#(title-series,phr:("$cleaned_title") OR Host-item,phr:("$cleaned_title")#;
|
|
$searchstr .= " NOT (bib-level:a OR bib-level:b))";
|
|
}
|
|
|
|
return $searchstr;
|
|
}
|
|
|
|
=head3 subscriptions
|
|
|
|
my $subscriptions = $self->subscriptions
|
|
|
|
Returns the related Koha::Subscriptions object for this Biblio object
|
|
|
|
=cut
|
|
|
|
sub subscriptions {
|
|
my ($self) = @_;
|
|
my $rs = $self->_result->subscriptions;
|
|
return Koha::Subscriptions->_new_from_dbic($rs);
|
|
}
|
|
|
|
=head3 serials
|
|
|
|
my $serials = $self->serials
|
|
|
|
Returns the related Koha::Serials object for this Biblio object
|
|
|
|
=cut
|
|
|
|
sub serials {
|
|
my ($self) = @_;
|
|
my $rs = $self->_result->serials;
|
|
return Koha::Serials->_new_from_dbic($rs);
|
|
}
|
|
|
|
=head3 subscription_histories
|
|
|
|
my $subscription_histories = $self->subscription_histories
|
|
|
|
Returns the related Koha::Subscription::Histories object for this Biblio object
|
|
|
|
=cut
|
|
|
|
sub subscription_histories {
|
|
my ($self) = @_;
|
|
my $rs = $self->_result->subscriptionhistories;
|
|
return Koha::Subscription::Histories->_new_from_dbic($rs);
|
|
}
|
|
|
|
=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 information 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 regarding 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 = $self->normalized_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;
|
|
if ($subfield) {
|
|
$value = $marc_record->subfield( $field, $subfield );
|
|
} else {
|
|
my $controlfield = $marc_record->field($field);
|
|
$value = $controlfield->data() if $controlfield;
|
|
}
|
|
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({ opac => 1 });
|
|
|
|
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 = C4::Context->preference('marcflavour');
|
|
my $opac = $params->{opac} // '0';
|
|
my $interface = $params->{opac} ? 'opac' : 'intranet';
|
|
|
|
my $record = $params->{record} // $self->metadata->record;
|
|
my $record_processor = Koha::RecordProcessor->new(
|
|
{
|
|
filters => [ 'ViewPolicy', 'ExpandCodedFields' ],
|
|
options => {
|
|
interface => $interface,
|
|
frameworkcode => $self->frameworkcode
|
|
}
|
|
}
|
|
);
|
|
$record_processor->process($record);
|
|
|
|
my $scope = $marcflavour eq "UNIMARC" ? '3..' : '5..';
|
|
|
|
#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 @marcnotes;
|
|
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, tag => $tag };
|
|
}
|
|
} else {
|
|
push @marcnotes, { marcnote => $field->as_string(), tag => $tag };
|
|
}
|
|
}
|
|
return \@marcnotes;
|
|
}
|
|
|
|
=head3 _get_marc_authors
|
|
|
|
Private method to return the list of authors contained in the MARC record.
|
|
See get get_marc_contributors and get_marc_authors for the public methods.
|
|
|
|
=cut
|
|
|
|
sub _get_marc_authors {
|
|
my ( $self, $params ) = @_;
|
|
|
|
my $fields_filter = $params->{fields_filter};
|
|
my $mintag = $params->{mintag};
|
|
my $maxtag = $params->{maxtag};
|
|
|
|
my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
|
|
my $marcflavour = C4::Context->preference('marcflavour');
|
|
|
|
# tagslib useful only for UNIMARC author responsibilities
|
|
my $tagslib =
|
|
$marcflavour eq "UNIMARC"
|
|
? C4::Biblio::GetMarcStructure( 1, $self->frameworkcode, { unsafe => 1 } )
|
|
: undef;
|
|
|
|
my @marcauthors;
|
|
foreach my $field ( $self->metadata->record->field($fields_filter) ) {
|
|
|
|
next
|
|
if $mintag && $field->tag() < $mintag
|
|
|| $maxtag && $field->tag() > $maxtag;
|
|
|
|
my @subfields_loop;
|
|
my @link_loop;
|
|
my @subfields = $field->subfields();
|
|
my $count_auth = 0;
|
|
|
|
# if there is an authority link, build the link with Koha-Auth-Number: subfield9
|
|
my $subfield9 = $field->subfield('9');
|
|
if ($subfield9) {
|
|
my $linkvalue = $subfield9;
|
|
$linkvalue =~ s/(\(|\))//g;
|
|
@link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
|
|
}
|
|
|
|
# other subfields
|
|
my $unimarc3;
|
|
for my $authors_subfield (@subfields) {
|
|
next if ( $authors_subfield->[0] eq '9' );
|
|
|
|
# unimarc3 contains the $3 of the author for UNIMARC.
|
|
# For french academic libraries, it's the "ppn", and it's required for idref webservice
|
|
$unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
|
|
|
|
# don't load unimarc subfields 3, 5
|
|
next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
|
|
|
|
my $code = $authors_subfield->[0];
|
|
my $value = $authors_subfield->[1];
|
|
my $linkvalue = $value;
|
|
$linkvalue =~ s/(\(|\))//g;
|
|
|
|
# UNIMARC author responsibility
|
|
if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
|
|
$value = C4::Biblio::GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
|
|
$linkvalue = "($value)";
|
|
}
|
|
|
|
# if no authority link, build a search query
|
|
unless ($subfield9) {
|
|
push @link_loop, {
|
|
limit => 'au',
|
|
'link' => $linkvalue,
|
|
operator => ( scalar @link_loop ) ? ' AND ' : undef
|
|
};
|
|
}
|
|
my @this_link_loop = @link_loop;
|
|
|
|
# do not display $0
|
|
unless ( $code eq '0' ) {
|
|
push @subfields_loop, {
|
|
tag => $field->tag(),
|
|
code => $code,
|
|
value => $value,
|
|
link_loop => \@this_link_loop,
|
|
separator => ( scalar @subfields_loop ) ? $AuthoritySeparator : ''
|
|
};
|
|
}
|
|
}
|
|
push @marcauthors, {
|
|
MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
|
|
authoritylink => $subfield9,
|
|
unimarc3 => $unimarc3
|
|
};
|
|
}
|
|
return \@marcauthors;
|
|
}
|
|
|
|
=head3 get_marc_contributors
|
|
|
|
my $contributors = $biblio->get_marc_contributors;
|
|
|
|
Get all contributors (but first author) from the MARC record and returns them in an array.
|
|
They are stored in different fields depending on MARC flavour (700..720 for MARC21)
|
|
|
|
=cut
|
|
|
|
sub get_marc_contributors {
|
|
my ( $self, $params ) = @_;
|
|
|
|
my ( $mintag, $maxtag, $fields_filter );
|
|
my $marcflavour = C4::Context->preference('marcflavour');
|
|
|
|
if ( $marcflavour eq "UNIMARC" ) {
|
|
$mintag = "700";
|
|
$maxtag = "712";
|
|
$fields_filter = '7..';
|
|
} else { # marc21/normarc
|
|
$mintag = "700";
|
|
$maxtag = "720";
|
|
$fields_filter = '7..';
|
|
}
|
|
|
|
return $self->_get_marc_authors(
|
|
{
|
|
fields_filter => $fields_filter,
|
|
mintag => $mintag,
|
|
maxtag => $maxtag
|
|
}
|
|
);
|
|
}
|
|
|
|
=head3 get_marc_authors
|
|
|
|
my $authors = $biblio->get_marc_authors;
|
|
|
|
Get all authors from the MARC record and returns them in an array.
|
|
They are stored in different fields depending on MARC flavour
|
|
(main author from 100 then secondary authors from 700..720).
|
|
|
|
=cut
|
|
|
|
sub get_marc_authors {
|
|
my ( $self, $params ) = @_;
|
|
|
|
my ( $mintag, $maxtag, $fields_filter );
|
|
my $marcflavour = C4::Context->preference('marcflavour');
|
|
|
|
if ( $marcflavour eq "UNIMARC" ) {
|
|
$fields_filter = '200';
|
|
} else { # marc21/normarc
|
|
$fields_filter = '1..';
|
|
$mintag = '100';
|
|
$maxtag = '111';
|
|
}
|
|
|
|
my @first_authors = @{
|
|
$self->_get_marc_authors(
|
|
{
|
|
fields_filter => $fields_filter,
|
|
mintag => $mintag,
|
|
maxtag => $maxtag
|
|
}
|
|
)
|
|
};
|
|
|
|
my @other_authors = @{ $self->get_marc_contributors };
|
|
|
|
return [ @first_authors, @other_authors ];
|
|
}
|
|
|
|
=head3 normalized_isbn
|
|
|
|
my $normalized_isbn = $biblio->normalized_isbn
|
|
|
|
Normalizes and returns the first valid ISBN found in the record.
|
|
ISBN13 are converted into ISBN10. This is required to get some book cover images.
|
|
|
|
=cut
|
|
|
|
sub normalized_isbn {
|
|
my ($self) = @_;
|
|
return C4::Koha::GetNormalizedISBN( $self->biblioitem->isbn );
|
|
}
|
|
|
|
=head3 public_read_list
|
|
|
|
This method returns the list of publicly readable database fields for both API and UI output purposes
|
|
|
|
=cut
|
|
|
|
sub public_read_list {
|
|
return [
|
|
'biblionumber', 'frameworkcode', 'author',
|
|
'title', 'medium', 'subtitle',
|
|
'part_number', 'part_name', 'unititle',
|
|
'notes', 'serial', 'seriestitle',
|
|
'copyrightdate', 'abstract'
|
|
];
|
|
}
|
|
|
|
=head3 metadata_extractor
|
|
|
|
my $extractor = $biblio->metadata_extractor
|
|
|
|
Return a Koha::Biblio::Metadata::Extractor object to use to extract data from the metadata (ie. MARC record for now)
|
|
|
|
=cut
|
|
|
|
sub metadata_extractor {
|
|
my ($self) = @_;
|
|
|
|
$self->{metadata_extractor} ||= Koha::Biblio::Metadata::Extractor->new( { biblio => $self } );
|
|
|
|
return $self->{metadata_extractor};
|
|
}
|
|
|
|
=head3 normalized_upc
|
|
|
|
my $normalized_upc = $biblio->normalized_upc
|
|
|
|
Normalizes and returns the UPC value found in the MARC record.
|
|
|
|
=cut
|
|
|
|
sub normalized_upc {
|
|
my ($self) = @_;
|
|
return $self->metadata_extractor->get_normalized_upc;
|
|
}
|
|
|
|
=head3 normalized_ean
|
|
|
|
my $normalized_ean = $biblio->normalized_ean
|
|
|
|
Normalizes and returns the EAN found in the MARC record.
|
|
|
|
=cut
|
|
|
|
sub normalized_ean {
|
|
my ($self) = @_;
|
|
return $self->metadata_extractor->get_normalized_ean;
|
|
}
|
|
|
|
=head3 normalized_oclc
|
|
|
|
my $normalized_oclc = $biblio->normalized_oclc
|
|
|
|
Normalizes and returns the OCLC number found in the MARC record.
|
|
|
|
=cut
|
|
|
|
sub normalized_oclc {
|
|
my ($self) = @_;
|
|
return $self->metadata_extractor->get_normalized_oclc;
|
|
}
|
|
|
|
=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 $json_biblio = $self->SUPER::to_api($args);
|
|
return unless $json_biblio;
|
|
|
|
$args = defined $args ? {%$args} : {};
|
|
delete $args->{embed};
|
|
|
|
my $biblioitem = $self->biblioitem;
|
|
|
|
Koha::Exceptions::RelatedObjectNotFound->throw( accessor => 'biblioitem', class => 'Koha::Biblioitem' )
|
|
unless $biblioitem;
|
|
|
|
my $json_biblioitem = $biblioitem->to_api($args);
|
|
return unless $json_biblioitem;
|
|
|
|
return { %$json_biblioitem, %$json_biblio };
|
|
}
|
|
|
|
=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',
|
|
deleted_on => undef,
|
|
};
|
|
}
|
|
|
|
=head3 get_marc_host
|
|
|
|
$host = $biblio->get_marc_host;
|
|
# OR:
|
|
( $host, $relatedparts, $hostinfo ) = $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).
|
|
|
|
If there is no $w, we use $0 (host biblionumber) or $9 (host itemnumber)
|
|
to search for the host record. If there is also no $0 and no $9, we search
|
|
using author and title. Failing all of that, we return an undef host and
|
|
form a concatenation of strings with 773$agt for host information,
|
|
returned when called in list context.
|
|
|
|
=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;
|
|
}
|
|
}
|
|
|
|
my $engine = Koha::SearchEngine::Search->new( { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
|
|
my $bibno;
|
|
if ( !$hostfld and $record->subfield( '773', 't' ) ) {
|
|
|
|
# not linked using $w
|
|
my $unlinkedf = $record->field('773');
|
|
my $host;
|
|
if ( C4::Context->preference("EasyAnalyticalRecords") ) {
|
|
if ( $unlinkedf->subfield('0') ) {
|
|
|
|
# use 773$0 host biblionumber
|
|
$bibno = $unlinkedf->subfield('0');
|
|
} elsif ( $unlinkedf->subfield('9') ) {
|
|
|
|
# use 773$9 host itemnumber
|
|
my $linkeditemnumber = $unlinkedf->subfield('9');
|
|
$bibno = Koha::Items->find($linkeditemnumber)->biblionumber;
|
|
}
|
|
}
|
|
if ($bibno) {
|
|
my $host = Koha::Biblios->find($bibno) or return;
|
|
return wantarray ? ( $host, $unlinkedf->subfield('g') ) : $host;
|
|
}
|
|
|
|
# just return plaintext and no host record
|
|
my $hostinfo = join( ", ", $unlinkedf->subfield('a'), $unlinkedf->subfield('t'), $unlinkedf->subfield('g') );
|
|
return wantarray ? ( undef, $unlinkedf->subfield('g'), $hostinfo ) : undef;
|
|
}
|
|
return if !$hostfld;
|
|
my $rcn = $hostfld->subfield('w');
|
|
|
|
# Look for control number with/without orgcode
|
|
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;
|
|
}
|
|
}
|
|
|
|
=head3 get_marc_host_only
|
|
|
|
my $host = $biblio->get_marc_host_only;
|
|
|
|
Return host only
|
|
|
|
=cut
|
|
|
|
sub get_marc_host_only {
|
|
my ($self) = @_;
|
|
|
|
my ($host) = $self->get_marc_host;
|
|
|
|
return $host;
|
|
}
|
|
|
|
=head3 get_marc_relatedparts_only
|
|
|
|
my $relatedparts = $biblio->get_marc_relatedparts_only;
|
|
|
|
Return related parts only
|
|
|
|
=cut
|
|
|
|
sub get_marc_relatedparts_only {
|
|
my ($self) = @_;
|
|
|
|
my ( undef, $relatedparts ) = $self->get_marc_host;
|
|
|
|
return $relatedparts;
|
|
}
|
|
|
|
=head3 get_marc_hostinfo_only
|
|
|
|
my $hostinfo = $biblio->get_marc_hostinfo_only;
|
|
|
|
Return host info only
|
|
|
|
=cut
|
|
|
|
sub get_marc_hostinfo_only {
|
|
my ($self) = @_;
|
|
|
|
my ( $host, $relatedparts, $hostinfo ) = $self->get_marc_host;
|
|
|
|
return $hostinfo;
|
|
}
|
|
|
|
=head3 generate_marc_host_field
|
|
|
|
my $link_field = $biblio->generate_marc_host_field;
|
|
$child->link_marc_host( $link_field );
|
|
|
|
This method generates a MARC link field from the host record that can be added to child
|
|
records to link them to the host record.
|
|
|
|
NOTE: This replicates and partially enhances C4::Biblio::prepare_marc_host(). We should merge
|
|
functionality from C4::Biblio::PrepareMarcHost() too and then replace all calls to those methods
|
|
with this one and remove those alternatives from the codebase.
|
|
|
|
=cut
|
|
|
|
sub generate_marc_host_field {
|
|
my ($self) = @_;
|
|
|
|
my $marcflavour = C4::Context->preference('marcflavour');
|
|
my $marc_host = $self->metadata->record;
|
|
|
|
my @sfd;
|
|
my $host_field;
|
|
my $link_field;
|
|
|
|
if ( $marcflavour eq 'MARC21' ) {
|
|
|
|
# Attempt to clone the main entry (100, 110, or 111)
|
|
my $main_entry = $marc_host->field('100') || $marc_host->field('110') || $marc_host->field('111');
|
|
$main_entry = $main_entry ? $main_entry->clone : undef;
|
|
|
|
# Clean unwanted subfields based on tag type
|
|
if ($main_entry) {
|
|
if ( $main_entry->tag eq '111' ) {
|
|
$main_entry->delete_subfield( code => qr/[94j]/ );
|
|
} else {
|
|
$main_entry->delete_subfield( code => qr/[94e]/ );
|
|
}
|
|
}
|
|
|
|
# Construct subfield 7 from leader and main entry tag
|
|
my $s7 = "nn" . substr( $marc_host->leader, 6, 2 );
|
|
if ($main_entry) {
|
|
my $c1 = 'n';
|
|
if ( $main_entry->tag =~ /^1[01]/ ) {
|
|
$c1 = $main_entry->indicator('1');
|
|
$c1 = $main_entry->tag eq '100' ? 1 : 2 unless $c1 =~ /\d/;
|
|
}
|
|
my $c0 =
|
|
( $main_entry->tag eq '100' ) ? 'p'
|
|
: ( $main_entry->tag eq '110' ) ? 'c'
|
|
: ( $main_entry->tag eq '111' ) ? 'm'
|
|
: 'u';
|
|
substr( $s7, 0, 2, $c0 . $c1 );
|
|
}
|
|
push @sfd, ( '7' => $s7 );
|
|
|
|
# Subfield a - cleaned main entry string
|
|
if ($main_entry) {
|
|
my $a = $main_entry->as_string;
|
|
$a =~ s/\.$// unless $a =~ /\b[a-z]{1,2}\.$/i;
|
|
push @sfd, ( 'a' => $a );
|
|
}
|
|
|
|
# Subfield t - title from 245, cleaned
|
|
if ( my $f245 = $marc_host->field('245') ) {
|
|
my $f245c = $f245->clone;
|
|
$f245c->delete_subfield( code => 'c' );
|
|
my $t = $f245c->as_string;
|
|
$t =~ s/[\s\/\\.]+$//;
|
|
my $nonfiling = $f245c->indicator('2') // 0;
|
|
$nonfiling = 0 unless $nonfiling =~ /^\d+$/;
|
|
$t = ucfirst substr( $t, $nonfiling );
|
|
push @sfd, ( 't' => $t );
|
|
}
|
|
|
|
# Subfield b - edition from 250
|
|
if ( my $f250 = $marc_host->field('250') ) {
|
|
my $b = $f250->as_string;
|
|
$b =~ s/\.$//;
|
|
if ($b) {
|
|
push @sfd, ( 'b' => $b );
|
|
}
|
|
}
|
|
|
|
# Subfield s - uniform title from 240
|
|
if ( my $f240 = $marc_host->field('240') ) {
|
|
my $s = $f240->as_string('a');
|
|
if ($s) {
|
|
push @sfd, ( 's' => $s );
|
|
}
|
|
}
|
|
|
|
# Subfield d - publication info from 264/260
|
|
my $d;
|
|
my @publication_fields = $marc_host->field('264');
|
|
@publication_fields = $marc_host->field('260') unless (@publication_fields);
|
|
my $index = 0;
|
|
for my $publication_field (@publication_fields) {
|
|
|
|
# Use first entry unless we find a preferred indicator1 = 3
|
|
if ( $index == 0 ) {
|
|
my $s = $publication_field->as_string('abc');
|
|
$s =~ s/\.$//;
|
|
if ($s) {
|
|
$d = $s;
|
|
}
|
|
$index++;
|
|
}
|
|
if ( $publication_field->indicator(1) && ( $publication_field->indicator(1) eq '3' ) ) {
|
|
my $s = $publication_field->as_string('abc');
|
|
$s =~ s/\.$//;
|
|
if ($s) {
|
|
$d = $s;
|
|
}
|
|
last;
|
|
}
|
|
}
|
|
push @sfd, ( d => $d ) if $d;
|
|
|
|
# Subfield k - host info from 800-830 fields
|
|
for my $f ( $marc_host->field('8[013][01]') ) {
|
|
my $k = $f->as_string('abcdnjltnp');
|
|
$k .= ', ISSN ' . $f->subfield('x') if $f->subfield('x');
|
|
$k .= ' ; ' . $f->subfield('v') if $f->subfield('v');
|
|
push @sfd, ( 'k' => $k );
|
|
}
|
|
|
|
# Subfield x - ISSN from 022
|
|
for my $f ( $marc_host->field('022') ) {
|
|
push @sfd, ( 'x' => $f->subfield('a') ) if $f->subfield('a');
|
|
}
|
|
|
|
# Subfield z - ISBN from 020
|
|
for my $f ( $marc_host->field('020') ) {
|
|
push @sfd, ( 'z' => $f->subfield('a') ) if $f->subfield('a');
|
|
}
|
|
|
|
# Subfield w - control number (001 and optionally 003)
|
|
if ( C4::Context->preference('UseControlNumber') ) {
|
|
if ( my $f001 = $marc_host->field('001') ) {
|
|
my $w = $f001->data;
|
|
if ( my $f003 = $marc_host->field('003') ) {
|
|
$w = '(' . $f003->data . ')' . $w;
|
|
}
|
|
push @sfd, ( 'w' => $w );
|
|
}
|
|
}
|
|
|
|
# Construct 773 link field
|
|
$link_field = MARC::Field->new( 773, '0', ' ', @sfd );
|
|
|
|
} elsif ( $marcflavour eq 'UNIMARC' ) {
|
|
|
|
# Author (700/710/720)
|
|
if ( $host_field = $marc_host->field('700') || $marc_host->field('710') || $marc_host->field('720') ) {
|
|
my $s = $host_field->as_string('ab');
|
|
push @sfd, ( 'a' => $s ) if $s;
|
|
}
|
|
|
|
# Title (200)
|
|
if ( $host_field = $marc_host->field('200') ) {
|
|
my $s = $host_field->as_string('a');
|
|
push @sfd, ( 't' => $s ) if $s;
|
|
}
|
|
|
|
# Place of publication (210$a)
|
|
if ( $host_field = $marc_host->field('210') ) {
|
|
my $s = $host_field->as_string('a');
|
|
push @sfd, ( 'c' => $s ) if $s;
|
|
}
|
|
|
|
# Date of publication (210$d)
|
|
if ( $host_field = $marc_host->field('210') ) {
|
|
my $s = $host_field->as_string('d');
|
|
push @sfd, ( 'd' => $s ) if $s;
|
|
}
|
|
|
|
# Edition statement (205)
|
|
if ( $host_field = $marc_host->field('205') ) {
|
|
my $s = $host_field->as_string;
|
|
push @sfd, ( 'e' => $s ) if $s;
|
|
}
|
|
|
|
# URL (856$u)
|
|
if ( $host_field = $marc_host->field('856') ) {
|
|
my $s = $host_field->as_string('u');
|
|
push @sfd, ( u => $s ) if ($s);
|
|
}
|
|
|
|
# ISSN (011$a)
|
|
if ( $host_field = $marc_host->field('011') ) {
|
|
my $s = $host_field->as_string('a');
|
|
push @sfd, ( x => $s ) if ($s);
|
|
}
|
|
|
|
# ISBN (010$a)
|
|
if ( $host_field = $marc_host->field('010') ) {
|
|
my $s = $host_field->as_string('a');
|
|
push @sfd, ( y => $s ) if ($s);
|
|
}
|
|
|
|
# Control number (001)
|
|
if ( $host_field = $marc_host->field('001') ) {
|
|
push @sfd, ( 0 => $host_field->data() );
|
|
}
|
|
|
|
# Construct 461 link field
|
|
$link_field = MARC::Field->new( 461, '0', ' ', @sfd );
|
|
}
|
|
|
|
return $link_field;
|
|
}
|
|
|
|
=head3 link_marc_host
|
|
|
|
$biblio->link_marc_host({ field => $link_field});
|
|
$biblio->link_marc_host({ host => $biblio });
|
|
$biblio->link_marc_host({ host => $biblionumber });
|
|
|
|
Links a child MARC record to the parent. Expects either a pre-formed link field as generated by
|
|
$parent->get_link_field, the biblio object or biblionumber of the host to link to.
|
|
|
|
=cut
|
|
|
|
sub link_marc_host {
|
|
my ( $self, $params ) = @_;
|
|
|
|
my $host_link_field;
|
|
if ( $params->{field} ) {
|
|
$host_link_field = $params->{field};
|
|
} elsif ( ref( $params->{host} ) eq 'Koha::Biblio' ) {
|
|
$host_link_field = $params->{host}->generate_marc_host_field;
|
|
} else {
|
|
my $host = Koha::Biblios->find( $params->{host} );
|
|
$host_link_field = $host->generate_marc_host_field;
|
|
}
|
|
|
|
my $marc_record = $self->metadata->record;
|
|
$marc_record->append_fields($host_link_field);
|
|
|
|
C4::Biblio::ModBiblioMarc( $marc_record, $self->biblionumber );
|
|
return $self;
|
|
}
|
|
|
|
=head3 age_restriction
|
|
|
|
my $age = $biblio->age_restriction;
|
|
|
|
Extracts the numeric age restriction from the biblio's agerestriction field
|
|
using the AgeRestrictionMarker system preference.
|
|
|
|
Returns the age (integer) or undef if no restriction is found.
|
|
|
|
=cut
|
|
|
|
sub age_restriction {
|
|
my ($self) = @_;
|
|
|
|
my $restriction_string = $self->biblioitem->agerestriction;
|
|
return unless $restriction_string;
|
|
|
|
my @values = split ' ', uc($restriction_string);
|
|
return unless @values;
|
|
|
|
my @markers = map { my $m = uc($_); $m =~ s/^\s+//; $m =~ s/\s+$//; $m }
|
|
@{ C4::Context->multivalue_preference('AgeRestrictionMarker') };
|
|
return unless @markers;
|
|
|
|
my $index = 0;
|
|
my $restriction_age = 0;
|
|
for my $value (@values) {
|
|
$index++;
|
|
for my $marker (@markers) {
|
|
if ( $marker eq $value ) {
|
|
if ( $index <= $#values ) {
|
|
$restriction_age += $values[$index];
|
|
}
|
|
last;
|
|
} elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
|
|
$restriction_age += $1;
|
|
last;
|
|
}
|
|
}
|
|
last if ( $restriction_age > 0 );
|
|
}
|
|
|
|
return $restriction_age || undef;
|
|
}
|
|
|
|
=head3 recalls
|
|
|
|
my $recalls = $biblio->recalls;
|
|
|
|
Return recalls linked to this biblio
|
|
|
|
=cut
|
|
|
|
sub recalls {
|
|
my ($self) = @_;
|
|
return Koha::Recalls->_new_from_dbic( scalar $self->_result->recalls );
|
|
}
|
|
|
|
=head3 can_be_recalled
|
|
|
|
my @items_for_recall = $biblio->can_be_recalled({ patron => $patron_object });
|
|
|
|
Does biblio-level checks and returns the items attached to this biblio that are available for recall
|
|
|
|
If hold_convert $param is included, this is a check to convert a hold to a recall, so we should not check for an existing hold.
|
|
|
|
=cut
|
|
|
|
sub can_be_recalled {
|
|
my ( $self, $params ) = @_;
|
|
|
|
return 0 if ( C4::Context->preference('UseRecalls') eq "off" );
|
|
|
|
my $patron = $params->{patron};
|
|
|
|
my $branchcode = C4::Context->userenv->{'branch'};
|
|
if ( C4::Context->preference('CircControl') eq 'PatronLibrary' and $patron ) {
|
|
$branchcode = $patron->branchcode;
|
|
}
|
|
|
|
my @all_items = Koha::Items->search( { biblionumber => $self->biblionumber } )->as_list;
|
|
|
|
# if there are no available items at all, no recall can be placed
|
|
return 0 if ( scalar @all_items == 0 );
|
|
|
|
my @itemtypes;
|
|
my @itemnumbers;
|
|
my @items;
|
|
my @all_itemnumbers;
|
|
foreach my $item (@all_items) {
|
|
push( @all_itemnumbers, $item->itemnumber );
|
|
if ( $item->can_be_recalled( { patron => $patron, hold_convert => $params->{hold_convert} } ) ) {
|
|
push( @itemtypes, $item->effective_itemtype );
|
|
push( @itemnumbers, $item->itemnumber );
|
|
push( @items, $item );
|
|
}
|
|
}
|
|
|
|
# if there are no recallable items, no recall can be placed
|
|
return 0 if ( scalar @items == 0 );
|
|
|
|
# Check the circulation rule for each relevant itemtype for this biblio
|
|
my ( @recalls_allowed, @recalls_per_record, @on_shelf_recalls );
|
|
foreach my $itemtype (@itemtypes) {
|
|
my $rule = Koha::CirculationRules->get_effective_rules(
|
|
{
|
|
branchcode => $branchcode,
|
|
categorycode => $patron ? $patron->categorycode : undef,
|
|
itemtype => $itemtype,
|
|
rules => [
|
|
'recalls_allowed',
|
|
'recalls_per_record',
|
|
'on_shelf_recalls',
|
|
],
|
|
}
|
|
);
|
|
push( @recalls_allowed, $rule->{recalls_allowed} ) if $rule;
|
|
push( @recalls_per_record, $rule->{recalls_per_record} ) if $rule;
|
|
push( @on_shelf_recalls, $rule->{on_shelf_recalls} ) if $rule;
|
|
}
|
|
my $recalls_allowed = ( sort { $b <=> $a } @recalls_allowed )[0]; # take highest
|
|
my $recalls_per_record = ( sort { $b <=> $a } @recalls_per_record )[0]; # take highest
|
|
my %on_shelf_recalls_count = ();
|
|
foreach my $count (@on_shelf_recalls) {
|
|
$on_shelf_recalls_count{$count}++;
|
|
}
|
|
my $on_shelf_recalls = ( sort { $on_shelf_recalls_count{$b} <=> $on_shelf_recalls_count{$a} } @on_shelf_recalls )[0]
|
|
; # take most common
|
|
|
|
# check recalls allowed has been set and is not zero
|
|
return 0 if ( !defined($recalls_allowed) || $recalls_allowed == 0 );
|
|
|
|
if ($patron) {
|
|
|
|
# check borrower has not reached open recalls allowed limit
|
|
return 0 if ( $patron->recalls->filter_by_current->count >= $recalls_allowed );
|
|
|
|
# check borrower has not reached open recalls allowed per record limit
|
|
return 0
|
|
if ( $patron->recalls->filter_by_current->search( { biblio_id => $self->biblionumber } )->count >=
|
|
$recalls_per_record );
|
|
|
|
# check if any of the items under this biblio are already checked out by this borrower
|
|
return 0
|
|
if (
|
|
Koha::Checkouts->search( { itemnumber => [@all_itemnumbers], borrowernumber => $patron->borrowernumber } )
|
|
->count > 0 );
|
|
}
|
|
|
|
# check item availability
|
|
my $checked_out_count = 0;
|
|
foreach (@items) {
|
|
if ( Koha::Checkouts->search( { itemnumber => $_->itemnumber } )->count > 0 ) { $checked_out_count++; }
|
|
}
|
|
|
|
# can't recall if on shelf recalls only allowed when all unavailable, but items are still available for checkout
|
|
return 0 if ( $on_shelf_recalls eq 'all' && $checked_out_count < scalar @items );
|
|
|
|
# can't recall if no items have been checked out
|
|
return 0 if ( $checked_out_count == 0 );
|
|
|
|
# can recall
|
|
return @items;
|
|
}
|
|
|
|
=head3 ratings
|
|
|
|
my $ratings = $biblio->ratings
|
|
|
|
Return a Koha::Ratings object representing the ratings of this bibliographic record
|
|
|
|
=cut
|
|
|
|
sub ratings {
|
|
my ($self) = @_;
|
|
my $rs = $self->_result->ratings;
|
|
return Koha::Ratings->_new_from_dbic($rs);
|
|
}
|
|
|
|
=head3 opac_summary_html
|
|
|
|
my $summary_html = $biblio->opac_summary_html
|
|
|
|
Based on the syspref OPACMySummaryHTML, returns a string representing the
|
|
summary of this bibliographic record.
|
|
{AUTHOR}, {TITLE}, {ISBN} and {BIBLIONUMBER} will be replaced.
|
|
|
|
=cut
|
|
|
|
sub opac_summary_html {
|
|
my ($self) = @_;
|
|
|
|
my $summary_html = C4::Context->preference('OPACMySummaryHTML');
|
|
return q{} unless $summary_html;
|
|
my $author = $self->author || q{};
|
|
my $title = $self->title || q{};
|
|
$title =~ s/\/+$//; # remove trailing slash
|
|
$title =~ s/\s+$//; # remove trailing space
|
|
my $normalized_isbn = $self->normalized_isbn || q{};
|
|
my $biblionumber = $self->biblionumber;
|
|
|
|
$summary_html =~ s/{AUTHOR}/$author/g;
|
|
$summary_html =~ s/{TITLE}/$title/g;
|
|
$summary_html =~ s/{ISBN}/$normalized_isbn/g;
|
|
$summary_html =~ s/{BIBLIONUMBER}/$biblionumber/g;
|
|
|
|
return $summary_html;
|
|
}
|
|
|
|
=head3 merge_with
|
|
|
|
my $biblio = Koha::Biblios->find($biblionumber);
|
|
$biblio->merge_with(\@biblio_ids);
|
|
|
|
This subroutine merges a list of bibliographic records into the bibliographic record.
|
|
This function DOES NOT CHANGE the bibliographic metadata of the record. But it links all
|
|
items, holds, subscriptions, serials issues and article_requests to the record. After doing changes
|
|
bibliographic records listed are deleted
|
|
|
|
=cut
|
|
|
|
sub merge_with {
|
|
my ( $self, $biblio_ids ) = @_;
|
|
|
|
my $schema = Koha::Database->new()->schema();
|
|
my $ref_biblionumber = $self->biblionumber;
|
|
my %results = ( 'biblio_id' => $ref_biblionumber, 'merged_ids' => [] );
|
|
|
|
# Ensure the keeper isn't in the list of records to merge
|
|
my @biblio_ids_to_merge = grep { $_ ne $ref_biblionumber } @$biblio_ids;
|
|
|
|
try {
|
|
$schema->txn_do(
|
|
sub {
|
|
foreach my $bn_merge (@biblio_ids_to_merge) {
|
|
my $from_biblio = Koha::Biblios->find($bn_merge);
|
|
$from_biblio->items->move_to_biblio($self);
|
|
|
|
# Move item groups
|
|
$from_biblio->item_groups->update(
|
|
{ biblio_id => $ref_biblionumber },
|
|
{ no_triggers => 1 }
|
|
);
|
|
|
|
# Move article requests
|
|
$from_biblio->article_requests->update(
|
|
{ biblionumber => $ref_biblionumber },
|
|
{ no_triggers => 1 }
|
|
);
|
|
|
|
# Move subscriptions
|
|
$from_biblio->subscriptions->update(
|
|
{ biblionumber => $ref_biblionumber },
|
|
{ no_triggers => 1 }
|
|
);
|
|
|
|
# Move subscription histories
|
|
$from_biblio->subscription_histories->update(
|
|
{ biblionumber => $ref_biblionumber },
|
|
{ no_triggers => 1 }
|
|
);
|
|
|
|
# Move serials
|
|
$from_biblio->serials->update(
|
|
{ biblionumber => $ref_biblionumber },
|
|
{ no_triggers => 1 }
|
|
);
|
|
|
|
# Move suggestions
|
|
$from_biblio->suggestions->update(
|
|
{ biblionumber => $ref_biblionumber },
|
|
{ no_triggers => 1 }
|
|
);
|
|
|
|
my $orders = $from_biblio->orders->unblessed;
|
|
for my $order (@$orders) {
|
|
$order->{'biblionumber'} = $ref_biblionumber;
|
|
|
|
# TODO Do we really need to call ModOrder here?
|
|
ModOrder($order);
|
|
|
|
# TODO : add error control (in ModOrder?)
|
|
}
|
|
|
|
# Move holds
|
|
MergeHolds( $schema->storage->dbh, $ref_biblionumber, $bn_merge );
|
|
|
|
my $error = DelBiblio($bn_merge); #DelBiblio return undef unless an error occurs
|
|
if ($error) {
|
|
die $error;
|
|
} else {
|
|
push( @{ $results{merged_ids} }, $bn_merge );
|
|
}
|
|
}
|
|
}
|
|
);
|
|
} catch {
|
|
Koha::Exception->throw($_);
|
|
};
|
|
return \%results;
|
|
}
|
|
|
|
=head2 Internal methods
|
|
|
|
=head3 _unblessed_for_log
|
|
|
|
Returns a plain hashref of biblio column values that are not derived from
|
|
the attached MARC record, for use in action log diffing.
|
|
|
|
Fields such as C<author>, C<title>, C<subtitle> etc. are omitted because
|
|
they are denormalised copies of MARC data and would duplicate what is
|
|
already captured in the C<_marc> key of the log entry. Only fields that
|
|
carry independent Koha metadata are retained: C<frameworkcode>,
|
|
C<opac_suppressed>, and C<serial>. The C<timestamp> and C<datecreated>
|
|
columns are also excluded as they are system-managed and add no signal.
|
|
|
|
=cut
|
|
|
|
# Biblio table columns that exist independently of the MARC record.
|
|
my @_LOG_FIELDS = qw( frameworkcode opac_suppressed serial );
|
|
|
|
sub _unblessed_for_log {
|
|
my ($self) = @_;
|
|
my $full = $self->unblessed;
|
|
my %data;
|
|
for my $key (@_LOG_FIELDS) {
|
|
next unless exists $full->{$key} && defined $full->{$key};
|
|
$data{$key} = blessed( $full->{$key} ) ? "$full->{$key}" : $full->{$key};
|
|
}
|
|
return \%data;
|
|
}
|
|
|
|
=head3 _type
|
|
|
|
=cut
|
|
|
|
sub _type {
|
|
return 'Biblio';
|
|
}
|
|
|
|
=head1 AUTHOR
|
|
|
|
Kyle M Hall <kyle@bywatersolutions.com>
|
|
|
|
=cut
|
|
|
|
1;
|