Bug 16371: Rewrite get_daily_quote
[koha.git] / Koha / Biblio.pm
blob830b9c4d73008067af75d7cb2b7c79654dc11875
1 package Koha::Biblio;
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>.
20 use Modern::Perl;
22 use Carp;
23 use List::MoreUtils qw(any);
24 use URI;
25 use URI::Escape;
27 use C4::Koha;
28 use C4::Biblio qw();
30 use Koha::Database;
31 use Koha::DateUtils qw( dt_from_string );
33 use base qw(Koha::Object);
35 use Koha::Acquisition::Orders;
36 use Koha::ArticleRequest::Status;
37 use Koha::ArticleRequests;
38 use Koha::Biblio::Metadatas;
39 use Koha::Biblioitems;
40 use Koha::CirculationRules;
41 use Koha::Item::Transfer::Limits;
42 use Koha::Items;
43 use Koha::Libraries;
44 use Koha::Suggestions;
45 use Koha::Subscriptions;
47 =head1 NAME
49 Koha::Biblio - Koha Biblio Object class
51 =head1 API
53 =head2 Class Methods
55 =cut
57 =head3 store
59 Overloaded I<store> method to set default values
61 =cut
63 sub store {
64 my ( $self ) = @_;
66 $self->datecreated( dt_from_string ) unless $self->datecreated;
68 return $self->SUPER::store;
71 =head3 metadata
73 my $metadata = $biblio->metadata();
75 Returns a Koha::Biblio::Metadata object
77 =cut
79 sub metadata {
80 my ( $self ) = @_;
82 my $metadata = $self->_result->metadata;
83 return Koha::Biblio::Metadata->_new_from_dbic($metadata);
86 =head3 orders
88 my $orders = $biblio->orders();
90 Returns a Koha::Acquisition::Orders object
92 =cut
94 sub orders {
95 my ( $self ) = @_;
97 my $orders = $self->_result->orders;
98 return Koha::Acquisition::Orders->_new_from_dbic($orders);
101 =head3 active_orders
103 my $active_orders = $biblio->active_orders();
105 Returns the active acquisition orders related to this biblio.
106 An order is considered active when it is not cancelled (i.e. when datecancellation
107 is not undef).
109 =cut
111 sub active_orders {
112 my ( $self ) = @_;
114 return $self->orders->search({ datecancellationprinted => undef });
117 =head3 can_article_request
119 my $bool = $biblio->can_article_request( $borrower );
121 Returns true if article requests can be made for this record
123 $borrower must be a Koha::Patron object
125 =cut
127 sub can_article_request {
128 my ( $self, $borrower ) = @_;
130 my $rule = $self->article_request_type($borrower);
131 return q{} if $rule eq 'item_only' && !$self->items()->count();
132 return 1 if $rule && $rule ne 'no';
134 return q{};
137 =head3 can_be_transferred
139 $biblio->can_be_transferred({ to => $to_library, from => $from_library })
141 Checks if at least one item of a biblio can be transferred to given library.
143 This feature is controlled by two system preferences:
144 UseBranchTransferLimits to enable / disable the feature
145 BranchTransferLimitsType to use either an itemnumber or ccode as an identifier
146 for setting the limitations
148 Performance-wise, it is recommended to use this method for a biblio instead of
149 iterating each item of a biblio with Koha::Item->can_be_transferred().
151 Takes HASHref that can have the following parameters:
152 MANDATORY PARAMETERS:
153 $to : Koha::Library
154 OPTIONAL PARAMETERS:
155 $from : Koha::Library # if given, only items from that
156 # holdingbranch are considered
158 Returns 1 if at least one of the item of a biblio can be transferred
159 to $to_library, otherwise 0.
161 =cut
163 sub can_be_transferred {
164 my ($self, $params) = @_;
166 my $to = $params->{to};
167 my $from = $params->{from};
169 return 1 unless C4::Context->preference('UseBranchTransferLimits');
170 my $limittype = C4::Context->preference('BranchTransferLimitsType');
172 my $items;
173 foreach my $item_of_bib ($self->items->as_list) {
174 next unless $item_of_bib->holdingbranch;
175 next if $from && $from->branchcode ne $item_of_bib->holdingbranch;
176 return 1 if $item_of_bib->holdingbranch eq $to->branchcode;
177 my $code = $limittype eq 'itemtype'
178 ? $item_of_bib->effective_itemtype
179 : $item_of_bib->ccode;
180 return 1 unless $code;
181 $items->{$code}->{$item_of_bib->holdingbranch} = 1;
184 # At this point we will have a HASHref containing each itemtype/ccode that
185 # this biblio has, inside which are all of the holdingbranches where those
186 # items are located at. Then, we will query Koha::Item::Transfer::Limits to
187 # find out whether a transfer limits for such $limittype from any of the
188 # listed holdingbranches to the given $to library exist. If at least one
189 # holdingbranch for that $limittype does not have a transfer limit to given
190 # $to library, then we know that the transfer is possible.
191 foreach my $code (keys %{$items}) {
192 my @holdingbranches = keys %{$items->{$code}};
193 return 1 if Koha::Item::Transfer::Limits->search({
194 toBranch => $to->branchcode,
195 fromBranch => { 'in' => \@holdingbranches },
196 $limittype => $code
197 }, {
198 group_by => [qw/fromBranch/]
199 })->count == scalar(@holdingbranches) ? 0 : 1;
202 return 0;
206 =head3 pickup_locations
208 my $pickup_locations = $biblio->pickup_locations( {patron => $patron } );
210 Returns an I<arrayref> of possible pickup locations for this biblio's items,
211 according to patron's home library (if patron is defined and holds are allowed
212 only from hold groups) and if item can be transferred to each pickup location.
214 =cut
216 sub pickup_locations {
217 my ($self, $params) = @_;
219 my $patron = $params->{patron};
221 my @pickup_locations;
222 foreach my $item_of_bib ($self->items->as_list) {
223 push @pickup_locations, @{ $item_of_bib->pickup_locations( {patron => $patron} ) };
226 my %seen;
227 @pickup_locations =
228 grep { !$seen{ $_->branchcode }++ } @pickup_locations;
230 return \@pickup_locations;
233 =head3 hidden_in_opac
235 my $bool = $biblio->hidden_in_opac({ [ rules => $rules ] })
237 Returns true if the biblio matches the hidding criteria defined in $rules.
238 Returns false otherwise.
240 Takes HASHref that can have the following parameters:
241 OPTIONAL PARAMETERS:
242 $rules : { <field> => [ value_1, ... ], ... }
244 Note: $rules inherits its structure from the parsed YAML from reading
245 the I<OpacHiddenItems> system preference.
247 =cut
249 sub hidden_in_opac {
250 my ( $self, $params ) = @_;
252 my $rules = $params->{rules} // {};
254 my @items = $self->items->as_list;
256 return 0 unless @items; # Do not hide if there is no item
258 return !(any { !$_->hidden_in_opac({ rules => $rules }) } @items);
261 =head3 article_request_type
263 my $type = $biblio->article_request_type( $borrower );
265 Returns the article request type based on items, or on the record
266 itself if there are no items.
268 $borrower must be a Koha::Patron object
270 =cut
272 sub article_request_type {
273 my ( $self, $borrower ) = @_;
275 return q{} unless $borrower;
277 my $rule = $self->article_request_type_for_items( $borrower );
278 return $rule if $rule;
280 # If the record has no items that are requestable, go by the record itemtype
281 $rule = $self->article_request_type_for_bib($borrower);
282 return $rule if $rule;
284 return q{};
287 =head3 article_request_type_for_bib
289 my $type = $biblio->article_request_type_for_bib
291 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record
293 =cut
295 sub article_request_type_for_bib {
296 my ( $self, $borrower ) = @_;
298 return q{} unless $borrower;
300 my $borrowertype = $borrower->categorycode;
301 my $itemtype = $self->itemtype();
303 my $rule = Koha::CirculationRules->get_effective_rule(
305 rule_name => 'article_requests',
306 categorycode => $borrowertype,
307 itemtype => $itemtype,
311 return q{} unless $rule;
312 return $rule->rule_value || q{}
315 =head3 article_request_type_for_items
317 my $type = $biblio->article_request_type_for_items
319 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record's items
321 If there is a conflict where some items are 'bib_only' and some are 'item_only', 'bib_only' will be returned.
323 =cut
325 sub article_request_type_for_items {
326 my ( $self, $borrower ) = @_;
328 my $counts;
329 foreach my $item ( $self->items()->as_list() ) {
330 my $rule = $item->article_request_type($borrower);
331 return $rule if $rule eq 'bib_only'; # we don't need to go any further
332 $counts->{$rule}++;
335 return 'item_only' if $counts->{item_only};
336 return 'yes' if $counts->{yes};
337 return 'no' if $counts->{no};
338 return q{};
341 =head3 article_requests
343 my @requests = $biblio->article_requests
345 Returns the article requests associated with this Biblio
347 =cut
349 sub article_requests {
350 my ( $self, $borrower ) = @_;
352 $self->{_article_requests} ||= Koha::ArticleRequests->search( { biblionumber => $self->biblionumber() } );
354 return wantarray ? $self->{_article_requests}->as_list : $self->{_article_requests};
357 =head3 article_requests_current
359 my @requests = $biblio->article_requests_current
361 Returns the article requests associated with this Biblio that are incomplete
363 =cut
365 sub article_requests_current {
366 my ( $self, $borrower ) = @_;
368 $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
370 biblionumber => $self->biblionumber(),
371 -or => [
372 { status => Koha::ArticleRequest::Status::Pending },
373 { status => Koha::ArticleRequest::Status::Processing }
378 return wantarray ? $self->{_article_requests_current}->as_list : $self->{_article_requests_current};
381 =head3 article_requests_finished
383 my @requests = $biblio->article_requests_finished
385 Returns the article requests associated with this Biblio that are completed
387 =cut
389 sub article_requests_finished {
390 my ( $self, $borrower ) = @_;
392 $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
394 biblionumber => $self->biblionumber(),
395 -or => [
396 { status => Koha::ArticleRequest::Status::Completed },
397 { status => Koha::ArticleRequest::Status::Canceled }
402 return wantarray ? $self->{_article_requests_finished}->as_list : $self->{_article_requests_finished};
405 =head3 items
407 my $items = $biblio->items();
409 Returns the related Koha::Items object for this biblio
411 =cut
413 sub items {
414 my ($self) = @_;
416 my $items_rs = $self->_result->items;
418 return Koha::Items->_new_from_dbic( $items_rs );
421 =head3 itemtype
423 my $itemtype = $biblio->itemtype();
425 Returns the itemtype for this record.
427 =cut
429 sub itemtype {
430 my ( $self ) = @_;
432 return $self->biblioitem()->itemtype();
435 =head3 holds
437 my $holds = $biblio->holds();
439 return the current holds placed on this record
441 =cut
443 sub holds {
444 my ( $self, $params, $attributes ) = @_;
445 $attributes->{order_by} = 'priority' unless exists $attributes->{order_by};
446 my $hold_rs = $self->_result->reserves->search( $params, $attributes );
447 return Koha::Holds->_new_from_dbic($hold_rs);
450 =head3 current_holds
452 my $holds = $biblio->current_holds
454 Return the holds placed on this bibliographic record.
455 It does not include future holds.
457 =cut
459 sub current_holds {
460 my ($self) = @_;
461 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
462 return $self->holds(
463 { reservedate => { '<=' => $dtf->format_date(dt_from_string) } } );
466 =head3 biblioitem
468 my $field = $self->biblioitem()->itemtype
470 Returns the related Koha::Biblioitem object for this Biblio object
472 =cut
474 sub biblioitem {
475 my ($self) = @_;
477 $self->{_biblioitem} ||= Koha::Biblioitems->find( { biblionumber => $self->biblionumber() } );
479 return $self->{_biblioitem};
482 =head3 suggestions
484 my $suggestions = $self->suggestions
486 Returns the related Koha::Suggestions object for this Biblio object
488 =cut
490 sub suggestions {
491 my ($self) = @_;
493 my $suggestions_rs = $self->_result->suggestions;
494 return Koha::Suggestions->_new_from_dbic( $suggestions_rs );
497 =head3 subscriptions
499 my $subscriptions = $self->subscriptions
501 Returns the related Koha::Subscriptions object for this Biblio object
503 =cut
505 sub subscriptions {
506 my ($self) = @_;
508 $self->{_subscriptions} ||= Koha::Subscriptions->search( { biblionumber => $self->biblionumber } );
510 return $self->{_subscriptions};
513 =head3 has_items_waiting_or_intransit
515 my $itemsWaitingOrInTransit = $biblio->has_items_waiting_or_intransit
517 Tells if this bibliographic record has items waiting or in transit.
519 =cut
521 sub has_items_waiting_or_intransit {
522 my ( $self ) = @_;
524 if ( Koha::Holds->search({ biblionumber => $self->id,
525 found => ['W', 'T'] })->count ) {
526 return 1;
529 foreach my $item ( $self->items->as_list ) {
530 return 1 if $item->get_transfer;
533 return 0;
536 =head2 get_coins
538 my $coins = $biblio->get_coins;
540 Returns the COinS (a span) which can be included in a biblio record
542 =cut
544 sub get_coins {
545 my ( $self ) = @_;
547 my $record = $self->metadata->record;
549 my $pos7 = substr $record->leader(), 7, 1;
550 my $pos6 = substr $record->leader(), 6, 1;
551 my $mtx;
552 my $genre;
553 my ( $aulast, $aufirst ) = ( '', '' );
554 my @authors;
555 my $title;
556 my $hosttitle;
557 my $pubyear = '';
558 my $isbn = '';
559 my $issn = '';
560 my $publisher = '';
561 my $pages = '';
562 my $titletype = '';
564 # For the purposes of generating COinS metadata, LDR/06-07 can be
565 # considered the same for UNIMARC and MARC21
566 my $fmts6 = {
567 'a' => 'book',
568 'b' => 'manuscript',
569 'c' => 'book',
570 'd' => 'manuscript',
571 'e' => 'map',
572 'f' => 'map',
573 'g' => 'film',
574 'i' => 'audioRecording',
575 'j' => 'audioRecording',
576 'k' => 'artwork',
577 'l' => 'document',
578 'm' => 'computerProgram',
579 'o' => 'document',
580 'r' => 'document',
582 my $fmts7 = {
583 'a' => 'journalArticle',
584 's' => 'journal',
587 $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
589 if ( $genre eq 'book' ) {
590 $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
593 ##### We must transform mtx to a valable mtx and document type ####
594 if ( $genre eq 'book' ) {
595 $mtx = 'book';
596 $titletype = 'b';
597 } elsif ( $genre eq 'journal' ) {
598 $mtx = 'journal';
599 $titletype = 'j';
600 } elsif ( $genre eq 'journalArticle' ) {
601 $mtx = 'journal';
602 $genre = 'article';
603 $titletype = 'a';
604 } else {
605 $mtx = 'dc';
608 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
610 # Setting datas
611 $aulast = $record->subfield( '700', 'a' ) || '';
612 $aufirst = $record->subfield( '700', 'b' ) || '';
613 push @authors, "$aufirst $aulast" if ($aufirst or $aulast);
615 # others authors
616 if ( $record->field('200') ) {
617 for my $au ( $record->field('200')->subfield('g') ) {
618 push @authors, $au;
622 $title = $record->subfield( '200', 'a' );
623 my $subfield_210d = $record->subfield('210', 'd');
624 if ($subfield_210d and $subfield_210d =~ /(\d{4})/) {
625 $pubyear = $1;
627 $publisher = $record->subfield( '210', 'c' ) || '';
628 $isbn = $record->subfield( '010', 'a' ) || '';
629 $issn = $record->subfield( '011', 'a' ) || '';
630 } else {
632 # MARC21 need some improve
634 # Setting datas
635 if ( $record->field('100') ) {
636 push @authors, $record->subfield( '100', 'a' );
639 # others authors
640 if ( $record->field('700') ) {
641 for my $au ( $record->field('700')->subfield('a') ) {
642 push @authors, $au;
645 $title = $record->field('245')->as_string('ab');
646 if ($titletype eq 'a') {
647 $pubyear = $record->field('008') || '';
648 $pubyear = substr($pubyear->data(), 7, 4) if $pubyear;
649 $isbn = $record->subfield( '773', 'z' ) || '';
650 $issn = $record->subfield( '773', 'x' ) || '';
651 $hosttitle = $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{};
652 my @rels = $record->subfield( '773', 'g' );
653 $pages = join(', ', @rels);
654 } else {
655 $pubyear = $record->subfield( '260', 'c' ) || '';
656 $publisher = $record->subfield( '260', 'b' ) || '';
657 $isbn = $record->subfield( '020', 'a' ) || '';
658 $issn = $record->subfield( '022', 'a' ) || '';
663 my @params = (
664 [ 'ctx_ver', 'Z39.88-2004' ],
665 [ 'rft_val_fmt', "info:ofi/fmt:kev:mtx:$mtx" ],
666 [ ($mtx eq 'dc' ? 'rft.type' : 'rft.genre'), $genre ],
667 [ "rft.${titletype}title", $title ],
670 # rft.title is authorized only once, so by checking $titletype
671 # we ensure that rft.title is not already in the list.
672 if ($hosttitle and $titletype) {
673 push @params, [ 'rft.title', $hosttitle ];
676 push @params, (
677 [ 'rft.isbn', $isbn ],
678 [ 'rft.issn', $issn ],
681 # If it's a subscription, these informations have no meaning.
682 if ($genre ne 'journal') {
683 push @params, (
684 [ 'rft.aulast', $aulast ],
685 [ 'rft.aufirst', $aufirst ],
686 (map { [ 'rft.au', $_ ] } @authors),
687 [ 'rft.pub', $publisher ],
688 [ 'rft.date', $pubyear ],
689 [ 'rft.pages', $pages ],
693 my $coins_value = join( '&amp;',
694 map { $$_[1] ? $$_[0] . '=' . uri_escape_utf8( $$_[1] ) : () } @params );
696 return $coins_value;
699 =head2 get_openurl
701 my $url = $biblio->get_openurl;
703 Returns url for OpenURL resolver set in OpenURLResolverURL system preference
705 =cut
707 sub get_openurl {
708 my ( $self ) = @_;
710 my $OpenURLResolverURL = C4::Context->preference('OpenURLResolverURL');
712 if ($OpenURLResolverURL) {
713 my $uri = URI->new($OpenURLResolverURL);
715 if (not defined $uri->query) {
716 $OpenURLResolverURL .= '?';
717 } else {
718 $OpenURLResolverURL .= '&amp;';
720 $OpenURLResolverURL .= $self->get_coins;
723 return $OpenURLResolverURL;
726 =head3 is_serial
728 my $serial = $biblio->is_serial
730 Return boolean true if this bibbliographic record is continuing resource
732 =cut
734 sub is_serial {
735 my ( $self ) = @_;
737 return 1 if $self->serial;
739 my $record = $self->metadata->record;
740 return 1 if substr($record->leader, 7, 1) eq 's';
742 return 0;
745 =head3 custom_cover_image_url
747 my $image_url = $biblio->custom_cover_image_url
749 Return the specific url of the cover image for this bibliographic record.
750 It is built regaring the value of the system preference CustomCoverImagesURL
752 =cut
754 sub custom_cover_image_url {
755 my ( $self ) = @_;
756 my $url = C4::Context->preference('CustomCoverImagesURL');
757 if ( $url =~ m|{isbn}| ) {
758 my $isbn = $self->biblioitem->isbn;
759 $url =~ s|{isbn}|$isbn|g;
761 if ( $url =~ m|{normalized_isbn}| ) {
762 my $normalized_isbn = C4::Koha::GetNormalizedISBN($self->biblioitem->isbn);
763 $url =~ s|{normalized_isbn}|$normalized_isbn|g;
765 if ( $url =~ m|{issn}| ) {
766 my $issn = $self->biblioitem->issn;
767 $url =~ s|{issn}|$issn|g;
770 my $re = qr|{(?<field>\d{3})\$(?<subfield>.)}|;
771 if ( $url =~ $re ) {
772 my $field = $+{field};
773 my $subfield = $+{subfield};
774 my $marc_record = $self->metadata->record;
775 my $value = $marc_record->subfield($field, $subfield);
776 $url =~ s|$re|$value|;
779 return $url;
782 =head3 to_api
784 my $json = $biblio->to_api;
786 Overloaded method that returns a JSON representation of the Koha::Biblio object,
787 suitable for API output. The related Koha::Biblioitem object is merged as expected
788 on the API.
790 =cut
792 sub to_api {
793 my ($self, $args) = @_;
795 my $response = $self->SUPER::to_api( $args );
796 my $biblioitem = $self->biblioitem->to_api;
798 return { %$response, %$biblioitem };
801 =head3 to_api_mapping
803 This method returns the mapping for representing a Koha::Biblio object
804 on the API.
806 =cut
808 sub to_api_mapping {
809 return {
810 biblionumber => 'biblio_id',
811 frameworkcode => 'framework_id',
812 unititle => 'uniform_title',
813 seriestitle => 'series_title',
814 copyrightdate => 'copyright_date',
815 datecreated => 'creation_date'
819 =head2 Internal methods
821 =head3 type
823 =cut
825 sub _type {
826 return 'Biblio';
829 =head1 AUTHOR
831 Kyle M Hall <kyle@bywatersolutions.com>
833 =cut