Bug 21674: (RM follow-up) Fix updatedatabase error
[koha.git] / Koha / Biblio.pm
blobd5fe1f9fa6d198ef2d4a4f032d55876c49964824
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 under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 3 of the License, or (at your option) any later
10 # version.
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
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::IssuingRules;
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 @pickup_locations = $biblio->pickup_locations( {patron => $patron } )
210 Returns possible pickup locations for this biblio items, according to patron's home library (if patron is defined and holds are allowed only from hold groups)
211 and if item can be transferred to each pickup location.
213 =cut
215 sub pickup_locations {
216 my ($self, $params) = @_;
218 my $patron = $params->{patron};
220 my @pickup_locations;
221 foreach my $item_of_bib ($self->items->as_list) {
222 push @pickup_locations, $item_of_bib->pickup_locations( {patron => $patron} );
225 my %seen;
226 @pickup_locations =
227 grep { !$seen{ $_->branchcode }++ } @pickup_locations;
229 return wantarray ? @pickup_locations : \@pickup_locations;
232 =head3 hidden_in_opac
234 my $bool = $biblio->hidden_in_opac({ [ rules => $rules ] })
236 Returns true if the biblio matches the hidding criteria defined in $rules.
237 Returns false otherwise.
239 Takes HASHref that can have the following parameters:
240 OPTIONAL PARAMETERS:
241 $rules : { <field> => [ value_1, ... ], ... }
243 Note: $rules inherits its structure from the parsed YAML from reading
244 the I<OpacHiddenItems> system preference.
246 =cut
248 sub hidden_in_opac {
249 my ( $self, $params ) = @_;
251 my $rules = $params->{rules} // {};
253 my @items = $self->items->as_list;
255 return 0 unless @items; # Do not hide if there is no item
257 return !(any { !$_->hidden_in_opac({ rules => $rules }) } @items);
260 =head3 article_request_type
262 my $type = $biblio->article_request_type( $borrower );
264 Returns the article request type based on items, or on the record
265 itself if there are no items.
267 $borrower must be a Koha::Patron object
269 =cut
271 sub article_request_type {
272 my ( $self, $borrower ) = @_;
274 return q{} unless $borrower;
276 my $rule = $self->article_request_type_for_items( $borrower );
277 return $rule if $rule;
279 # If the record has no items that are requestable, go by the record itemtype
280 $rule = $self->article_request_type_for_bib($borrower);
281 return $rule if $rule;
283 return q{};
286 =head3 article_request_type_for_bib
288 my $type = $biblio->article_request_type_for_bib
290 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record
292 =cut
294 sub article_request_type_for_bib {
295 my ( $self, $borrower ) = @_;
297 return q{} unless $borrower;
299 my $borrowertype = $borrower->categorycode;
300 my $itemtype = $self->itemtype();
302 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule({ categorycode => $borrowertype, itemtype => $itemtype });
304 return q{} unless $issuing_rule;
305 return $issuing_rule->article_requests || q{}
308 =head3 article_request_type_for_items
310 my $type = $biblio->article_request_type_for_items
312 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record's items
314 If there is a conflict where some items are 'bib_only' and some are 'item_only', 'bib_only' will be returned.
316 =cut
318 sub article_request_type_for_items {
319 my ( $self, $borrower ) = @_;
321 my $counts;
322 foreach my $item ( $self->items()->as_list() ) {
323 my $rule = $item->article_request_type($borrower);
324 return $rule if $rule eq 'bib_only'; # we don't need to go any further
325 $counts->{$rule}++;
328 return 'item_only' if $counts->{item_only};
329 return 'yes' if $counts->{yes};
330 return 'no' if $counts->{no};
331 return q{};
334 =head3 article_requests
336 my @requests = $biblio->article_requests
338 Returns the article requests associated with this Biblio
340 =cut
342 sub article_requests {
343 my ( $self, $borrower ) = @_;
345 $self->{_article_requests} ||= Koha::ArticleRequests->search( { biblionumber => $self->biblionumber() } );
347 return wantarray ? $self->{_article_requests}->as_list : $self->{_article_requests};
350 =head3 article_requests_current
352 my @requests = $biblio->article_requests_current
354 Returns the article requests associated with this Biblio that are incomplete
356 =cut
358 sub article_requests_current {
359 my ( $self, $borrower ) = @_;
361 $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
363 biblionumber => $self->biblionumber(),
364 -or => [
365 { status => Koha::ArticleRequest::Status::Pending },
366 { status => Koha::ArticleRequest::Status::Processing }
371 return wantarray ? $self->{_article_requests_current}->as_list : $self->{_article_requests_current};
374 =head3 article_requests_finished
376 my @requests = $biblio->article_requests_finished
378 Returns the article requests associated with this Biblio that are completed
380 =cut
382 sub article_requests_finished {
383 my ( $self, $borrower ) = @_;
385 $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
387 biblionumber => $self->biblionumber(),
388 -or => [
389 { status => Koha::ArticleRequest::Status::Completed },
390 { status => Koha::ArticleRequest::Status::Canceled }
395 return wantarray ? $self->{_article_requests_finished}->as_list : $self->{_article_requests_finished};
398 =head3 items
400 my $items = $biblio->items();
402 Returns the related Koha::Items object for this biblio
404 =cut
406 sub items {
407 my ($self) = @_;
409 my $items_rs = $self->_result->items;
411 return Koha::Items->_new_from_dbic( $items_rs );
414 =head3 itemtype
416 my $itemtype = $biblio->itemtype();
418 Returns the itemtype for this record.
420 =cut
422 sub itemtype {
423 my ( $self ) = @_;
425 return $self->biblioitem()->itemtype();
428 =head3 holds
430 my $holds = $biblio->holds();
432 return the current holds placed on this record
434 =cut
436 sub holds {
437 my ( $self, $params, $attributes ) = @_;
438 $attributes->{order_by} = 'priority' unless exists $attributes->{order_by};
439 my $hold_rs = $self->_result->reserves->search( $params, $attributes );
440 return Koha::Holds->_new_from_dbic($hold_rs);
443 =head3 current_holds
445 my $holds = $biblio->current_holds
447 Return the holds placed on this bibliographic record.
448 It does not include future holds.
450 =cut
452 sub current_holds {
453 my ($self) = @_;
454 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
455 return $self->holds(
456 { reservedate => { '<=' => $dtf->format_date(dt_from_string) } } );
459 =head3 biblioitem
461 my $field = $self->biblioitem()->itemtype
463 Returns the related Koha::Biblioitem object for this Biblio object
465 =cut
467 sub biblioitem {
468 my ($self) = @_;
470 $self->{_biblioitem} ||= Koha::Biblioitems->find( { biblionumber => $self->biblionumber() } );
472 return $self->{_biblioitem};
475 =head3 suggestions
477 my $suggestions = $self->suggestions
479 Returns the related Koha::Suggestions object for this Biblio object
481 =cut
483 sub suggestions {
484 my ($self) = @_;
486 my $suggestions_rs = $self->_result->suggestions;
487 return Koha::Suggestions->_new_from_dbic( $suggestions_rs );
490 =head3 subscriptions
492 my $subscriptions = $self->subscriptions
494 Returns the related Koha::Subscriptions object for this Biblio object
496 =cut
498 sub subscriptions {
499 my ($self) = @_;
501 $self->{_subscriptions} ||= Koha::Subscriptions->search( { biblionumber => $self->biblionumber } );
503 return $self->{_subscriptions};
506 =head3 has_items_waiting_or_intransit
508 my $itemsWaitingOrInTransit = $biblio->has_items_waiting_or_intransit
510 Tells if this bibliographic record has items waiting or in transit.
512 =cut
514 sub has_items_waiting_or_intransit {
515 my ( $self ) = @_;
517 if ( Koha::Holds->search({ biblionumber => $self->id,
518 found => ['W', 'T'] })->count ) {
519 return 1;
522 foreach my $item ( $self->items->as_list ) {
523 return 1 if $item->get_transfer;
526 return 0;
529 =head2 get_coins
531 my $coins = $biblio->get_coins;
533 Returns the COinS (a span) which can be included in a biblio record
535 =cut
537 sub get_coins {
538 my ( $self ) = @_;
540 my $record = $self->metadata->record;
542 my $pos7 = substr $record->leader(), 7, 1;
543 my $pos6 = substr $record->leader(), 6, 1;
544 my $mtx;
545 my $genre;
546 my ( $aulast, $aufirst ) = ( '', '' );
547 my @authors;
548 my $title;
549 my $hosttitle;
550 my $pubyear = '';
551 my $isbn = '';
552 my $issn = '';
553 my $publisher = '';
554 my $pages = '';
555 my $titletype = '';
557 # For the purposes of generating COinS metadata, LDR/06-07 can be
558 # considered the same for UNIMARC and MARC21
559 my $fmts6 = {
560 'a' => 'book',
561 'b' => 'manuscript',
562 'c' => 'book',
563 'd' => 'manuscript',
564 'e' => 'map',
565 'f' => 'map',
566 'g' => 'film',
567 'i' => 'audioRecording',
568 'j' => 'audioRecording',
569 'k' => 'artwork',
570 'l' => 'document',
571 'm' => 'computerProgram',
572 'o' => 'document',
573 'r' => 'document',
575 my $fmts7 = {
576 'a' => 'journalArticle',
577 's' => 'journal',
580 $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
582 if ( $genre eq 'book' ) {
583 $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
586 ##### We must transform mtx to a valable mtx and document type ####
587 if ( $genre eq 'book' ) {
588 $mtx = 'book';
589 $titletype = 'b';
590 } elsif ( $genre eq 'journal' ) {
591 $mtx = 'journal';
592 $titletype = 'j';
593 } elsif ( $genre eq 'journalArticle' ) {
594 $mtx = 'journal';
595 $genre = 'article';
596 $titletype = 'a';
597 } else {
598 $mtx = 'dc';
601 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
603 # Setting datas
604 $aulast = $record->subfield( '700', 'a' ) || '';
605 $aufirst = $record->subfield( '700', 'b' ) || '';
606 push @authors, "$aufirst $aulast" if ($aufirst or $aulast);
608 # others authors
609 if ( $record->field('200') ) {
610 for my $au ( $record->field('200')->subfield('g') ) {
611 push @authors, $au;
615 $title = $record->subfield( '200', 'a' );
616 my $subfield_210d = $record->subfield('210', 'd');
617 if ($subfield_210d and $subfield_210d =~ /(\d{4})/) {
618 $pubyear = $1;
620 $publisher = $record->subfield( '210', 'c' ) || '';
621 $isbn = $record->subfield( '010', 'a' ) || '';
622 $issn = $record->subfield( '011', 'a' ) || '';
623 } else {
625 # MARC21 need some improve
627 # Setting datas
628 if ( $record->field('100') ) {
629 push @authors, $record->subfield( '100', 'a' );
632 # others authors
633 if ( $record->field('700') ) {
634 for my $au ( $record->field('700')->subfield('a') ) {
635 push @authors, $au;
638 $title = $record->field('245')->as_string('ab');
639 if ($titletype eq 'a') {
640 $pubyear = $record->field('008') || '';
641 $pubyear = substr($pubyear->data(), 7, 4) if $pubyear;
642 $isbn = $record->subfield( '773', 'z' ) || '';
643 $issn = $record->subfield( '773', 'x' ) || '';
644 $hosttitle = $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{};
645 my @rels = $record->subfield( '773', 'g' );
646 $pages = join(', ', @rels);
647 } else {
648 $pubyear = $record->subfield( '260', 'c' ) || '';
649 $publisher = $record->subfield( '260', 'b' ) || '';
650 $isbn = $record->subfield( '020', 'a' ) || '';
651 $issn = $record->subfield( '022', 'a' ) || '';
656 my @params = (
657 [ 'ctx_ver', 'Z39.88-2004' ],
658 [ 'rft_val_fmt', "info:ofi/fmt:kev:mtx:$mtx" ],
659 [ ($mtx eq 'dc' ? 'rft.type' : 'rft.genre'), $genre ],
660 [ "rft.${titletype}title", $title ],
663 # rft.title is authorized only once, so by checking $titletype
664 # we ensure that rft.title is not already in the list.
665 if ($hosttitle and $titletype) {
666 push @params, [ 'rft.title', $hosttitle ];
669 push @params, (
670 [ 'rft.isbn', $isbn ],
671 [ 'rft.issn', $issn ],
674 # If it's a subscription, these informations have no meaning.
675 if ($genre ne 'journal') {
676 push @params, (
677 [ 'rft.aulast', $aulast ],
678 [ 'rft.aufirst', $aufirst ],
679 (map { [ 'rft.au', $_ ] } @authors),
680 [ 'rft.pub', $publisher ],
681 [ 'rft.date', $pubyear ],
682 [ 'rft.pages', $pages ],
686 my $coins_value = join( '&amp;',
687 map { $$_[1] ? $$_[0] . '=' . uri_escape_utf8( $$_[1] ) : () } @params );
689 return $coins_value;
692 =head2 get_openurl
694 my $url = $biblio->get_openurl;
696 Returns url for OpenURL resolver set in OpenURLResolverURL system preference
698 =cut
700 sub get_openurl {
701 my ( $self ) = @_;
703 my $OpenURLResolverURL = C4::Context->preference('OpenURLResolverURL');
705 if ($OpenURLResolverURL) {
706 my $uri = URI->new($OpenURLResolverURL);
708 if (not defined $uri->query) {
709 $OpenURLResolverURL .= '?';
710 } else {
711 $OpenURLResolverURL .= '&amp;';
713 $OpenURLResolverURL .= $self->get_coins;
716 return $OpenURLResolverURL;
719 =head3 is_serial
721 my $serial = $biblio->is_serial
723 Return boolean true if this bibbliographic record is continuing resource
725 =cut
727 sub is_serial {
728 my ( $self ) = @_;
730 return 1 if $self->serial;
732 my $record = $self->metadata->record;
733 return 1 if substr($record->leader, 7, 1) eq 's';
735 return 0;
738 =head3 custom_cover_image_url
740 my $image_url = $biblio->custom_cover_image_url
742 Return the specific url of the cover image for this bibliographic record.
743 It is built regaring the value of the system preference CustomCoverImagesURL
745 =cut
747 sub custom_cover_image_url {
748 my ( $self ) = @_;
749 my $url = C4::Context->preference('CustomCoverImagesURL');
750 if ( $url =~ m|{isbn}| ) {
751 my $isbn = $self->biblioitem->isbn;
752 $url =~ s|{isbn}|$isbn|g;
754 if ( $url =~ m|{normalized_isbn}| ) {
755 my $normalized_isbn = C4::Koha::GetNormalizedISBN($self->biblioitem->isbn);
756 $url =~ s|{normalized_isbn}|$normalized_isbn|g;
758 if ( $url =~ m|{issn}| ) {
759 my $issn = $self->biblioitem->issn;
760 $url =~ s|{issn}|$issn|g;
763 my $re = qr|{(?<field>\d{3})\$(?<subfield>.)}|;
764 if ( $url =~ $re ) {
765 my $field = $+{field};
766 my $subfield = $+{subfield};
767 my $marc_record = $self->metadata->record;
768 my $value = $marc_record->subfield($field, $subfield);
769 $url =~ s|$re|$value|;
772 return $url;
775 =head3 to_api
777 my $json = $biblio->to_api;
779 Overloaded method that returns a JSON representation of the Koha::Biblio object,
780 suitable for API output. The related Koha::Biblioitem object is merged as expected
781 on the API.
783 =cut
785 sub to_api {
786 my ($self, $args) = @_;
788 my @embeds = keys %{ $args->{embed} };
789 my $remaining_embeds = {};
791 foreach my $embed (@embeds) {
792 $remaining_embeds = delete $args->{embed}->{$embed}
793 unless $self->can($embed);
796 my $response = $self->SUPER::to_api( $args );
797 my $biblioitem = $self->biblioitem->to_api({ embed => $remaining_embeds });
799 return { %$response, %$biblioitem };
802 =head3 to_api_mapping
804 This method returns the mapping for representing a Koha::Biblio object
805 on the API.
807 =cut
809 sub to_api_mapping {
810 return {
811 biblionumber => 'biblio_id',
812 frameworkcode => 'framework_id',
813 unititle => 'uniform_title',
814 seriestitle => 'series_title',
815 copyrightdate => 'copyright_date',
816 datecreated => 'creation_date'
820 =head2 Internal methods
822 =head3 type
824 =cut
826 sub _type {
827 return 'Biblio';
830 =head1 AUTHOR
832 Kyle M Hall <kyle@bywatersolutions.com>
834 =cut