3 # Copyright ByWater Solutions 2014
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22 use List::MoreUtils qw( any );
24 use URI::Escape qw( uri_escape_utf8 );
26 use C4::Koha qw( GetNormalizedISBN GetNormalizedUPC GetNormalizedOCLCNumber );
29 use Koha::DateUtils qw( dt_from_string );
31 use base qw(Koha::Object);
33 use Koha::Acquisition::Orders;
34 use Koha::ArticleRequests;
35 use Koha::Biblio::Metadatas;
36 use Koha::Biblio::Metadata::Extractor;
37 use Koha::Biblio::ItemGroups;
38 use Koha::Biblioitems;
39 use Koha::Cache::Memory::Lite;
41 use Koha::CirculationRules;
43 use Koha::Illrequests;
44 use Koha::Item::Transfer::Limits;
47 use Koha::Old::Checkouts;
50 use Koha::RecordProcessor;
51 use Koha::Suggestions;
52 use Koha::Subscriptions;
53 use Koha::SearchEngine;
54 use Koha::SearchEngine::Search;
55 use Koha::SearchEngine::QueryBuilder;
60 Koha::Biblio - Koha Biblio Object class
70 Overloaded I<store> method to set default values
77 $self->datecreated( dt_from_string ) unless $self->datecreated;
79 return $self->SUPER::store;
84 my $metadata = $biblio->metadata();
86 Returns a Koha::Biblio::Metadata object
93 my $metadata = $self->_result->metadata;
94 return Koha::Biblio::Metadata->_new_from_dbic($metadata);
99 my $record = $biblio->record();
101 Returns a Marc::Record object
108 return $self->metadata->record;
113 my $schema = $biblio->record_schema();
115 Returns the record schema (MARC21, USMARC or UNIMARC).
122 return $self->metadata->schema // C4::Context->preference("marcflavour");
127 my $orders = $biblio->orders();
129 Returns a Koha::Acquisition::Orders object
136 my $orders = $self->_result->orders;
137 return Koha::Acquisition::Orders->_new_from_dbic($orders);
142 my $active_orders = $biblio->active_orders();
144 Returns the active acquisition orders related to this biblio.
145 An order is considered active when it is not cancelled (i.e. when datecancellation
153 return $self->orders->search({ datecancellationprinted => undef });
158 my $tickets = $biblio->tickets();
160 Returns all tickets linked to the biblio
166 my $rs = $self->_result->tickets;
167 return Koha::Tickets->_new_from_dbic( $rs );
172 my $ill_requests = $biblio->ill_requests();
174 Returns a Koha::Illrequests object
181 my $ill_requests = $self->_result->ill_requests;
182 return Koha::Illrequests->_new_from_dbic($ill_requests);
187 my $item_groups = $biblio->item_groups();
189 Returns a Koha::Biblio::ItemGroups object
196 my $item_groups = $self->_result->item_groups;
197 return Koha::Biblio::ItemGroups->_new_from_dbic($item_groups);
200 =head3 can_article_request
202 my $bool = $biblio->can_article_request( $borrower );
204 Returns true if article requests can be made for this record
206 $borrower must be a Koha::Patron object
210 sub can_article_request {
211 my ( $self, $borrower ) = @_;
213 my $rule = $self->article_request_type($borrower);
214 return q{} if $rule eq 'item_only' && !$self->items()->count();
215 return 1 if $rule && $rule ne 'no';
220 =head3 can_be_transferred
222 $biblio->can_be_transferred({ to => $to_library, from => $from_library })
224 Checks if at least one item of a biblio can be transferred to given library.
226 This feature is controlled by two system preferences:
227 UseBranchTransferLimits to enable / disable the feature
228 BranchTransferLimitsType to use either an itemnumber or ccode as an identifier
229 for setting the limitations
231 Performance-wise, it is recommended to use this method for a biblio instead of
232 iterating each item of a biblio with Koha::Item->can_be_transferred().
234 Takes HASHref that can have the following parameters:
235 MANDATORY PARAMETERS:
238 $from : Koha::Library # if given, only items from that
239 # holdingbranch are considered
241 Returns 1 if at least one of the item of a biblio can be transferred
242 to $to_library, otherwise 0.
246 sub can_be_transferred {
247 my ($self, $params) = @_;
249 my $to = $params->{to};
250 my $from = $params->{from};
252 return 1 unless C4::Context->preference('UseBranchTransferLimits');
253 my $limittype = C4::Context->preference('BranchTransferLimitsType');
256 foreach my $item_of_bib ($self->items->as_list) {
257 next unless $item_of_bib->holdingbranch;
258 next if $from && $from->branchcode ne $item_of_bib->holdingbranch;
259 return 1 if $item_of_bib->holdingbranch eq $to->branchcode;
260 my $code = $limittype eq 'itemtype'
261 ? $item_of_bib->effective_itemtype
262 : $item_of_bib->ccode;
263 return 1 unless $code;
264 $items->{$code}->{$item_of_bib->holdingbranch} = 1;
267 # At this point we will have a HASHref containing each itemtype/ccode that
268 # this biblio has, inside which are all of the holdingbranches where those
269 # items are located at. Then, we will query Koha::Item::Transfer::Limits to
270 # find out whether a transfer limits for such $limittype from any of the
271 # listed holdingbranches to the given $to library exist. If at least one
272 # holdingbranch for that $limittype does not have a transfer limit to given
273 # $to library, then we know that the transfer is possible.
274 foreach my $code (keys %{$items}) {
275 my @holdingbranches = keys %{$items->{$code}};
276 return 1 if Koha::Item::Transfer::Limits->search({
277 toBranch => $to->branchcode,
278 fromBranch => { 'in' => \@holdingbranches },
281 group_by => [qw/fromBranch/]
282 })->count == scalar(@holdingbranches) ? 0 : 1;
289 =head3 pickup_locations
291 my $pickup_locations = $biblio->pickup_locations({ patron => $patron });
293 Returns a Koha::Libraries set of possible pickup locations for this biblio's items,
294 according to patron's home library and if item can be transferred to each pickup location.
296 Throws a I<Koha::Exceptions::MissingParameter> exception if the B<mandatory> parameter I<patron>
301 sub pickup_locations {
302 my ( $self, $params ) = @_;
304 Koha::Exceptions::MissingParameter->throw( parameter => 'patron' )
305 unless exists $params->{patron};
307 my $patron = $params->{patron};
309 my $memory_cache = Koha::Cache::Memory::Lite->get_instance();
310 my @pickup_locations;
311 foreach my $item ( $self->items->as_list ) {
312 my $cache_key = sprintf "Pickup_locations:%s:%s:%s:%s:%s",
313 $item->itype,$item->homebranch,$item->holdingbranch,$item->ccode || "",$patron->branchcode||"" ;
314 my $item_pickup_locations = $memory_cache->get_from_cache( $cache_key );
315 unless( $item_pickup_locations ){
316 @{ $item_pickup_locations } = $item->pickup_locations( { patron => $patron } )->_resultset->get_column('branchcode')->all;
317 $memory_cache->set_in_cache( $cache_key, $item_pickup_locations );
319 push @pickup_locations, @{ $item_pickup_locations }
322 return Koha::Libraries->search(
323 { branchcode => { '-in' => \@pickup_locations } }, { order_by => ['branchname'] } );
326 =head3 hidden_in_opac
328 my $bool = $biblio->hidden_in_opac({ [ rules => $rules ] })
330 Returns true if the biblio matches the hidding criteria defined in $rules.
331 Returns false otherwise. It involves the I<OpacHiddenItems> and
332 I<OpacHiddenItemsHidesRecord> system preferences.
334 Takes HASHref that can have the following parameters:
336 $rules : { <field> => [ value_1, ... ], ... }
338 Note: $rules inherits its structure from the parsed YAML from reading
339 the I<OpacHiddenItems> system preference.
344 my ( $self, $params ) = @_;
346 my $rules = $params->{rules} // {};
348 my @items = $self->items->as_list;
350 return 0 unless @items; # Do not hide if there is no item
352 # Ok, there are items, don't even try the rules unless OpacHiddenItemsHidesRecord
353 return 0 unless C4::Context->preference('OpacHiddenItemsHidesRecord');
355 return !(any { !$_->hidden_in_opac({ rules => $rules }) } @items);
358 =head3 article_request_type
360 my $type = $biblio->article_request_type( $borrower );
362 Returns the article request type based on items, or on the record
363 itself if there are no items.
365 $borrower must be a Koha::Patron object
369 sub article_request_type {
370 my ( $self, $borrower ) = @_;
372 return q{} unless $borrower;
374 my $rule = $self->article_request_type_for_items( $borrower );
375 return $rule if $rule;
377 # If the record has no items that are requestable, go by the record itemtype
378 $rule = $self->article_request_type_for_bib($borrower);
379 return $rule if $rule;
384 =head3 article_request_type_for_bib
386 my $type = $biblio->article_request_type_for_bib
388 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record
392 sub article_request_type_for_bib {
393 my ( $self, $borrower ) = @_;
395 return q{} unless $borrower;
397 my $borrowertype = $borrower->categorycode;
398 my $itemtype = $self->itemtype();
400 my $rule = Koha::CirculationRules->get_effective_rule(
402 rule_name => 'article_requests',
403 categorycode => $borrowertype,
404 itemtype => $itemtype,
408 return q{} unless $rule;
409 return $rule->rule_value || q{}
412 =head3 article_request_type_for_items
414 my $type = $biblio->article_request_type_for_items
416 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record's items
418 If there is a conflict where some items are 'bib_only' and some are 'item_only', 'bib_only' will be returned.
422 sub article_request_type_for_items {
423 my ( $self, $borrower ) = @_;
426 foreach my $item ( $self->items()->as_list() ) {
427 my $rule = $item->article_request_type($borrower);
428 return $rule if $rule eq 'bib_only'; # we don't need to go any further
432 return 'item_only' if $counts->{item_only};
433 return 'yes' if $counts->{yes};
434 return 'no' if $counts->{no};
438 =head3 article_requests
440 my $article_requests = $biblio->article_requests
442 Returns the article requests associated with this biblio
446 sub article_requests {
449 return Koha::ArticleRequests->_new_from_dbic( scalar $self->_result->article_requests );
452 =head3 current_checkouts
454 my $current_checkouts = $biblio->current_checkouts
456 Returns the current checkouts associated with this biblio
460 sub current_checkouts {
463 return Koha::Checkouts->search( { "item.biblionumber" => $self->id },
464 { join => 'item' } );
469 my $old_checkouts = $biblio->old_checkouts
471 Returns the past checkouts associated with this biblio
478 return Koha::Old::Checkouts->search( { "item.biblionumber" => $self->id },
479 { join => 'item' } );
484 my $items = $biblio->items({ [ host_items => 1 ] });
486 The optional param host_items allows you to include 'analytical' items.
488 Returns the related Koha::Items object for this biblio
493 my ($self,$params) = @_;
495 my $items_rs = $self->_result->items;
497 return Koha::Items->_new_from_dbic( $items_rs ) unless $params->{host_items};
499 my @itemnumbers = $items_rs->get_column('itemnumber')->all;
500 my $host_itemnumbers = $self->_host_itemnumbers();
501 push @itemnumbers, @{ $host_itemnumbers };
502 return Koha::Items->search({ "me.itemnumber" => { -in => \@itemnumbers } });
507 my $host_items = $biblio->host_items();
509 Return the host items (easy analytical record)
516 return Koha::Items->new->empty
517 unless C4::Context->preference('EasyAnalyticalRecords');
519 my $host_itemnumbers = $self->_host_itemnumbers;
521 return Koha::Items->search( { itemnumber => { -in => $host_itemnumbers } } );
524 =head3 _host_itemnumbers
526 my $host_itemnumber = $biblio->_host_itemnumbers();
528 Return the itemnumbers for analytical items on this record
532 sub _host_itemnumbers {
535 my $marcflavour = C4::Context->preference("marcflavour");
536 my $analyticfield = '773';
537 if ( $marcflavour eq 'UNIMARC' ) {
538 $analyticfield = '461';
540 my $marc_record = $self->metadata->record;
542 foreach my $field ( $marc_record->field($analyticfield) ) {
543 push @itemnumbers, $field->subfield('9');
545 return \@itemnumbers;
551 my $itemtype = $biblio->itemtype();
553 Returns the itemtype for this record.
560 return $self->biblioitem()->itemtype();
565 my $holds = $biblio->holds();
567 return the current holds placed on this record
572 my ( $self, $params, $attributes ) = @_;
573 $attributes->{order_by} = 'priority' unless exists $attributes->{order_by};
574 my $hold_rs = $self->_result->reserves->search( $params, $attributes );
575 return Koha::Holds->_new_from_dbic($hold_rs);
580 my $holds = $biblio->current_holds
582 Return the holds placed on this bibliographic record.
583 It does not include future holds.
589 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
591 { reservedate => { '<=' => $dtf->format_date(dt_from_string) } } );
596 my $field = $self->biblioitem
598 Returns the related Koha::Biblioitem object for this Biblio object
604 return Koha::Biblioitems->find( { biblionumber => $self->biblionumber } );
609 my $suggestions = $self->suggestions
611 Returns the related Koha::Suggestions object for this Biblio object
618 my $suggestions_rs = $self->_result->suggestions;
619 return Koha::Suggestions->_new_from_dbic( $suggestions_rs );
622 =head3 get_marc_components
624 my $components = $self->get_marc_components();
626 Returns an array of search results data, which are component parts of
627 this object (MARC21 773 points to this)
631 sub get_marc_components {
632 my ($self, $max_results) = @_;
634 return [] if (C4::Context->preference('marcflavour') ne 'MARC21');
636 my ( $searchstr, $sort ) = $self->get_components_query;
639 if (defined($searchstr)) {
640 my $searcher = Koha::SearchEngine::Search->new({index => $Koha::SearchEngine::BIBLIOS_INDEX});
641 my ( $error, $results, $facets );
643 ( $error, $results, $facets ) = $searcher->search_compat( $searchstr, undef, [$sort], ['biblioserver'], $max_results, 0, undef, undef, 'ccl', 0 );
648 warn "Warning from search_compat: '$error'";
652 message => 'component_search',
657 $components = $results->{biblioserver}->{RECORDS} if defined($results) && $results->{biblioserver}->{hits};
660 return $components // [];
663 =head2 get_components_query
665 Returns a query which can be used to search for all component parts of MARC21 biblios
669 sub get_components_query {
672 my $builder = Koha::SearchEngine::QueryBuilder->new(
673 { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
674 my $marc = $self->metadata->record;
675 my $component_sort_field = C4::Context->preference('ComponentSortField') // "title";
676 my $component_sort_order = C4::Context->preference('ComponentSortOrder') // "asc";
677 my $sort = $component_sort_field . "_" . $component_sort_order;
680 if ( C4::Context->preference('UseControlNumber') ) {
681 my $pf001 = $marc->field('001') || undef;
683 if ( defined($pf001) ) {
685 my $pf003 = $marc->field('003') || undef;
687 if ( !defined($pf003) ) {
688 # search for 773$w='Host001'
689 $searchstr .= "rcn:\"" . $pf001->data()."\"";
693 # search for (773$w='Host001' and 003='Host003') or 773$w='(Host003)Host001'
694 $searchstr .= "(rcn:\"" . $pf001->data() . "\" AND cni:\"" . $pf003->data() . "\")";
695 $searchstr .= " OR rcn:\"" . $pf003->data() . " " . $pf001->data() . "\"";
699 # limit to monograph and serial component part records
700 $searchstr .= " AND (bib-level:a OR bib-level:b)";
705 my $cleaned_title = $marc->subfield('245', "a");
706 $cleaned_title =~ tr|/||;
707 $cleaned_title = $builder->clean_search_term($cleaned_title);
708 $searchstr = qq#Host-item:("$cleaned_title")#;
710 my ($error, $query ,$query_str) = $builder->build_query_compat( undef, [$searchstr], undef, undef, [$sort], 0 );
716 return ($query, $query_str, $sort);
719 =head3 get_marc_volumes
721 my $volumes = $self->get_marc_volumes();
723 Returns an array of MARCXML data, which are volumes parts of
724 this object (MARC21 773$w or 8xx$w point to this)
728 sub get_marc_volumes {
729 my ( $self, $max_results ) = @_;
731 return $self->{_volumes} if defined( $self->{_volumes} );
733 my $searchstr = $self->get_volumes_query;
735 if ( defined($searchstr) ) {
736 my $searcher = Koha::SearchEngine::Search->new( { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
737 my ( $errors, $results, $total_hits ) = $searcher->simple_search_compat( $searchstr, 0, $max_results );
739 ( defined($results) && scalar(@$results) ) ? $results : [];
741 $self->{_volumes} = [];
744 return $self->{_volumes};
747 =head2 get_volumes_query
749 Returns a query which can be used to search for all component parts of MARC21 biblios
753 sub get_volumes_query {
756 # MARC21 Only for now
757 return if ( C4::Context->preference('marcflavour') ne 'MARC21' );
759 my $marc = $self->metadata->record;
761 # Only build volumes query if we're in a 'Set' record
762 # or we have a monographic series.
763 # For monographic series the check on LDR 7 in (b or i or s) is omitted
764 my $leader19 = substr( $marc->leader, 19, 1 );
765 my $pf008 = $marc->field('008') || '';
766 my $mseries = ( $pf008 && substr( $pf008->data(), 21, 1 ) eq 'm' ) ? 1 : 0;
767 return unless ( $leader19 eq 'a' || $mseries );
769 my $builder = Koha::SearchEngine::QueryBuilder->new( { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
772 if ( C4::Context->preference('UseControlNumber') ) {
773 my $pf001 = $marc->field('001') || undef;
775 if ( defined($pf001) ) {
777 my $pf003 = $marc->field('003') || undef;
779 if ( !defined($pf003) ) {
781 # search for linking_field$w='Host001'
782 $searchstr .= "rcn:" . $pf001->data();
786 # search for (linking_field$w='Host001' and 003='Host003') or linking_field$w='(Host003)Host001'
787 $searchstr .= "(rcn:" . $pf001->data() . " AND cni:" . $pf003->data() . ")";
788 $searchstr .= " OR rcn:\"" . $pf003->data() . " " . $pf001->data() . "\"";
792 # exclude monograph and serial component part records
793 $searchstr .= " NOT (bib-level:a OR bib-level:b)";
797 my $cleaned_title = $marc->subfield( '245', "a" );
798 $cleaned_title =~ tr|/||;
799 $cleaned_title = $builder->clean_search_term($cleaned_title);
800 $searchstr = qq#(title-series,phr:("$cleaned_title") OR Host-item,phr:("$cleaned_title")#;
801 $searchstr .= " NOT (bib-level:a OR bib-level:b))";
809 my $subscriptions = $self->subscriptions
811 Returns the related Koha::Subscriptions object for this Biblio object
817 my $rs = $self->_result->subscriptions;
818 return Koha::Subscriptions->_new_from_dbic($rs);
821 =head3 has_items_waiting_or_intransit
823 my $itemsWaitingOrInTransit = $biblio->has_items_waiting_or_intransit
825 Tells if this bibliographic record has items waiting or in transit.
829 sub has_items_waiting_or_intransit {
832 if ( Koha::Holds->search({ biblionumber => $self->id,
833 found => ['W', 'T'] })->count ) {
837 foreach my $item ( $self->items->as_list ) {
838 return 1 if $item->get_transfer;
846 my $coins = $biblio->get_coins;
848 Returns the COinS (a span) which can be included in a biblio record
855 my $record = $self->metadata->record;
857 my $pos7 = substr $record->leader(), 7, 1;
858 my $pos6 = substr $record->leader(), 6, 1;
861 my ( $aulast, $aufirst ) = ( '', '' );
872 # For the purposes of generating COinS metadata, LDR/06-07 can be
873 # considered the same for UNIMARC and MARC21
882 'i' => 'audioRecording',
883 'j' => 'audioRecording',
886 'm' => 'computerProgram',
891 'a' => 'journalArticle',
895 $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
897 if ( $genre eq 'book' ) {
898 $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
901 ##### We must transform mtx to a valable mtx and document type ####
902 if ( $genre eq 'book' ) {
905 } elsif ( $genre eq 'journal' ) {
908 } elsif ( $genre eq 'journalArticle' ) {
916 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
919 $aulast = $record->subfield( '700', 'a' ) || '';
920 $aufirst = $record->subfield( '700', 'b' ) || '';
921 push @authors, "$aufirst $aulast" if ($aufirst or $aulast);
924 if ( $record->field('200') ) {
925 for my $au ( $record->field('200')->subfield('g') ) {
930 $title = $record->subfield( '200', 'a' );
931 my $subfield_210d = $record->subfield('210', 'd');
932 if ($subfield_210d and $subfield_210d =~ /(\d{4})/) {
935 $publisher = $record->subfield( '210', 'c' ) || '';
936 $isbn = $record->subfield( '010', 'a' ) || '';
937 $issn = $record->subfield( '011', 'a' ) || '';
940 # MARC21 need some improve
943 if ( $record->field('100') ) {
944 push @authors, $record->subfield( '100', 'a' );
948 if ( $record->field('700') ) {
949 for my $au ( $record->field('700')->subfield('a') ) {
953 $title = $record->field('245');
954 $title &&= $title->as_string('ab');
955 if ($titletype eq 'a') {
956 $pubyear = $record->field('008') || '';
957 $pubyear = substr($pubyear->data(), 7, 4) if $pubyear;
958 $isbn = $record->subfield( '773', 'z' ) || '';
959 $issn = $record->subfield( '773', 'x' ) || '';
960 $hosttitle = $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{};
961 my @rels = $record->subfield( '773', 'g' );
962 $pages = join(', ', @rels);
964 $pubyear = $record->subfield( '260', 'c' ) || '';
965 $publisher = $record->subfield( '260', 'b' ) || '';
966 $isbn = $record->subfield( '020', 'a' ) || '';
967 $issn = $record->subfield( '022', 'a' ) || '';
973 [ 'ctx_ver', 'Z39.88-2004' ],
974 [ 'rft_val_fmt', "info:ofi/fmt:kev:mtx:$mtx" ],
975 [ ($mtx eq 'dc' ? 'rft.type' : 'rft.genre'), $genre ],
976 [ "rft.${titletype}title", $title ],
979 # rft.title is authorized only once, so by checking $titletype
980 # we ensure that rft.title is not already in the list.
981 if ($hosttitle and $titletype) {
982 push @params, [ 'rft.title', $hosttitle ];
986 [ 'rft.isbn', $isbn ],
987 [ 'rft.issn', $issn ],
990 # If it's a subscription, these informations have no meaning.
991 if ($genre ne 'journal') {
993 [ 'rft.aulast', $aulast ],
994 [ 'rft.aufirst', $aufirst ],
995 (map { [ 'rft.au', $_ ] } @authors),
996 [ 'rft.pub', $publisher ],
997 [ 'rft.date', $pubyear ],
998 [ 'rft.pages', $pages ],
1002 my $coins_value = join( '&',
1003 map { $$_[1] ? $$_[0] . '=' . uri_escape_utf8( $$_[1] ) : () } @params );
1005 return $coins_value;
1010 my $url = $biblio->get_openurl;
1012 Returns url for OpenURL resolver set in OpenURLResolverURL system preference
1019 my $OpenURLResolverURL = C4::Context->preference('OpenURLResolverURL');
1021 if ($OpenURLResolverURL) {
1022 my $uri = URI->new($OpenURLResolverURL);
1024 if (not defined $uri->query) {
1025 $OpenURLResolverURL .= '?';
1027 $OpenURLResolverURL .= '&';
1029 $OpenURLResolverURL .= $self->get_coins;
1032 return $OpenURLResolverURL;
1037 my $serial = $biblio->is_serial
1039 Return boolean true if this bibbliographic record is continuing resource
1046 return 1 if $self->serial;
1048 my $record = $self->metadata->record;
1049 return 1 if substr($record->leader, 7, 1) eq 's';
1054 =head3 custom_cover_image_url
1056 my $image_url = $biblio->custom_cover_image_url
1058 Return the specific url of the cover image for this bibliographic record.
1059 It is built regaring the value of the system preference CustomCoverImagesURL
1063 sub custom_cover_image_url {
1065 my $url = C4::Context->preference('CustomCoverImagesURL');
1066 if ( $url =~ m|{isbn}| ) {
1067 my $isbn = $self->biblioitem->isbn;
1068 return unless $isbn;
1069 $url =~ s|{isbn}|$isbn|g;
1071 if ( $url =~ m|{normalized_isbn}| ) {
1072 my $normalized_isbn = $self->normalized_isbn;
1073 return unless $normalized_isbn;
1074 $url =~ s|{normalized_isbn}|$normalized_isbn|g;
1076 if ( $url =~ m|{issn}| ) {
1077 my $issn = $self->biblioitem->issn;
1078 return unless $issn;
1079 $url =~ s|{issn}|$issn|g;
1082 my $re = qr|{(?<field>\d{3})(\$(?<subfield>.))?}|;
1083 if ( $url =~ $re ) {
1084 my $field = $+{field};
1085 my $subfield = $+{subfield};
1086 my $marc_record = $self->metadata->record;
1089 $value = $marc_record->subfield( $field, $subfield );
1091 my $controlfield = $marc_record->field($field);
1092 $value = $controlfield->data() if $controlfield;
1094 return unless $value;
1095 $url =~ s|$re|$value|;
1103 Return the cover images associated with this biblio.
1110 my $cover_images_rs = $self->_result->cover_images;
1111 return unless $cover_images_rs;
1112 return Koha::CoverImages->_new_from_dbic($cover_images_rs);
1115 =head3 get_marc_notes
1117 $marcnotesarray = $biblio->get_marc_notes({ opac => 1 });
1119 Get all notes from the MARC record and returns them in an array.
1120 The notes are stored in different fields depending on MARC flavour.
1121 MARC21 5XX $u subfields receive special attention as they are URIs.
1125 sub get_marc_notes {
1126 my ( $self, $params ) = @_;
1128 my $marcflavour = C4::Context->preference('marcflavour');
1129 my $opac = $params->{opac} // '0';
1130 my $interface = $params->{opac} ? 'opac' : 'intranet';
1132 my $record = $params->{record} // $self->metadata->record;
1133 my $record_processor = Koha::RecordProcessor->new(
1135 filters => [ 'ViewPolicy', 'ExpandCodedFields' ],
1137 interface => $interface,
1138 frameworkcode => $self->frameworkcode
1142 $record_processor->process($record);
1144 my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
1145 #MARC21 specs indicate some notes should be private if first indicator 0
1146 my %maybe_private = (
1154 my %hiddenlist = map { $_ => 1 }
1155 split( /,/, C4::Context->preference('NotesToHide'));
1158 foreach my $field ( $record->field($scope) ) {
1159 my $tag = $field->tag();
1160 next if $hiddenlist{ $tag };
1161 next if $opac && $maybe_private{$tag} && !$field->indicator(1);
1162 if( $marcflavour ne 'UNIMARC' && $field->subfield('u') ) {
1163 # Field 5XX$u always contains URI
1164 # Examples: 505u, 506u, 510u, 514u, 520u, 530u, 538u, 540u, 542u, 552u, 555u, 561u, 563u, 583u
1165 # We first push the other subfields, then all $u's separately
1166 # Leave further actions to the template (see e.g. opac-detail)
1168 join '', ( 'a' .. 't', 'v' .. 'z', '0' .. '9' ); # excl 'u'
1169 push @marcnotes, { marcnote => $field->as_string($othersub) };
1170 foreach my $sub ( $field->subfield('u') ) {
1171 $sub =~ s/^\s+|\s+$//g; # trim
1172 push @marcnotes, { marcnote => $sub, tag => $tag };
1175 push @marcnotes, { marcnote => $field->as_string(), tag => $tag };
1181 =head3 _get_marc_authors
1183 Private method to return the list of authors contained in the MARC record.
1184 See get get_marc_contributors and get_marc_authors for the public methods.
1188 sub _get_marc_authors {
1189 my ( $self, $params ) = @_;
1191 my $fields_filter = $params->{fields_filter};
1192 my $mintag = $params->{mintag};
1193 my $maxtag = $params->{maxtag};
1195 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1196 my $marcflavour = C4::Context->preference('marcflavour');
1198 # tagslib useful only for UNIMARC author responsibilities
1199 my $tagslib = $marcflavour eq "UNIMARC"
1200 ? C4::Biblio::GetMarcStructure( 1, $self->frameworkcode, { unsafe => 1 } )
1204 foreach my $field ( $self->metadata->record->field($fields_filter) ) {
1207 if $mintag && $field->tag() < $mintag
1208 || $maxtag && $field->tag() > $maxtag;
1212 my @subfields = $field->subfields();
1215 # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1216 my $subfield9 = $field->subfield('9');
1218 my $linkvalue = $subfield9;
1219 $linkvalue =~ s/(\(|\))//g;
1220 @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1225 for my $authors_subfield (@subfields) {
1226 next if ( $authors_subfield->[0] eq '9' );
1228 # unimarc3 contains the $3 of the author for UNIMARC.
1229 # For french academic libraries, it's the "ppn", and it's required for idref webservice
1230 $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1232 # don't load unimarc subfields 3, 5
1233 next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1235 my $code = $authors_subfield->[0];
1236 my $value = $authors_subfield->[1];
1237 my $linkvalue = $value;
1238 $linkvalue =~ s/(\(|\))//g;
1239 # UNIMARC author responsibility
1240 if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1241 $value = C4::Biblio::GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1242 $linkvalue = "($value)";
1244 # if no authority link, build a search query
1245 unless ($subfield9) {
1248 'link' => $linkvalue,
1249 operator => (scalar @link_loop) ? ' AND ' : undef
1252 my @this_link_loop = @link_loop;
1254 unless ( $code eq '0') {
1255 push @subfields_loop, {
1256 tag => $field->tag(),
1259 link_loop => \@this_link_loop,
1260 separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1264 push @marcauthors, {
1265 MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1266 authoritylink => $subfield9,
1267 unimarc3 => $unimarc3
1270 return \@marcauthors;
1273 =head3 get_marc_contributors
1275 my $contributors = $biblio->get_marc_contributors;
1277 Get all contributors (but first author) from the MARC record and returns them in an array.
1278 They are stored in different fields depending on MARC flavour (700..720 for MARC21)
1282 sub get_marc_contributors {
1283 my ( $self, $params ) = @_;
1285 my ( $mintag, $maxtag, $fields_filter );
1286 my $marcflavour = C4::Context->preference('marcflavour');
1288 if ( $marcflavour eq "UNIMARC" ) {
1291 $fields_filter = '7..';
1292 } else { # marc21/normarc
1295 $fields_filter = '7..';
1298 return $self->_get_marc_authors(
1300 fields_filter => $fields_filter,
1307 =head3 get_marc_authors
1309 my $authors = $biblio->get_marc_authors;
1311 Get all authors from the MARC record and returns them in an array.
1312 They are stored in different fields depending on MARC flavour
1313 (main author from 100 then secondary authors from 700..720).
1317 sub get_marc_authors {
1318 my ( $self, $params ) = @_;
1320 my ( $mintag, $maxtag, $fields_filter );
1321 my $marcflavour = C4::Context->preference('marcflavour');
1323 if ( $marcflavour eq "UNIMARC" ) {
1324 $fields_filter = '200';
1325 } else { # marc21/normarc
1326 $fields_filter = '100';
1329 my @first_authors = @{$self->_get_marc_authors(
1331 fields_filter => $fields_filter,
1337 my @other_authors = @{$self->get_marc_contributors};
1339 return [@first_authors, @other_authors];
1342 =head3 normalized_isbn
1344 my $normalized_isbn = $biblio->normalized_isbn
1346 Normalizes and returns the first valid ISBN found in the record.
1347 ISBN13 are converted into ISBN10. This is required to get some book cover images.
1351 sub normalized_isbn {
1353 return C4::Koha::GetNormalizedISBN($self->biblioitem->isbn);
1356 =head3 public_read_list
1358 This method returns the list of publicly readable database fields for both API and UI output purposes
1362 sub public_read_list {
1364 'biblionumber', 'frameworkcode', 'author',
1365 'title', 'medium', 'subtitle',
1366 'part_number', 'part_name', 'unititle',
1367 'notes', 'serial', 'seriestitle',
1368 'copyrightdate', 'abstract'
1372 =head3 metadata_extractor
1374 my $extractor = $biblio->metadata_extractor
1376 Return a Koha::Biblio::Metadata::Extractor object to use to extract data from the metadata (ie. MARC record for now)
1380 sub metadata_extractor {
1383 $self->{metadata_extractor} ||= Koha::Biblio::Metadata::Extractor->new( { biblio => $self } );
1385 return $self->{metadata_extractor};
1388 =head3 normalized_upc
1390 my $normalized_upc = $biblio->normalized_upc
1392 Normalizes and returns the UPC value found in the MARC record.
1396 sub normalized_upc {
1398 return $self->metadata_extractor->get_normalized_upc;
1401 =head3 normalized_oclc
1403 my $normalized_oclc = $biblio->normalized_oclc
1405 Normalizes and returns the OCLC number found in the MARC record.
1409 sub normalized_oclc {
1411 return $self->metadata_extractor->get_normalized_oclc;
1416 my $json = $biblio->to_api;
1418 Overloaded method that returns a JSON representation of the Koha::Biblio object,
1419 suitable for API output. The related Koha::Biblioitem object is merged as expected
1425 my ($self, $args) = @_;
1427 my $response = $self->SUPER::to_api( $args );
1429 $args = defined $args ? {%$args} : {};
1430 delete $args->{embed};
1432 my $biblioitem = $self->biblioitem->to_api( $args );
1434 return { %$response, %$biblioitem };
1437 =head3 to_api_mapping
1439 This method returns the mapping for representing a Koha::Biblio object
1444 sub to_api_mapping {
1446 biblionumber => 'biblio_id',
1447 frameworkcode => 'framework_id',
1448 unititle => 'uniform_title',
1449 seriestitle => 'series_title',
1450 copyrightdate => 'copyright_date',
1451 datecreated => 'creation_date',
1452 deleted_on => undef,
1456 =head3 get_marc_host
1458 $host = $biblio->get_marc_host;
1460 ( $host, $relatedparts, $hostinfo ) = $biblio->get_marc_host;
1462 Returns host biblio record from MARC21 773 (undef if no 773 present).
1463 It looks at the first 773 field with MARCorgCode or only a control
1464 number. Complete $w or numeric part is used to search host record.
1465 The optional parameter no_items triggers a check if $biblio has items.
1466 If there are, the sub returns undef.
1467 Called in list context, it also returns 773$g (related parts).
1469 If there is no $w, we use $0 (host biblionumber) or $9 (host itemnumber)
1470 to search for the host record. If there is also no $0 and no $9, we search
1471 using author and title. Failing all of that, we return an undef host and
1472 form a concatenation of strings with 773$agt for host information,
1473 returned when called in list context.
1478 my ($self, $params) = @_;
1479 my $no_items = $params->{no_items};
1480 return if C4::Context->preference('marcflavour') eq 'UNIMARC'; # TODO
1481 return if $params->{no_items} && $self->items->count > 0;
1484 eval { $record = $self->metadata->record };
1487 # We pick the first $w with your MARCOrgCode or the first $w that has no
1488 # code (between parentheses) at all.
1489 my $orgcode = C4::Context->preference('MARCOrgCode') // q{};
1491 foreach my $f ( $record->field('773') ) {
1492 my $w = $f->subfield('w') or next;
1493 if( $w =~ /^\($orgcode\)\s*(\d+)/i or $w =~ /^\d+/ ) {
1499 my $engine = Koha::SearchEngine::Search->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
1501 if ( !$hostfld and $record->subfield('773','t') ) {
1502 # not linked using $w
1503 my $unlinkedf = $record->field('773');
1505 if ( C4::Context->preference("EasyAnalyticalRecords") ) {
1506 if ( $unlinkedf->subfield('0') ) {
1507 # use 773$0 host biblionumber
1508 $bibno = $unlinkedf->subfield('0');
1509 } elsif ( $unlinkedf->subfield('9') ) {
1510 # use 773$9 host itemnumber
1511 my $linkeditemnumber = $unlinkedf->subfield('9');
1512 $bibno = Koha::Items->find( $linkeditemnumber )->biblionumber;
1516 my $host = Koha::Biblios->find($bibno) or return;
1517 return wantarray ? ( $host, $unlinkedf->subfield('g') ) : $host;
1519 # just return plaintext and no host record
1520 my $hostinfo = join( ", ", $unlinkedf->subfield('a'), $unlinkedf->subfield('t'), $unlinkedf->subfield('g') );
1521 return wantarray ? ( undef, $unlinkedf->subfield('g'), $hostinfo ) : undef;
1523 return if !$hostfld;
1524 my $rcn = $hostfld->subfield('w');
1526 # Look for control number with/without orgcode
1527 for my $try (1..2) {
1528 my ( $error, $results, $total_hits ) = $engine->simple_search_compat( 'Control-number='.$rcn, 0,1 );
1529 if( !$error and $total_hits == 1 ) {
1530 $bibno = $engine->extract_biblionumber( $results->[0] );
1533 # Add or remove orgcode for second try
1534 if( $try == 1 && $rcn =~ /\)\s*(\d+)/ ) {
1535 $rcn = $1; # number only
1536 } elsif( $try == 1 && $rcn =~ /^\d+/ ) {
1537 $rcn = "($orgcode)$rcn";
1543 my $host = Koha::Biblios->find($bibno) or return;
1544 return wantarray ? ( $host, $hostfld->subfield('g') ) : $host;
1548 =head3 get_marc_host_only
1550 my $host = $biblio->get_marc_host_only;
1556 sub get_marc_host_only {
1559 my ( $host ) = $self->get_marc_host;
1564 =head3 get_marc_relatedparts_only
1566 my $relatedparts = $biblio->get_marc_relatedparts_only;
1568 Return related parts only
1572 sub get_marc_relatedparts_only {
1575 my ( undef, $relatedparts ) = $self->get_marc_host;
1577 return $relatedparts;
1580 =head3 get_marc_hostinfo_only
1582 my $hostinfo = $biblio->get_marc_hostinfo_only;
1584 Return host info only
1588 sub get_marc_hostinfo_only {
1591 my ( $host, $relatedparts, $hostinfo ) = $self->get_marc_host;
1598 my $recalls = $biblio->recalls;
1600 Return recalls linked to this biblio
1606 return Koha::Recalls->_new_from_dbic( scalar $self->_result->recalls );
1609 =head3 can_be_recalled
1611 my @items_for_recall = $biblio->can_be_recalled({ patron => $patron_object });
1613 Does biblio-level checks and returns the items attached to this biblio that are available for recall
1617 sub can_be_recalled {
1618 my ( $self, $params ) = @_;
1620 return 0 if !( C4::Context->preference('UseRecalls') );
1622 my $patron = $params->{patron};
1624 my $branchcode = C4::Context->userenv->{'branch'};
1625 if ( C4::Context->preference('CircControl') eq 'PatronLibrary' and $patron ) {
1626 $branchcode = $patron->branchcode;
1629 my @all_items = Koha::Items->search({ biblionumber => $self->biblionumber })->as_list;
1631 # if there are no available items at all, no recall can be placed
1632 return 0 if ( scalar @all_items == 0 );
1637 my @all_itemnumbers;
1638 foreach my $item ( @all_items ) {
1639 push( @all_itemnumbers, $item->itemnumber );
1640 if ( $item->can_be_recalled({ patron => $patron }) ) {
1641 push( @itemtypes, $item->effective_itemtype );
1642 push( @itemnumbers, $item->itemnumber );
1643 push( @items, $item );
1647 # if there are no recallable items, no recall can be placed
1648 return 0 if ( scalar @items == 0 );
1650 # Check the circulation rule for each relevant itemtype for this biblio
1651 my ( @recalls_allowed, @recalls_per_record, @on_shelf_recalls );
1652 foreach my $itemtype ( @itemtypes ) {
1653 my $rule = Koha::CirculationRules->get_effective_rules({
1654 branchcode => $branchcode,
1655 categorycode => $patron ? $patron->categorycode : undef,
1656 itemtype => $itemtype,
1659 'recalls_per_record',
1663 push( @recalls_allowed, $rule->{recalls_allowed} ) if $rule;
1664 push( @recalls_per_record, $rule->{recalls_per_record} ) if $rule;
1665 push( @on_shelf_recalls, $rule->{on_shelf_recalls} ) if $rule;
1667 my $recalls_allowed = (sort {$b <=> $a} @recalls_allowed)[0]; # take highest
1668 my $recalls_per_record = (sort {$b <=> $a} @recalls_per_record)[0]; # take highest
1669 my %on_shelf_recalls_count = ();
1670 foreach my $count ( @on_shelf_recalls ) {
1671 $on_shelf_recalls_count{$count}++;
1673 my $on_shelf_recalls = (sort {$on_shelf_recalls_count{$b} <=> $on_shelf_recalls_count{$a}} @on_shelf_recalls)[0]; # take most common
1675 # check recalls allowed has been set and is not zero
1676 return 0 if ( !defined($recalls_allowed) || $recalls_allowed == 0 );
1679 # check borrower has not reached open recalls allowed limit
1680 return 0 if ( $patron->recalls->filter_by_current->count >= $recalls_allowed );
1682 # check borrower has not reached open recalls allowed per record limit
1683 return 0 if ( $patron->recalls->filter_by_current->search({ biblio_id => $self->biblionumber })->count >= $recalls_per_record );
1685 # check if any of the items under this biblio are already checked out by this borrower
1686 return 0 if ( Koha::Checkouts->search({ itemnumber => [ @all_itemnumbers ], borrowernumber => $patron->borrowernumber })->count > 0 );
1689 # check item availability
1690 my $checked_out_count = 0;
1692 if ( Koha::Checkouts->search({ itemnumber => $_->itemnumber })->count > 0 ){ $checked_out_count++; }
1695 # can't recall if on shelf recalls only allowed when all unavailable, but items are still available for checkout
1696 return 0 if ( $on_shelf_recalls eq 'all' && $checked_out_count < scalar @items );
1698 # can't recall if no items have been checked out
1699 return 0 if ( $checked_out_count == 0 );
1707 my $ratings = $biblio->ratings
1709 Return a Koha::Ratings object representing the ratings of this bibliographic record
1715 my $rs = $self->_result->ratings;
1716 return Koha::Ratings->_new_from_dbic($rs);
1719 =head3 opac_summary_html
1721 my $summary_html = $biblio->opac_summary_html
1723 Based on the syspref OPACMySummaryHTML, returns a string representing the
1724 summary of this bibliographic record.
1725 {AUTHOR}, {TITLE}, {ISBN} and {BIBLIONUMBER} will be replaced.
1729 sub opac_summary_html {
1732 my $summary_html = C4::Context->preference('OPACMySummaryHTML');
1733 return q{} unless $summary_html;
1734 my $author = $self->author || q{};
1735 my $title = $self->title || q{};
1736 $title =~ s/\/+$//; # remove trailing slash
1737 $title =~ s/\s+$//; # remove trailing space
1738 my $normalized_isbn = $self->normalized_isbn || q{};
1739 my $biblionumber = $self->biblionumber;
1741 $summary_html =~ s/{AUTHOR}/$author/g;
1742 $summary_html =~ s/{TITLE}/$title/g;
1743 $summary_html =~ s/{ISBN}/$normalized_isbn/g;
1744 $summary_html =~ s/{BIBLIONUMBER}/$biblionumber/g;
1746 return $summary_html;
1749 =head2 Internal methods
1761 Kyle M Hall <kyle@bywatersolutions.com>