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 );
27 use C4::XSLT qw( transformMARCXML4XSLT );
30 use Koha::DateUtils qw( dt_from_string );
32 use base qw(Koha::Object);
34 use Koha::Acquisition::Orders;
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;
44 use Koha::SearchEngine;
45 use Koha::SearchEngine::Search;
49 Koha::Biblio - Koha Biblio Object class
59 Overloaded I<store> method to set default values
66 $self->datecreated( dt_from_string ) unless $self->datecreated;
68 return $self->SUPER::store;
73 my $metadata = $biblio->metadata();
75 Returns a Koha::Biblio::Metadata object
82 my $metadata = $self->_result->metadata;
83 return Koha::Biblio::Metadata->_new_from_dbic($metadata);
88 my $orders = $biblio->orders();
90 Returns a Koha::Acquisition::Orders object
97 my $orders = $self->_result->orders;
98 return Koha::Acquisition::Orders->_new_from_dbic($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
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
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';
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:
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.
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');
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 },
198 group_by => [qw/fromBranch/]
199 })->count == scalar(@holdingbranches) ? 0 : 1;
206 =head3 pickup_locations
208 my $pickup_locations = $biblio->pickup_locations( {patron => $patron } );
210 Returns a Koha::Libraries set 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.
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,
224 $item_of_bib->pickup_locations( { patron => $patron } )
225 ->_resultset->get_column('branchcode')->all;
228 return Koha::Libraries->search(
229 { branchcode => { '-in' => \@pickup_locations } }, { order_by => ['branchname'] } );
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. It involves the I<OpacHiddenItems> and
238 I<OpacHiddenItemsHidesRecord> system preferences.
240 Takes HASHref that can have the following parameters:
242 $rules : { <field> => [ value_1, ... ], ... }
244 Note: $rules inherits its structure from the parsed YAML from reading
245 the I<OpacHiddenItems> system preference.
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 # Ok, there are items, don't even try the rules unless OpacHiddenItemsHidesRecord
259 return 0 unless C4::Context->preference('OpacHiddenItemsHidesRecord');
261 return !(any { !$_->hidden_in_opac({ rules => $rules }) } @items);
264 =head3 article_request_type
266 my $type = $biblio->article_request_type( $borrower );
268 Returns the article request type based on items, or on the record
269 itself if there are no items.
271 $borrower must be a Koha::Patron object
275 sub article_request_type {
276 my ( $self, $borrower ) = @_;
278 return q{} unless $borrower;
280 my $rule = $self->article_request_type_for_items( $borrower );
281 return $rule if $rule;
283 # If the record has no items that are requestable, go by the record itemtype
284 $rule = $self->article_request_type_for_bib($borrower);
285 return $rule if $rule;
290 =head3 article_request_type_for_bib
292 my $type = $biblio->article_request_type_for_bib
294 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record
298 sub article_request_type_for_bib {
299 my ( $self, $borrower ) = @_;
301 return q{} unless $borrower;
303 my $borrowertype = $borrower->categorycode;
304 my $itemtype = $self->itemtype();
306 my $rule = Koha::CirculationRules->get_effective_rule(
308 rule_name => 'article_requests',
309 categorycode => $borrowertype,
310 itemtype => $itemtype,
314 return q{} unless $rule;
315 return $rule->rule_value || q{}
318 =head3 article_request_type_for_items
320 my $type = $biblio->article_request_type_for_items
322 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record's items
324 If there is a conflict where some items are 'bib_only' and some are 'item_only', 'bib_only' will be returned.
328 sub article_request_type_for_items {
329 my ( $self, $borrower ) = @_;
332 foreach my $item ( $self->items()->as_list() ) {
333 my $rule = $item->article_request_type($borrower);
334 return $rule if $rule eq 'bib_only'; # we don't need to go any further
338 return 'item_only' if $counts->{item_only};
339 return 'yes' if $counts->{yes};
340 return 'no' if $counts->{no};
344 =head3 article_requests
346 my $article_requests = $biblio->article_requests
348 Returns the article requests associated with this biblio
352 sub article_requests {
355 return Koha::ArticleRequests->_new_from_dbic( scalar $self->_result->article_requests );
360 my $items = $biblio->items();
362 Returns the related Koha::Items object for this biblio
369 my $items_rs = $self->_result->items;
371 return Koha::Items->_new_from_dbic( $items_rs );
376 my $host_items = $biblio->host_items();
378 Return the host items (easy analytical record)
385 return Koha::Items->new->empty
386 unless C4::Context->preference('EasyAnalyticalRecords');
388 my $marcflavour = C4::Context->preference("marcflavour");
389 my $analyticfield = '773';
390 if ( $marcflavour eq 'MARC21' ) {
391 $analyticfield = '773';
393 elsif ( $marcflavour eq 'UNIMARC' ) {
394 $analyticfield = '461';
396 my $marc_record = $self->metadata->record;
398 foreach my $field ( $marc_record->field($analyticfield) ) {
399 push @itemnumbers, $field->subfield('9');
402 return Koha::Items->search( { itemnumber => { -in => \@itemnumbers } } );
407 my $itemtype = $biblio->itemtype();
409 Returns the itemtype for this record.
416 return $self->biblioitem()->itemtype();
421 my $holds = $biblio->holds();
423 return the current holds placed on this record
428 my ( $self, $params, $attributes ) = @_;
429 $attributes->{order_by} = 'priority' unless exists $attributes->{order_by};
430 my $hold_rs = $self->_result->reserves->search( $params, $attributes );
431 return Koha::Holds->_new_from_dbic($hold_rs);
436 my $holds = $biblio->current_holds
438 Return the holds placed on this bibliographic record.
439 It does not include future holds.
445 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
447 { reservedate => { '<=' => $dtf->format_date(dt_from_string) } } );
452 my $field = $self->biblioitem()->itemtype
454 Returns the related Koha::Biblioitem object for this Biblio object
461 $self->{_biblioitem} ||= Koha::Biblioitems->find( { biblionumber => $self->biblionumber() } );
463 return $self->{_biblioitem};
468 my $suggestions = $self->suggestions
470 Returns the related Koha::Suggestions object for this Biblio object
477 my $suggestions_rs = $self->_result->suggestions;
478 return Koha::Suggestions->_new_from_dbic( $suggestions_rs );
481 =head3 get_marc_components
483 my $components = $self->get_marc_components();
485 Returns an array of MARCXML data, which are component parts of
486 this object (MARC21 773$w points to this)
490 sub get_marc_components {
491 my ($self, $max_results) = @_;
493 return [] if (C4::Context->preference('marcflavour') ne 'MARC21');
495 my $searchstr = $self->get_components_query;
497 if (defined($searchstr)) {
498 my $searcher = Koha::SearchEngine::Search->new({index => $Koha::SearchEngine::BIBLIOS_INDEX});
499 my ( $errors, $results, $total_hits ) = $searcher->simple_search_compat( $searchstr, 0, $max_results );
500 $self->{_components} = $results if ( defined($results) && scalar(@$results) );
503 return $self->{_components} || [];
506 =head2 get_components_query
508 Returns a query which can be used to search for all component parts of MARC21 biblios
512 sub get_components_query {
515 my $marc = $self->metadata->record;
518 if ( C4::Context->preference('UseControlNumber') ) {
519 my $pf001 = $marc->field('001') || undef;
521 if ( defined($pf001) ) {
523 my $pf003 = $marc->field('003') || undef;
525 if ( !defined($pf003) ) {
526 # search for 773$w='Host001'
527 $searchstr .= "rcn:" . $pf001->data();
531 # search for (773$w='Host001' and 003='Host003') or 773$w='(Host003)Host001'
532 $searchstr .= "(rcn:" . $pf001->data() . " AND cni:" . $pf003->data() . ")";
533 $searchstr .= " OR rcn:\"" . $pf003->data() . " " . $pf001->data() . "\"";
537 # limit to monograph and serial component part records
538 $searchstr .= " AND (bib-level:a OR bib-level:b)";
543 my $cleaned_title = $marc->title;
544 $cleaned_title =~ tr|/||;
545 $searchstr = "Host-item:($cleaned_title)";
553 my $subscriptions = $self->subscriptions
555 Returns the related Koha::Subscriptions object for this Biblio object
562 $self->{_subscriptions} ||= Koha::Subscriptions->search( { biblionumber => $self->biblionumber } );
564 return $self->{_subscriptions};
567 =head3 has_items_waiting_or_intransit
569 my $itemsWaitingOrInTransit = $biblio->has_items_waiting_or_intransit
571 Tells if this bibliographic record has items waiting or in transit.
575 sub has_items_waiting_or_intransit {
578 if ( Koha::Holds->search({ biblionumber => $self->id,
579 found => ['W', 'T'] })->count ) {
583 foreach my $item ( $self->items->as_list ) {
584 return 1 if $item->get_transfer;
592 my $coins = $biblio->get_coins;
594 Returns the COinS (a span) which can be included in a biblio record
601 my $record = $self->metadata->record;
603 my $pos7 = substr $record->leader(), 7, 1;
604 my $pos6 = substr $record->leader(), 6, 1;
607 my ( $aulast, $aufirst ) = ( '', '' );
618 # For the purposes of generating COinS metadata, LDR/06-07 can be
619 # considered the same for UNIMARC and MARC21
628 'i' => 'audioRecording',
629 'j' => 'audioRecording',
632 'm' => 'computerProgram',
637 'a' => 'journalArticle',
641 $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
643 if ( $genre eq 'book' ) {
644 $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
647 ##### We must transform mtx to a valable mtx and document type ####
648 if ( $genre eq 'book' ) {
651 } elsif ( $genre eq 'journal' ) {
654 } elsif ( $genre eq 'journalArticle' ) {
662 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
665 $aulast = $record->subfield( '700', 'a' ) || '';
666 $aufirst = $record->subfield( '700', 'b' ) || '';
667 push @authors, "$aufirst $aulast" if ($aufirst or $aulast);
670 if ( $record->field('200') ) {
671 for my $au ( $record->field('200')->subfield('g') ) {
676 $title = $record->subfield( '200', 'a' );
677 my $subfield_210d = $record->subfield('210', 'd');
678 if ($subfield_210d and $subfield_210d =~ /(\d{4})/) {
681 $publisher = $record->subfield( '210', 'c' ) || '';
682 $isbn = $record->subfield( '010', 'a' ) || '';
683 $issn = $record->subfield( '011', 'a' ) || '';
686 # MARC21 need some improve
689 if ( $record->field('100') ) {
690 push @authors, $record->subfield( '100', 'a' );
694 if ( $record->field('700') ) {
695 for my $au ( $record->field('700')->subfield('a') ) {
699 $title = $record->field('245');
700 $title &&= $title->as_string('ab');
701 if ($titletype eq 'a') {
702 $pubyear = $record->field('008') || '';
703 $pubyear = substr($pubyear->data(), 7, 4) if $pubyear;
704 $isbn = $record->subfield( '773', 'z' ) || '';
705 $issn = $record->subfield( '773', 'x' ) || '';
706 $hosttitle = $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{};
707 my @rels = $record->subfield( '773', 'g' );
708 $pages = join(', ', @rels);
710 $pubyear = $record->subfield( '260', 'c' ) || '';
711 $publisher = $record->subfield( '260', 'b' ) || '';
712 $isbn = $record->subfield( '020', 'a' ) || '';
713 $issn = $record->subfield( '022', 'a' ) || '';
719 [ 'ctx_ver', 'Z39.88-2004' ],
720 [ 'rft_val_fmt', "info:ofi/fmt:kev:mtx:$mtx" ],
721 [ ($mtx eq 'dc' ? 'rft.type' : 'rft.genre'), $genre ],
722 [ "rft.${titletype}title", $title ],
725 # rft.title is authorized only once, so by checking $titletype
726 # we ensure that rft.title is not already in the list.
727 if ($hosttitle and $titletype) {
728 push @params, [ 'rft.title', $hosttitle ];
732 [ 'rft.isbn', $isbn ],
733 [ 'rft.issn', $issn ],
736 # If it's a subscription, these informations have no meaning.
737 if ($genre ne 'journal') {
739 [ 'rft.aulast', $aulast ],
740 [ 'rft.aufirst', $aufirst ],
741 (map { [ 'rft.au', $_ ] } @authors),
742 [ 'rft.pub', $publisher ],
743 [ 'rft.date', $pubyear ],
744 [ 'rft.pages', $pages ],
748 my $coins_value = join( '&',
749 map { $$_[1] ? $$_[0] . '=' . uri_escape_utf8( $$_[1] ) : () } @params );
756 my $url = $biblio->get_openurl;
758 Returns url for OpenURL resolver set in OpenURLResolverURL system preference
765 my $OpenURLResolverURL = C4::Context->preference('OpenURLResolverURL');
767 if ($OpenURLResolverURL) {
768 my $uri = URI->new($OpenURLResolverURL);
770 if (not defined $uri->query) {
771 $OpenURLResolverURL .= '?';
773 $OpenURLResolverURL .= '&';
775 $OpenURLResolverURL .= $self->get_coins;
778 return $OpenURLResolverURL;
783 my $serial = $biblio->is_serial
785 Return boolean true if this bibbliographic record is continuing resource
792 return 1 if $self->serial;
794 my $record = $self->metadata->record;
795 return 1 if substr($record->leader, 7, 1) eq 's';
800 =head3 custom_cover_image_url
802 my $image_url = $biblio->custom_cover_image_url
804 Return the specific url of the cover image for this bibliographic record.
805 It is built regaring the value of the system preference CustomCoverImagesURL
809 sub custom_cover_image_url {
811 my $url = C4::Context->preference('CustomCoverImagesURL');
812 if ( $url =~ m|{isbn}| ) {
813 my $isbn = $self->biblioitem->isbn;
815 $url =~ s|{isbn}|$isbn|g;
817 if ( $url =~ m|{normalized_isbn}| ) {
818 my $normalized_isbn = C4::Koha::GetNormalizedISBN($self->biblioitem->isbn);
819 return unless $normalized_isbn;
820 $url =~ s|{normalized_isbn}|$normalized_isbn|g;
822 if ( $url =~ m|{issn}| ) {
823 my $issn = $self->biblioitem->issn;
825 $url =~ s|{issn}|$issn|g;
828 my $re = qr|{(?<field>\d{3})(\$(?<subfield>.))?}|;
830 my $field = $+{field};
831 my $subfield = $+{subfield};
832 my $marc_record = $self->metadata->record;
835 $value = $marc_record->subfield( $field, $subfield );
837 my $controlfield = $marc_record->field($field);
838 $value = $controlfield->data() if $controlfield;
840 return unless $value;
841 $url =~ s|$re|$value|;
849 Return the cover images associated with this biblio.
856 my $cover_images_rs = $self->_result->cover_images;
857 return unless $cover_images_rs;
858 return Koha::CoverImages->_new_from_dbic($cover_images_rs);
861 =head3 get_marc_notes
863 $marcnotesarray = $biblio->get_marc_notes({ marcflavour => $marcflavour });
865 Get all notes from the MARC record and returns them in an array.
866 The notes are stored in different fields depending on MARC flavour.
867 MARC21 5XX $u subfields receive special attention as they are URIs.
872 my ( $self, $params ) = @_;
874 my $marcflavour = $params->{marcflavour};
875 my $opac = $params->{opac};
877 my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
880 #MARC21 specs indicate some notes should be private if first indicator 0
881 my %maybe_private = (
889 my %hiddenlist = map { $_ => 1 }
890 split( /,/, C4::Context->preference('NotesToHide'));
891 my $record = $self->metadata->record;
892 $record = transformMARCXML4XSLT( $self->biblionumber, $record, $opac );
894 foreach my $field ( $record->field($scope) ) {
895 my $tag = $field->tag();
896 next if $hiddenlist{ $tag };
897 next if $opac && $maybe_private{$tag} && !$field->indicator(1);
898 if( $marcflavour ne 'UNIMARC' && $field->subfield('u') ) {
899 # Field 5XX$u always contains URI
900 # Examples: 505u, 506u, 510u, 514u, 520u, 530u, 538u, 540u, 542u, 552u, 555u, 561u, 563u, 583u
901 # We first push the other subfields, then all $u's separately
902 # Leave further actions to the template (see e.g. opac-detail)
904 join '', ( 'a' .. 't', 'v' .. 'z', '0' .. '9' ); # excl 'u'
905 push @marcnotes, { marcnote => $field->as_string($othersub) };
906 foreach my $sub ( $field->subfield('u') ) {
907 $sub =~ s/^\s+|\s+$//g; # trim
908 push @marcnotes, { marcnote => $sub };
911 push @marcnotes, { marcnote => $field->as_string() };
919 my $json = $biblio->to_api;
921 Overloaded method that returns a JSON representation of the Koha::Biblio object,
922 suitable for API output. The related Koha::Biblioitem object is merged as expected
928 my ($self, $args) = @_;
930 my $response = $self->SUPER::to_api( $args );
931 my $biblioitem = $self->biblioitem->to_api;
933 return { %$response, %$biblioitem };
936 =head3 to_api_mapping
938 This method returns the mapping for representing a Koha::Biblio object
945 biblionumber => 'biblio_id',
946 frameworkcode => 'framework_id',
947 unititle => 'uniform_title',
948 seriestitle => 'series_title',
949 copyrightdate => 'copyright_date',
950 datecreated => 'creation_date'
956 $host = $biblio->get_marc_host;
958 ( $host, $relatedparts ) = $biblio->get_marc_host;
960 Returns host biblio record from MARC21 773 (undef if no 773 present).
961 It looks at the first 773 field with MARCorgCode or only a control
962 number. Complete $w or numeric part is used to search host record.
963 The optional parameter no_items triggers a check if $biblio has items.
964 If there are, the sub returns undef.
965 Called in list context, it also returns 773$g (related parts).
970 my ($self, $params) = @_;
971 my $no_items = $params->{no_items};
972 return if C4::Context->preference('marcflavour') eq 'UNIMARC'; # TODO
973 return if $params->{no_items} && $self->items->count > 0;
976 eval { $record = $self->metadata->record };
979 # We pick the first $w with your MARCOrgCode or the first $w that has no
980 # code (between parentheses) at all.
981 my $orgcode = C4::Context->preference('MARCOrgCode') // q{};
983 foreach my $f ( $record->field('773') ) {
984 my $w = $f->subfield('w') or next;
985 if( $w =~ /^\($orgcode\)\s*(\d+)/i or $w =~ /^\d+/ ) {
991 my $rcn = $hostfld->subfield('w');
993 # Look for control number with/without orgcode
994 my $engine = Koha::SearchEngine::Search->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
997 my ( $error, $results, $total_hits ) = $engine->simple_search_compat( 'Control-number='.$rcn, 0,1 );
998 if( !$error and $total_hits == 1 ) {
999 $bibno = $engine->extract_biblionumber( $results->[0] );
1002 # Add or remove orgcode for second try
1003 if( $try == 1 && $rcn =~ /\)\s*(\d+)/ ) {
1004 $rcn = $1; # number only
1005 } elsif( $try == 1 && $rcn =~ /^\d+/ ) {
1006 $rcn = "($orgcode)$rcn";
1012 my $host = Koha::Biblios->find($bibno) or return;
1013 return wantarray ? ( $host, $hostfld->subfield('g') ) : $host;
1017 =head2 Internal methods
1029 Kyle M Hall <kyle@bywatersolutions.com>