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 );
29 use Koha::DateUtils qw( dt_from_string );
31 use base qw(Koha::Object);
33 use Koha::Acquisition::Orders;
34 use Koha::ArticleRequest::Status;
35 use Koha::ArticleRequests;
36 use Koha::Biblio::Metadatas;
37 use Koha::Biblioitems;
38 use Koha::CirculationRules;
39 use Koha::Item::Transfer::Limits;
42 use Koha::Suggestions;
43 use Koha::Subscriptions;
47 Koha::Biblio - Koha Biblio Object class
57 Overloaded I<store> method to set default values
64 $self->datecreated( dt_from_string ) unless $self->datecreated;
66 return $self->SUPER::store;
71 my $metadata = $biblio->metadata();
73 Returns a Koha::Biblio::Metadata object
80 my $metadata = $self->_result->metadata;
81 return Koha::Biblio::Metadata->_new_from_dbic($metadata);
86 my $orders = $biblio->orders();
88 Returns a Koha::Acquisition::Orders object
95 my $orders = $self->_result->orders;
96 return Koha::Acquisition::Orders->_new_from_dbic($orders);
101 my $active_orders = $biblio->active_orders();
103 Returns the active acquisition orders related to this biblio.
104 An order is considered active when it is not cancelled (i.e. when datecancellation
112 return $self->orders->search({ datecancellationprinted => undef });
115 =head3 can_article_request
117 my $bool = $biblio->can_article_request( $borrower );
119 Returns true if article requests can be made for this record
121 $borrower must be a Koha::Patron object
125 sub can_article_request {
126 my ( $self, $borrower ) = @_;
128 my $rule = $self->article_request_type($borrower);
129 return q{} if $rule eq 'item_only' && !$self->items()->count();
130 return 1 if $rule && $rule ne 'no';
135 =head3 can_be_transferred
137 $biblio->can_be_transferred({ to => $to_library, from => $from_library })
139 Checks if at least one item of a biblio can be transferred to given library.
141 This feature is controlled by two system preferences:
142 UseBranchTransferLimits to enable / disable the feature
143 BranchTransferLimitsType to use either an itemnumber or ccode as an identifier
144 for setting the limitations
146 Performance-wise, it is recommended to use this method for a biblio instead of
147 iterating each item of a biblio with Koha::Item->can_be_transferred().
149 Takes HASHref that can have the following parameters:
150 MANDATORY PARAMETERS:
153 $from : Koha::Library # if given, only items from that
154 # holdingbranch are considered
156 Returns 1 if at least one of the item of a biblio can be transferred
157 to $to_library, otherwise 0.
161 sub can_be_transferred {
162 my ($self, $params) = @_;
164 my $to = $params->{to};
165 my $from = $params->{from};
167 return 1 unless C4::Context->preference('UseBranchTransferLimits');
168 my $limittype = C4::Context->preference('BranchTransferLimitsType');
171 foreach my $item_of_bib ($self->items->as_list) {
172 next unless $item_of_bib->holdingbranch;
173 next if $from && $from->branchcode ne $item_of_bib->holdingbranch;
174 return 1 if $item_of_bib->holdingbranch eq $to->branchcode;
175 my $code = $limittype eq 'itemtype'
176 ? $item_of_bib->effective_itemtype
177 : $item_of_bib->ccode;
178 return 1 unless $code;
179 $items->{$code}->{$item_of_bib->holdingbranch} = 1;
182 # At this point we will have a HASHref containing each itemtype/ccode that
183 # this biblio has, inside which are all of the holdingbranches where those
184 # items are located at. Then, we will query Koha::Item::Transfer::Limits to
185 # find out whether a transfer limits for such $limittype from any of the
186 # listed holdingbranches to the given $to library exist. If at least one
187 # holdingbranch for that $limittype does not have a transfer limit to given
188 # $to library, then we know that the transfer is possible.
189 foreach my $code (keys %{$items}) {
190 my @holdingbranches = keys %{$items->{$code}};
191 return 1 if Koha::Item::Transfer::Limits->search({
192 toBranch => $to->branchcode,
193 fromBranch => { 'in' => \@holdingbranches },
196 group_by => [qw/fromBranch/]
197 })->count == scalar(@holdingbranches) ? 0 : 1;
204 =head3 pickup_locations
206 my $pickup_locations = $biblio->pickup_locations( {patron => $patron } );
208 Returns a Koha::Libraries set of possible pickup locations for this biblio's items,
209 according to patron's home library (if patron is defined and holds are allowed
210 only from hold groups) and if item can be transferred to each pickup location.
214 sub pickup_locations {
215 my ( $self, $params ) = @_;
217 my $patron = $params->{patron};
219 my @pickup_locations;
220 foreach my $item_of_bib ( $self->items->as_list ) {
221 push @pickup_locations,
222 $item_of_bib->pickup_locations( { patron => $patron } )
223 ->_resultset->get_column('branchcode')->all;
226 return Koha::Libraries->search(
227 { branchcode => { '-in' => \@pickup_locations } }, { order_by => ['branchname'] } );
230 =head3 hidden_in_opac
232 my $bool = $biblio->hidden_in_opac({ [ rules => $rules ] })
234 Returns true if the biblio matches the hidding criteria defined in $rules.
235 Returns false otherwise. It involves the I<OpacHiddenItems> and
236 I<OpacHiddenItemsHidesRecord> system preferences.
238 Takes HASHref that can have the following parameters:
240 $rules : { <field> => [ value_1, ... ], ... }
242 Note: $rules inherits its structure from the parsed YAML from reading
243 the I<OpacHiddenItems> system preference.
248 my ( $self, $params ) = @_;
250 my $rules = $params->{rules} // {};
252 my @items = $self->items->as_list;
254 return 0 unless @items; # Do not hide if there is no item
256 # Ok, there are items, don't even try the rules unless OpacHiddenItemsHidesRecord
257 return 0 unless C4::Context->preference('OpacHiddenItemsHidesRecord');
259 return !(any { !$_->hidden_in_opac({ rules => $rules }) } @items);
262 =head3 article_request_type
264 my $type = $biblio->article_request_type( $borrower );
266 Returns the article request type based on items, or on the record
267 itself if there are no items.
269 $borrower must be a Koha::Patron object
273 sub article_request_type {
274 my ( $self, $borrower ) = @_;
276 return q{} unless $borrower;
278 my $rule = $self->article_request_type_for_items( $borrower );
279 return $rule if $rule;
281 # If the record has no items that are requestable, go by the record itemtype
282 $rule = $self->article_request_type_for_bib($borrower);
283 return $rule if $rule;
288 =head3 article_request_type_for_bib
290 my $type = $biblio->article_request_type_for_bib
292 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record
296 sub article_request_type_for_bib {
297 my ( $self, $borrower ) = @_;
299 return q{} unless $borrower;
301 my $borrowertype = $borrower->categorycode;
302 my $itemtype = $self->itemtype();
304 my $rule = Koha::CirculationRules->get_effective_rule(
306 rule_name => 'article_requests',
307 categorycode => $borrowertype,
308 itemtype => $itemtype,
312 return q{} unless $rule;
313 return $rule->rule_value || q{}
316 =head3 article_request_type_for_items
318 my $type = $biblio->article_request_type_for_items
320 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record's items
322 If there is a conflict where some items are 'bib_only' and some are 'item_only', 'bib_only' will be returned.
326 sub article_request_type_for_items {
327 my ( $self, $borrower ) = @_;
330 foreach my $item ( $self->items()->as_list() ) {
331 my $rule = $item->article_request_type($borrower);
332 return $rule if $rule eq 'bib_only'; # we don't need to go any further
336 return 'item_only' if $counts->{item_only};
337 return 'yes' if $counts->{yes};
338 return 'no' if $counts->{no};
342 =head3 article_requests
344 my @requests = $biblio->article_requests
346 Returns the article requests associated with this Biblio
350 sub article_requests {
351 my ( $self, $borrower ) = @_;
353 $self->{_article_requests} ||= Koha::ArticleRequests->search( { biblionumber => $self->biblionumber() } );
355 return wantarray ? $self->{_article_requests}->as_list : $self->{_article_requests};
358 =head3 article_requests_current
360 my @requests = $biblio->article_requests_current
362 Returns the article requests associated with this Biblio that are incomplete
366 sub article_requests_current {
367 my ( $self, $borrower ) = @_;
369 $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
371 biblionumber => $self->biblionumber(),
373 { status => Koha::ArticleRequest::Status::Pending },
374 { status => Koha::ArticleRequest::Status::Processing }
379 return wantarray ? $self->{_article_requests_current}->as_list : $self->{_article_requests_current};
382 =head3 article_requests_finished
384 my @requests = $biblio->article_requests_finished
386 Returns the article requests associated with this Biblio that are completed
390 sub article_requests_finished {
391 my ( $self, $borrower ) = @_;
393 $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
395 biblionumber => $self->biblionumber(),
397 { status => Koha::ArticleRequest::Status::Completed },
398 { status => Koha::ArticleRequest::Status::Canceled }
403 return wantarray ? $self->{_article_requests_finished}->as_list : $self->{_article_requests_finished};
408 my $items = $biblio->items();
410 Returns the related Koha::Items object for this biblio
417 my $items_rs = $self->_result->items;
419 return Koha::Items->_new_from_dbic( $items_rs );
424 my $itemtype = $biblio->itemtype();
426 Returns the itemtype for this record.
433 return $self->biblioitem()->itemtype();
438 my $holds = $biblio->holds();
440 return the current holds placed on this record
445 my ( $self, $params, $attributes ) = @_;
446 $attributes->{order_by} = 'priority' unless exists $attributes->{order_by};
447 my $hold_rs = $self->_result->reserves->search( $params, $attributes );
448 return Koha::Holds->_new_from_dbic($hold_rs);
453 my $holds = $biblio->current_holds
455 Return the holds placed on this bibliographic record.
456 It does not include future holds.
462 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
464 { reservedate => { '<=' => $dtf->format_date(dt_from_string) } } );
469 my $field = $self->biblioitem()->itemtype
471 Returns the related Koha::Biblioitem object for this Biblio object
478 $self->{_biblioitem} ||= Koha::Biblioitems->find( { biblionumber => $self->biblionumber() } );
480 return $self->{_biblioitem};
485 my $suggestions = $self->suggestions
487 Returns the related Koha::Suggestions object for this Biblio object
494 my $suggestions_rs = $self->_result->suggestions;
495 return Koha::Suggestions->_new_from_dbic( $suggestions_rs );
500 my $subscriptions = $self->subscriptions
502 Returns the related Koha::Subscriptions object for this Biblio object
509 $self->{_subscriptions} ||= Koha::Subscriptions->search( { biblionumber => $self->biblionumber } );
511 return $self->{_subscriptions};
514 =head3 has_items_waiting_or_intransit
516 my $itemsWaitingOrInTransit = $biblio->has_items_waiting_or_intransit
518 Tells if this bibliographic record has items waiting or in transit.
522 sub has_items_waiting_or_intransit {
525 if ( Koha::Holds->search({ biblionumber => $self->id,
526 found => ['W', 'T'] })->count ) {
530 foreach my $item ( $self->items->as_list ) {
531 return 1 if $item->get_transfer;
539 my $coins = $biblio->get_coins;
541 Returns the COinS (a span) which can be included in a biblio record
548 my $record = $self->metadata->record;
550 my $pos7 = substr $record->leader(), 7, 1;
551 my $pos6 = substr $record->leader(), 6, 1;
554 my ( $aulast, $aufirst ) = ( '', '' );
565 # For the purposes of generating COinS metadata, LDR/06-07 can be
566 # considered the same for UNIMARC and MARC21
575 'i' => 'audioRecording',
576 'j' => 'audioRecording',
579 'm' => 'computerProgram',
584 'a' => 'journalArticle',
588 $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
590 if ( $genre eq 'book' ) {
591 $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
594 ##### We must transform mtx to a valable mtx and document type ####
595 if ( $genre eq 'book' ) {
598 } elsif ( $genre eq 'journal' ) {
601 } elsif ( $genre eq 'journalArticle' ) {
609 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
612 $aulast = $record->subfield( '700', 'a' ) || '';
613 $aufirst = $record->subfield( '700', 'b' ) || '';
614 push @authors, "$aufirst $aulast" if ($aufirst or $aulast);
617 if ( $record->field('200') ) {
618 for my $au ( $record->field('200')->subfield('g') ) {
623 $title = $record->subfield( '200', 'a' );
624 my $subfield_210d = $record->subfield('210', 'd');
625 if ($subfield_210d and $subfield_210d =~ /(\d{4})/) {
628 $publisher = $record->subfield( '210', 'c' ) || '';
629 $isbn = $record->subfield( '010', 'a' ) || '';
630 $issn = $record->subfield( '011', 'a' ) || '';
633 # MARC21 need some improve
636 if ( $record->field('100') ) {
637 push @authors, $record->subfield( '100', 'a' );
641 if ( $record->field('700') ) {
642 for my $au ( $record->field('700')->subfield('a') ) {
646 $title = $record->field('245');
647 $title &&= $title->as_string('ab');
648 if ($titletype eq 'a') {
649 $pubyear = $record->field('008') || '';
650 $pubyear = substr($pubyear->data(), 7, 4) if $pubyear;
651 $isbn = $record->subfield( '773', 'z' ) || '';
652 $issn = $record->subfield( '773', 'x' ) || '';
653 $hosttitle = $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{};
654 my @rels = $record->subfield( '773', 'g' );
655 $pages = join(', ', @rels);
657 $pubyear = $record->subfield( '260', 'c' ) || '';
658 $publisher = $record->subfield( '260', 'b' ) || '';
659 $isbn = $record->subfield( '020', 'a' ) || '';
660 $issn = $record->subfield( '022', 'a' ) || '';
666 [ 'ctx_ver', 'Z39.88-2004' ],
667 [ 'rft_val_fmt', "info:ofi/fmt:kev:mtx:$mtx" ],
668 [ ($mtx eq 'dc' ? 'rft.type' : 'rft.genre'), $genre ],
669 [ "rft.${titletype}title", $title ],
672 # rft.title is authorized only once, so by checking $titletype
673 # we ensure that rft.title is not already in the list.
674 if ($hosttitle and $titletype) {
675 push @params, [ 'rft.title', $hosttitle ];
679 [ 'rft.isbn', $isbn ],
680 [ 'rft.issn', $issn ],
683 # If it's a subscription, these informations have no meaning.
684 if ($genre ne 'journal') {
686 [ 'rft.aulast', $aulast ],
687 [ 'rft.aufirst', $aufirst ],
688 (map { [ 'rft.au', $_ ] } @authors),
689 [ 'rft.pub', $publisher ],
690 [ 'rft.date', $pubyear ],
691 [ 'rft.pages', $pages ],
695 my $coins_value = join( '&',
696 map { $$_[1] ? $$_[0] . '=' . uri_escape_utf8( $$_[1] ) : () } @params );
703 my $url = $biblio->get_openurl;
705 Returns url for OpenURL resolver set in OpenURLResolverURL system preference
712 my $OpenURLResolverURL = C4::Context->preference('OpenURLResolverURL');
714 if ($OpenURLResolverURL) {
715 my $uri = URI->new($OpenURLResolverURL);
717 if (not defined $uri->query) {
718 $OpenURLResolverURL .= '?';
720 $OpenURLResolverURL .= '&';
722 $OpenURLResolverURL .= $self->get_coins;
725 return $OpenURLResolverURL;
730 my $serial = $biblio->is_serial
732 Return boolean true if this bibbliographic record is continuing resource
739 return 1 if $self->serial;
741 my $record = $self->metadata->record;
742 return 1 if substr($record->leader, 7, 1) eq 's';
747 =head3 custom_cover_image_url
749 my $image_url = $biblio->custom_cover_image_url
751 Return the specific url of the cover image for this bibliographic record.
752 It is built regaring the value of the system preference CustomCoverImagesURL
756 sub custom_cover_image_url {
758 my $url = C4::Context->preference('CustomCoverImagesURL');
759 if ( $url =~ m|{isbn}| ) {
760 my $isbn = $self->biblioitem->isbn;
762 $url =~ s|{isbn}|$isbn|g;
764 if ( $url =~ m|{normalized_isbn}| ) {
765 my $normalized_isbn = C4::Koha::GetNormalizedISBN($self->biblioitem->isbn);
766 return unless $normalized_isbn;
767 $url =~ s|{normalized_isbn}|$normalized_isbn|g;
769 if ( $url =~ m|{issn}| ) {
770 my $issn = $self->biblioitem->issn;
772 $url =~ s|{issn}|$issn|g;
775 my $re = qr|{(?<field>\d{3})\$(?<subfield>.)}|;
777 my $field = $+{field};
778 my $subfield = $+{subfield};
779 my $marc_record = $self->metadata->record;
780 my $value = $marc_record->subfield($field, $subfield);
781 return unless $value;
782 $url =~ s|$re|$value|;
790 Return the cover images associated with this biblio.
797 my $cover_images_rs = $self->_result->cover_images;
798 return unless $cover_images_rs;
799 return Koha::CoverImages->_new_from_dbic($cover_images_rs);
802 =head3 get_marc_notes
804 $marcnotesarray = $biblio->get_marc_notes({ marcflavour => $marcflavour });
806 Get all notes from the MARC record and returns them in an array.
807 The notes are stored in different fields depending on MARC flavour.
808 MARC21 5XX $u subfields receive special attention as they are URIs.
813 my ( $self, $params ) = @_;
815 my $marcflavour = $params->{marcflavour};
816 my $opac = $params->{opac};
818 my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
821 #MARC21 specs indicate some notes should be private if first indicator 0
822 my %maybe_private = (
830 my %hiddenlist = map { $_ => 1 }
831 split( /,/, C4::Context->preference('NotesToHide'));
832 foreach my $field ( $self->metadata->record->field($scope) ) {
833 my $tag = $field->tag();
834 next if $hiddenlist{ $tag };
835 next if $opac && $maybe_private{$tag} && !$field->indicator(1);
836 if( $marcflavour ne 'UNIMARC' && $field->subfield('u') ) {
837 # Field 5XX$u always contains URI
838 # Examples: 505u, 506u, 510u, 514u, 520u, 530u, 538u, 540u, 542u, 552u, 555u, 561u, 563u, 583u
839 # We first push the other subfields, then all $u's separately
840 # Leave further actions to the template (see e.g. opac-detail)
842 join '', ( 'a' .. 't', 'v' .. 'z', '0' .. '9' ); # excl 'u'
843 push @marcnotes, { marcnote => $field->as_string($othersub) };
844 foreach my $sub ( $field->subfield('u') ) {
845 $sub =~ s/^\s+|\s+$//g; # trim
846 push @marcnotes, { marcnote => $sub };
849 push @marcnotes, { marcnote => $field->as_string() };
857 my $json = $biblio->to_api;
859 Overloaded method that returns a JSON representation of the Koha::Biblio object,
860 suitable for API output. The related Koha::Biblioitem object is merged as expected
866 my ($self, $args) = @_;
868 my $response = $self->SUPER::to_api( $args );
869 my $biblioitem = $self->biblioitem->to_api;
871 return { %$response, %$biblioitem };
874 =head3 to_api_mapping
876 This method returns the mapping for representing a Koha::Biblio object
883 biblionumber => 'biblio_id',
884 frameworkcode => 'framework_id',
885 unititle => 'uniform_title',
886 seriestitle => 'series_title',
887 copyrightdate => 'copyright_date',
888 datecreated => 'creation_date'
894 $host = $biblio->get_marc_host;
896 ( $host, $relatedparts ) = $biblio->get_marc_host;
898 Returns host biblio record from MARC21 773 (undef if no 773 present).
899 It looks at the first 773 field with MARCorgCode or only a control
900 number. Complete $w or numeric part is used to search host record.
901 The optional parameter no_items triggers a check if $biblio has items.
902 If there are, the sub returns undef.
903 Called in list context, it also returns 773$g (related parts).
908 my ($self, $params) = @_;
909 my $no_items = $params->{no_items};
910 return if C4::Context->preference('marcflavour') eq 'UNIMARC'; # TODO
911 return if $params->{no_items} && $self->items->count > 0;
914 eval { $record = $self->metadata->record };
917 # We pick the first $w with your MARCOrgCode or the first $w that has no
918 # code (between parentheses) at all.
919 my $orgcode = C4::Context->preference('MARCOrgCode') // q{};
921 foreach my $f ( $record->field('773') ) {
922 my $w = $f->subfield('w') or next;
923 if( $w =~ /^\($orgcode\)\s*(\d+)/i or $w =~ /^\d+/ ) {
929 my $rcn = $hostfld->subfield('w');
931 # Look for control number with/without orgcode
932 my $engine = Koha::SearchEngine::Search->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
935 my ( $error, $results, $total_hits ) = $engine->simple_search_compat( 'Control-number='.$rcn, 0,1 );
936 if( !$error and $total_hits == 1 ) {
937 $bibno = $engine->extract_biblionumber( $results->[0] );
940 # Add or remove orgcode for second try
941 if( $try == 1 && $rcn =~ /\)\s*(\d+)/ ) {
942 $rcn = $1; # number only
943 } elsif( $try == 1 && $rcn =~ /^\d+/ ) {
944 $rcn = "($orgcode)$rcn";
950 my $host = Koha::Biblios->find($bibno) or return;
951 return wantarray ? ( $host, $hostfld->subfield('g') ) : $host;
955 =head2 Internal methods
967 Kyle M Hall <kyle@bywatersolutions.com>