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::ArticleRequests;
35 use Koha::Biblio::Metadatas;
36 use Koha::Biblio::ItemGroups;
37 use Koha::Biblioitems;
38 use Koha::Cache::Memory::Lite;
40 use Koha::CirculationRules;
42 use Koha::Illrequests;
43 use Koha::Item::Transfer::Limits;
46 use Koha::Old::Checkouts;
48 use Koha::RecordProcessor;
49 use Koha::Suggestions;
50 use Koha::Subscriptions;
51 use Koha::SearchEngine;
52 use Koha::SearchEngine::Search;
53 use Koha::SearchEngine::QueryBuilder;
58 Koha::Biblio - Koha Biblio Object class
68 Overloaded I<store> method to set default values
75 $self->datecreated( dt_from_string ) unless $self->datecreated;
77 return $self->SUPER::store;
82 my $metadata = $biblio->metadata();
84 Returns a Koha::Biblio::Metadata object
91 my $metadata = $self->_result->metadata;
92 return Koha::Biblio::Metadata->_new_from_dbic($metadata);
97 my $record = $biblio->record();
99 Returns a Marc::Record object
106 return $self->metadata->record;
111 my $schema = $biblio->record_schema();
113 Returns the record schema (MARC21, USMARC or UNIMARC).
120 return $self->metadata->schema // C4::Context->preference("marcflavour");
125 my $orders = $biblio->orders();
127 Returns a Koha::Acquisition::Orders object
134 my $orders = $self->_result->orders;
135 return Koha::Acquisition::Orders->_new_from_dbic($orders);
140 my $active_orders = $biblio->active_orders();
142 Returns the active acquisition orders related to this biblio.
143 An order is considered active when it is not cancelled (i.e. when datecancellation
151 return $self->orders->search({ datecancellationprinted => undef });
156 my $tickets = $biblio->tickets();
158 Returns all tickets linked to the biblio
164 my $rs = $self->_result->tickets;
165 return Koha::Tickets->_new_from_dbic( $rs );
170 my $ill_requests = $biblio->ill_requests();
172 Returns a Koha::Illrequests object
179 my $ill_requests = $self->_result->ill_requests;
180 return Koha::Illrequests->_new_from_dbic($ill_requests);
185 my $item_groups = $biblio->item_groups();
187 Returns a Koha::Biblio::ItemGroups object
194 my $item_groups = $self->_result->item_groups;
195 return Koha::Biblio::ItemGroups->_new_from_dbic($item_groups);
198 =head3 can_article_request
200 my $bool = $biblio->can_article_request( $borrower );
202 Returns true if article requests can be made for this record
204 $borrower must be a Koha::Patron object
208 sub can_article_request {
209 my ( $self, $borrower ) = @_;
211 my $rule = $self->article_request_type($borrower);
212 return q{} if $rule eq 'item_only' && !$self->items()->count();
213 return 1 if $rule && $rule ne 'no';
218 =head3 can_be_transferred
220 $biblio->can_be_transferred({ to => $to_library, from => $from_library })
222 Checks if at least one item of a biblio can be transferred to given library.
224 This feature is controlled by two system preferences:
225 UseBranchTransferLimits to enable / disable the feature
226 BranchTransferLimitsType to use either an itemnumber or ccode as an identifier
227 for setting the limitations
229 Performance-wise, it is recommended to use this method for a biblio instead of
230 iterating each item of a biblio with Koha::Item->can_be_transferred().
232 Takes HASHref that can have the following parameters:
233 MANDATORY PARAMETERS:
236 $from : Koha::Library # if given, only items from that
237 # holdingbranch are considered
239 Returns 1 if at least one of the item of a biblio can be transferred
240 to $to_library, otherwise 0.
244 sub can_be_transferred {
245 my ($self, $params) = @_;
247 my $to = $params->{to};
248 my $from = $params->{from};
250 return 1 unless C4::Context->preference('UseBranchTransferLimits');
251 my $limittype = C4::Context->preference('BranchTransferLimitsType');
254 foreach my $item_of_bib ($self->items->as_list) {
255 next unless $item_of_bib->holdingbranch;
256 next if $from && $from->branchcode ne $item_of_bib->holdingbranch;
257 return 1 if $item_of_bib->holdingbranch eq $to->branchcode;
258 my $code = $limittype eq 'itemtype'
259 ? $item_of_bib->effective_itemtype
260 : $item_of_bib->ccode;
261 return 1 unless $code;
262 $items->{$code}->{$item_of_bib->holdingbranch} = 1;
265 # At this point we will have a HASHref containing each itemtype/ccode that
266 # this biblio has, inside which are all of the holdingbranches where those
267 # items are located at. Then, we will query Koha::Item::Transfer::Limits to
268 # find out whether a transfer limits for such $limittype from any of the
269 # listed holdingbranches to the given $to library exist. If at least one
270 # holdingbranch for that $limittype does not have a transfer limit to given
271 # $to library, then we know that the transfer is possible.
272 foreach my $code (keys %{$items}) {
273 my @holdingbranches = keys %{$items->{$code}};
274 return 1 if Koha::Item::Transfer::Limits->search({
275 toBranch => $to->branchcode,
276 fromBranch => { 'in' => \@holdingbranches },
279 group_by => [qw/fromBranch/]
280 })->count == scalar(@holdingbranches) ? 0 : 1;
287 =head3 pickup_locations
289 my $pickup_locations = $biblio->pickup_locations({ patron => $patron });
291 Returns a Koha::Libraries set of possible pickup locations for this biblio's items,
292 according to patron's home library and if item can be transferred to each pickup location.
294 Throws a I<Koha::Exceptions::MissingParameter> exception if the B<mandatory> parameter I<patron>
299 sub pickup_locations {
300 my ( $self, $params ) = @_;
302 Koha::Exceptions::MissingParameter->throw( parameter => 'patron' )
303 unless exists $params->{patron};
305 my $patron = $params->{patron};
307 my $memory_cache = Koha::Cache::Memory::Lite->get_instance();
308 my @pickup_locations;
309 foreach my $item ( $self->items->as_list ) {
310 my $cache_key = sprintf "Pickup_locations:%s:%s:%s:%s:%s",
311 $item->itype,$item->homebranch,$item->holdingbranch,$item->ccode || "",$patron->branchcode||"" ;
312 my $item_pickup_locations = $memory_cache->get_from_cache( $cache_key );
313 unless( $item_pickup_locations ){
314 @{ $item_pickup_locations } = $item->pickup_locations( { patron => $patron } )->_resultset->get_column('branchcode')->all;
315 $memory_cache->set_in_cache( $cache_key, $item_pickup_locations );
317 push @pickup_locations, @{ $item_pickup_locations }
320 return Koha::Libraries->search(
321 { branchcode => { '-in' => \@pickup_locations } }, { order_by => ['branchname'] } );
324 =head3 hidden_in_opac
326 my $bool = $biblio->hidden_in_opac({ [ rules => $rules ] })
328 Returns true if the biblio matches the hidding criteria defined in $rules.
329 Returns false otherwise. It involves the I<OpacHiddenItems> and
330 I<OpacHiddenItemsHidesRecord> system preferences.
332 Takes HASHref that can have the following parameters:
334 $rules : { <field> => [ value_1, ... ], ... }
336 Note: $rules inherits its structure from the parsed YAML from reading
337 the I<OpacHiddenItems> system preference.
342 my ( $self, $params ) = @_;
344 my $rules = $params->{rules} // {};
346 my @items = $self->items->as_list;
348 return 0 unless @items; # Do not hide if there is no item
350 # Ok, there are items, don't even try the rules unless OpacHiddenItemsHidesRecord
351 return 0 unless C4::Context->preference('OpacHiddenItemsHidesRecord');
353 return !(any { !$_->hidden_in_opac({ rules => $rules }) } @items);
356 =head3 article_request_type
358 my $type = $biblio->article_request_type( $borrower );
360 Returns the article request type based on items, or on the record
361 itself if there are no items.
363 $borrower must be a Koha::Patron object
367 sub article_request_type {
368 my ( $self, $borrower ) = @_;
370 return q{} unless $borrower;
372 my $rule = $self->article_request_type_for_items( $borrower );
373 return $rule if $rule;
375 # If the record has no items that are requestable, go by the record itemtype
376 $rule = $self->article_request_type_for_bib($borrower);
377 return $rule if $rule;
382 =head3 article_request_type_for_bib
384 my $type = $biblio->article_request_type_for_bib
386 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record
390 sub article_request_type_for_bib {
391 my ( $self, $borrower ) = @_;
393 return q{} unless $borrower;
395 my $borrowertype = $borrower->categorycode;
396 my $itemtype = $self->itemtype();
398 my $rule = Koha::CirculationRules->get_effective_rule(
400 rule_name => 'article_requests',
401 categorycode => $borrowertype,
402 itemtype => $itemtype,
406 return q{} unless $rule;
407 return $rule->rule_value || q{}
410 =head3 article_request_type_for_items
412 my $type = $biblio->article_request_type_for_items
414 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record's items
416 If there is a conflict where some items are 'bib_only' and some are 'item_only', 'bib_only' will be returned.
420 sub article_request_type_for_items {
421 my ( $self, $borrower ) = @_;
424 foreach my $item ( $self->items()->as_list() ) {
425 my $rule = $item->article_request_type($borrower);
426 return $rule if $rule eq 'bib_only'; # we don't need to go any further
430 return 'item_only' if $counts->{item_only};
431 return 'yes' if $counts->{yes};
432 return 'no' if $counts->{no};
436 =head3 article_requests
438 my $article_requests = $biblio->article_requests
440 Returns the article requests associated with this biblio
444 sub article_requests {
447 return Koha::ArticleRequests->_new_from_dbic( scalar $self->_result->article_requests );
450 =head3 current_checkouts
452 my $current_checkouts = $biblio->current_checkouts
454 Returns the current checkouts associated with this biblio
458 sub current_checkouts {
461 return Koha::Checkouts->search( { "item.biblionumber" => $self->id },
462 { join => 'item' } );
467 my $old_checkouts = $biblio->old_checkouts
469 Returns the past checkouts associated with this biblio
476 return Koha::Old::Checkouts->search( { "item.biblionumber" => $self->id },
477 { join => 'item' } );
482 my $items = $biblio->items();
484 Returns the related Koha::Items object for this biblio
491 my $items_rs = $self->_result->items;
493 return Koha::Items->_new_from_dbic( $items_rs );
498 my $host_items = $biblio->host_items();
500 Return the host items (easy analytical record)
507 return Koha::Items->new->empty
508 unless C4::Context->preference('EasyAnalyticalRecords');
510 my $marcflavour = C4::Context->preference("marcflavour");
511 my $analyticfield = '773';
512 if ( $marcflavour eq 'MARC21' ) {
513 $analyticfield = '773';
515 elsif ( $marcflavour eq 'UNIMARC' ) {
516 $analyticfield = '461';
518 my $marc_record = $self->metadata->record;
520 foreach my $field ( $marc_record->field($analyticfield) ) {
521 push @itemnumbers, $field->subfield('9');
524 return Koha::Items->search( { itemnumber => { -in => \@itemnumbers } } );
529 my $itemtype = $biblio->itemtype();
531 Returns the itemtype for this record.
538 return $self->biblioitem()->itemtype();
543 my $holds = $biblio->holds();
545 return the current holds placed on this record
550 my ( $self, $params, $attributes ) = @_;
551 $attributes->{order_by} = 'priority' unless exists $attributes->{order_by};
552 my $hold_rs = $self->_result->reserves->search( $params, $attributes );
553 return Koha::Holds->_new_from_dbic($hold_rs);
558 my $holds = $biblio->current_holds
560 Return the holds placed on this bibliographic record.
561 It does not include future holds.
567 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
569 { reservedate => { '<=' => $dtf->format_date(dt_from_string) } } );
574 my $field = $self->biblioitem
576 Returns the related Koha::Biblioitem object for this Biblio object
582 return Koha::Biblioitems->find( { biblionumber => $self->biblionumber } );
587 my $suggestions = $self->suggestions
589 Returns the related Koha::Suggestions object for this Biblio object
596 my $suggestions_rs = $self->_result->suggestions;
597 return Koha::Suggestions->_new_from_dbic( $suggestions_rs );
600 =head3 get_marc_components
602 my $components = $self->get_marc_components();
604 Returns an array of search results data, which are component parts of
605 this object (MARC21 773 points to this)
609 sub get_marc_components {
610 my ($self, $max_results) = @_;
612 return [] if (C4::Context->preference('marcflavour') ne 'MARC21');
614 my ( $searchstr, $sort ) = $self->get_components_query;
617 if (defined($searchstr)) {
618 my $searcher = Koha::SearchEngine::Search->new({index => $Koha::SearchEngine::BIBLIOS_INDEX});
619 my ( $error, $results, $facets );
621 ( $error, $results, $facets ) = $searcher->search_compat( $searchstr, undef, [$sort], ['biblioserver'], $max_results, 0, undef, undef, 'ccl', 0 );
626 warn "Warning from search_compat: '$error'";
630 message => 'component_search',
635 $components = $results->{biblioserver}->{RECORDS} if defined($results) && $results->{biblioserver}->{hits};
638 return $components // [];
641 =head2 get_components_query
643 Returns a query which can be used to search for all component parts of MARC21 biblios
647 sub get_components_query {
650 my $builder = Koha::SearchEngine::QueryBuilder->new(
651 { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
652 my $marc = $self->metadata->record;
653 my $component_sort_field = C4::Context->preference('ComponentSortField') // "title";
654 my $component_sort_order = C4::Context->preference('ComponentSortOrder') // "asc";
655 my $sort = $component_sort_field . "_" . $component_sort_order;
658 if ( C4::Context->preference('UseControlNumber') ) {
659 my $pf001 = $marc->field('001') || undef;
661 if ( defined($pf001) ) {
663 my $pf003 = $marc->field('003') || undef;
665 if ( !defined($pf003) ) {
666 # search for 773$w='Host001'
667 $searchstr .= "rcn:\"" . $pf001->data()."\"";
671 # search for (773$w='Host001' and 003='Host003') or 773$w='(Host003)Host001'
672 $searchstr .= "(rcn:\"" . $pf001->data() . "\" AND cni:\"" . $pf003->data() . "\")";
673 $searchstr .= " OR rcn:\"" . $pf003->data() . " " . $pf001->data() . "\"";
677 # limit to monograph and serial component part records
678 $searchstr .= " AND (bib-level:a OR bib-level:b)";
683 my $cleaned_title = $marc->subfield('245', "a");
684 $cleaned_title =~ tr|/||;
685 $cleaned_title = $builder->clean_search_term($cleaned_title);
686 $searchstr = qq#Host-item:("$cleaned_title")#;
688 my ($error, $query ,$query_str) = $builder->build_query_compat( undef, [$searchstr], undef, undef, [$sort], 0 );
694 return ($query, $query_str, $sort);
699 my $subscriptions = $self->subscriptions
701 Returns the related Koha::Subscriptions object for this Biblio object
707 my $rs = $self->_result->subscriptions;
708 return Koha::Subscriptions->_new_from_dbic($rs);
711 =head3 has_items_waiting_or_intransit
713 my $itemsWaitingOrInTransit = $biblio->has_items_waiting_or_intransit
715 Tells if this bibliographic record has items waiting or in transit.
719 sub has_items_waiting_or_intransit {
722 if ( Koha::Holds->search({ biblionumber => $self->id,
723 found => ['W', 'T'] })->count ) {
727 foreach my $item ( $self->items->as_list ) {
728 return 1 if $item->get_transfer;
736 my $coins = $biblio->get_coins;
738 Returns the COinS (a span) which can be included in a biblio record
745 my $record = $self->metadata->record;
747 my $pos7 = substr $record->leader(), 7, 1;
748 my $pos6 = substr $record->leader(), 6, 1;
751 my ( $aulast, $aufirst ) = ( '', '' );
762 # For the purposes of generating COinS metadata, LDR/06-07 can be
763 # considered the same for UNIMARC and MARC21
772 'i' => 'audioRecording',
773 'j' => 'audioRecording',
776 'm' => 'computerProgram',
781 'a' => 'journalArticle',
785 $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
787 if ( $genre eq 'book' ) {
788 $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
791 ##### We must transform mtx to a valable mtx and document type ####
792 if ( $genre eq 'book' ) {
795 } elsif ( $genre eq 'journal' ) {
798 } elsif ( $genre eq 'journalArticle' ) {
806 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
809 $aulast = $record->subfield( '700', 'a' ) || '';
810 $aufirst = $record->subfield( '700', 'b' ) || '';
811 push @authors, "$aufirst $aulast" if ($aufirst or $aulast);
814 if ( $record->field('200') ) {
815 for my $au ( $record->field('200')->subfield('g') ) {
820 $title = $record->subfield( '200', 'a' );
821 my $subfield_210d = $record->subfield('210', 'd');
822 if ($subfield_210d and $subfield_210d =~ /(\d{4})/) {
825 $publisher = $record->subfield( '210', 'c' ) || '';
826 $isbn = $record->subfield( '010', 'a' ) || '';
827 $issn = $record->subfield( '011', 'a' ) || '';
830 # MARC21 need some improve
833 if ( $record->field('100') ) {
834 push @authors, $record->subfield( '100', 'a' );
838 if ( $record->field('700') ) {
839 for my $au ( $record->field('700')->subfield('a') ) {
843 $title = $record->field('245');
844 $title &&= $title->as_string('ab');
845 if ($titletype eq 'a') {
846 $pubyear = $record->field('008') || '';
847 $pubyear = substr($pubyear->data(), 7, 4) if $pubyear;
848 $isbn = $record->subfield( '773', 'z' ) || '';
849 $issn = $record->subfield( '773', 'x' ) || '';
850 $hosttitle = $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{};
851 my @rels = $record->subfield( '773', 'g' );
852 $pages = join(', ', @rels);
854 $pubyear = $record->subfield( '260', 'c' ) || '';
855 $publisher = $record->subfield( '260', 'b' ) || '';
856 $isbn = $record->subfield( '020', 'a' ) || '';
857 $issn = $record->subfield( '022', 'a' ) || '';
863 [ 'ctx_ver', 'Z39.88-2004' ],
864 [ 'rft_val_fmt', "info:ofi/fmt:kev:mtx:$mtx" ],
865 [ ($mtx eq 'dc' ? 'rft.type' : 'rft.genre'), $genre ],
866 [ "rft.${titletype}title", $title ],
869 # rft.title is authorized only once, so by checking $titletype
870 # we ensure that rft.title is not already in the list.
871 if ($hosttitle and $titletype) {
872 push @params, [ 'rft.title', $hosttitle ];
876 [ 'rft.isbn', $isbn ],
877 [ 'rft.issn', $issn ],
880 # If it's a subscription, these informations have no meaning.
881 if ($genre ne 'journal') {
883 [ 'rft.aulast', $aulast ],
884 [ 'rft.aufirst', $aufirst ],
885 (map { [ 'rft.au', $_ ] } @authors),
886 [ 'rft.pub', $publisher ],
887 [ 'rft.date', $pubyear ],
888 [ 'rft.pages', $pages ],
892 my $coins_value = join( '&',
893 map { $$_[1] ? $$_[0] . '=' . uri_escape_utf8( $$_[1] ) : () } @params );
900 my $url = $biblio->get_openurl;
902 Returns url for OpenURL resolver set in OpenURLResolverURL system preference
909 my $OpenURLResolverURL = C4::Context->preference('OpenURLResolverURL');
911 if ($OpenURLResolverURL) {
912 my $uri = URI->new($OpenURLResolverURL);
914 if (not defined $uri->query) {
915 $OpenURLResolverURL .= '?';
917 $OpenURLResolverURL .= '&';
919 $OpenURLResolverURL .= $self->get_coins;
922 return $OpenURLResolverURL;
927 my $serial = $biblio->is_serial
929 Return boolean true if this bibbliographic record is continuing resource
936 return 1 if $self->serial;
938 my $record = $self->metadata->record;
939 return 1 if substr($record->leader, 7, 1) eq 's';
944 =head3 custom_cover_image_url
946 my $image_url = $biblio->custom_cover_image_url
948 Return the specific url of the cover image for this bibliographic record.
949 It is built regaring the value of the system preference CustomCoverImagesURL
953 sub custom_cover_image_url {
955 my $url = C4::Context->preference('CustomCoverImagesURL');
956 if ( $url =~ m|{isbn}| ) {
957 my $isbn = $self->biblioitem->isbn;
959 $url =~ s|{isbn}|$isbn|g;
961 if ( $url =~ m|{normalized_isbn}| ) {
962 my $normalized_isbn = C4::Koha::GetNormalizedISBN($self->biblioitem->isbn);
963 return unless $normalized_isbn;
964 $url =~ s|{normalized_isbn}|$normalized_isbn|g;
966 if ( $url =~ m|{issn}| ) {
967 my $issn = $self->biblioitem->issn;
969 $url =~ s|{issn}|$issn|g;
972 my $re = qr|{(?<field>\d{3})(\$(?<subfield>.))?}|;
974 my $field = $+{field};
975 my $subfield = $+{subfield};
976 my $marc_record = $self->metadata->record;
979 $value = $marc_record->subfield( $field, $subfield );
981 my $controlfield = $marc_record->field($field);
982 $value = $controlfield->data() if $controlfield;
984 return unless $value;
985 $url =~ s|$re|$value|;
993 Return the cover images associated with this biblio.
1000 my $cover_images_rs = $self->_result->cover_images;
1001 return unless $cover_images_rs;
1002 return Koha::CoverImages->_new_from_dbic($cover_images_rs);
1005 =head3 get_marc_notes
1007 $marcnotesarray = $biblio->get_marc_notes({ opac => 1 });
1009 Get all notes from the MARC record and returns them in an array.
1010 The notes are stored in different fields depending on MARC flavour.
1011 MARC21 5XX $u subfields receive special attention as they are URIs.
1015 sub get_marc_notes {
1016 my ( $self, $params ) = @_;
1018 my $marcflavour = C4::Context->preference('marcflavour');
1019 my $opac = $params->{opac} // '0';
1020 my $interface = $params->{opac} ? 'opac' : 'intranet';
1022 my $record = $params->{record} // $self->metadata->record;
1023 my $record_processor = Koha::RecordProcessor->new(
1025 filters => [ 'ViewPolicy', 'ExpandCodedFields' ],
1027 interface => $interface,
1028 frameworkcode => $self->frameworkcode
1032 $record_processor->process($record);
1034 my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
1035 #MARC21 specs indicate some notes should be private if first indicator 0
1036 my %maybe_private = (
1044 my %hiddenlist = map { $_ => 1 }
1045 split( /,/, C4::Context->preference('NotesToHide'));
1048 foreach my $field ( $record->field($scope) ) {
1049 my $tag = $field->tag();
1050 next if $hiddenlist{ $tag };
1051 next if $opac && $maybe_private{$tag} && !$field->indicator(1);
1052 if( $marcflavour ne 'UNIMARC' && $field->subfield('u') ) {
1053 # Field 5XX$u always contains URI
1054 # Examples: 505u, 506u, 510u, 514u, 520u, 530u, 538u, 540u, 542u, 552u, 555u, 561u, 563u, 583u
1055 # We first push the other subfields, then all $u's separately
1056 # Leave further actions to the template (see e.g. opac-detail)
1058 join '', ( 'a' .. 't', 'v' .. 'z', '0' .. '9' ); # excl 'u'
1059 push @marcnotes, { marcnote => $field->as_string($othersub) };
1060 foreach my $sub ( $field->subfield('u') ) {
1061 $sub =~ s/^\s+|\s+$//g; # trim
1062 push @marcnotes, { marcnote => $sub };
1065 push @marcnotes, { marcnote => $field->as_string() };
1071 =head3 _get_marc_authors
1073 Private method to return the list of authors contained in the MARC record.
1074 See get get_marc_contributors and get_marc_authors for the public methods.
1078 sub _get_marc_authors {
1079 my ( $self, $params ) = @_;
1081 my $fields_filter = $params->{fields_filter};
1082 my $mintag = $params->{mintag};
1083 my $maxtag = $params->{maxtag};
1085 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1086 my $marcflavour = C4::Context->preference('marcflavour');
1088 # tagslib useful only for UNIMARC author responsibilities
1089 my $tagslib = $marcflavour eq "UNIMARC"
1090 ? C4::Biblio::GetMarcStructure( 1, $self->frameworkcode, { unsafe => 1 } )
1094 foreach my $field ( $self->metadata->record->field($fields_filter) ) {
1097 if $mintag && $field->tag() < $mintag
1098 || $maxtag && $field->tag() > $maxtag;
1102 my @subfields = $field->subfields();
1105 # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1106 my $subfield9 = $field->subfield('9');
1108 my $linkvalue = $subfield9;
1109 $linkvalue =~ s/(\(|\))//g;
1110 @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1115 for my $authors_subfield (@subfields) {
1116 next if ( $authors_subfield->[0] eq '9' );
1118 # unimarc3 contains the $3 of the author for UNIMARC.
1119 # For french academic libraries, it's the "ppn", and it's required for idref webservice
1120 $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1122 # don't load unimarc subfields 3, 5
1123 next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1125 my $code = $authors_subfield->[0];
1126 my $value = $authors_subfield->[1];
1127 my $linkvalue = $value;
1128 $linkvalue =~ s/(\(|\))//g;
1129 # UNIMARC author responsibility
1130 if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1131 $value = C4::Biblio::GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1132 $linkvalue = "($value)";
1134 # if no authority link, build a search query
1135 unless ($subfield9) {
1138 'link' => $linkvalue,
1139 operator => (scalar @link_loop) ? ' AND ' : undef
1142 my @this_link_loop = @link_loop;
1144 unless ( $code eq '0') {
1145 push @subfields_loop, {
1146 tag => $field->tag(),
1149 link_loop => \@this_link_loop,
1150 separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1154 push @marcauthors, {
1155 MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1156 authoritylink => $subfield9,
1157 unimarc3 => $unimarc3
1160 return \@marcauthors;
1163 =head3 get_marc_contributors
1165 my $contributors = $biblio->get_marc_contributors;
1167 Get all contributors (but first author) from the MARC record and returns them in an array.
1168 They are stored in different fields depending on MARC flavour (700..720 for MARC21)
1172 sub get_marc_contributors {
1173 my ( $self, $params ) = @_;
1175 my ( $mintag, $maxtag, $fields_filter );
1176 my $marcflavour = C4::Context->preference('marcflavour');
1178 if ( $marcflavour eq "UNIMARC" ) {
1181 $fields_filter = '7..';
1182 } else { # marc21/normarc
1185 $fields_filter = '7..';
1188 return $self->_get_marc_authors(
1190 fields_filter => $fields_filter,
1197 =head3 get_marc_authors
1199 my $authors = $biblio->get_marc_authors;
1201 Get all authors from the MARC record and returns them in an array.
1202 They are stored in different fields depending on MARC flavour
1203 (main author from 100 then secondary authors from 700..720).
1207 sub get_marc_authors {
1208 my ( $self, $params ) = @_;
1210 my ( $mintag, $maxtag, $fields_filter );
1211 my $marcflavour = C4::Context->preference('marcflavour');
1213 if ( $marcflavour eq "UNIMARC" ) {
1214 $fields_filter = '200';
1215 } else { # marc21/normarc
1216 $fields_filter = '100';
1219 my @first_authors = @{$self->_get_marc_authors(
1221 fields_filter => $fields_filter,
1227 my @other_authors = @{$self->get_marc_contributors};
1229 return [@first_authors, @other_authors];
1235 my $json = $biblio->to_api;
1237 Overloaded method that returns a JSON representation of the Koha::Biblio object,
1238 suitable for API output. The related Koha::Biblioitem object is merged as expected
1244 my ($self, $args) = @_;
1246 my $response = $self->SUPER::to_api( $args );
1247 my $biblioitem = $self->biblioitem->to_api;
1249 return { %$response, %$biblioitem };
1252 =head3 to_api_mapping
1254 This method returns the mapping for representing a Koha::Biblio object
1259 sub to_api_mapping {
1261 biblionumber => 'biblio_id',
1262 frameworkcode => 'framework_id',
1263 unititle => 'uniform_title',
1264 seriestitle => 'series_title',
1265 copyrightdate => 'copyright_date',
1266 datecreated => 'creation_date',
1267 deleted_on => undef,
1271 =head3 get_marc_host
1273 $host = $biblio->get_marc_host;
1275 ( $host, $relatedparts, $hostinfo ) = $biblio->get_marc_host;
1277 Returns host biblio record from MARC21 773 (undef if no 773 present).
1278 It looks at the first 773 field with MARCorgCode or only a control
1279 number. Complete $w or numeric part is used to search host record.
1280 The optional parameter no_items triggers a check if $biblio has items.
1281 If there are, the sub returns undef.
1282 Called in list context, it also returns 773$g (related parts).
1284 If there is no $w, we use $0 (host biblionumber) or $9 (host itemnumber)
1285 to search for the host record. If there is also no $0 and no $9, we search
1286 using author and title. Failing all of that, we return an undef host and
1287 form a concatenation of strings with 773$agt for host information,
1288 returned when called in list context.
1293 my ($self, $params) = @_;
1294 my $no_items = $params->{no_items};
1295 return if C4::Context->preference('marcflavour') eq 'UNIMARC'; # TODO
1296 return if $params->{no_items} && $self->items->count > 0;
1299 eval { $record = $self->metadata->record };
1302 # We pick the first $w with your MARCOrgCode or the first $w that has no
1303 # code (between parentheses) at all.
1304 my $orgcode = C4::Context->preference('MARCOrgCode') // q{};
1306 foreach my $f ( $record->field('773') ) {
1307 my $w = $f->subfield('w') or next;
1308 if( $w =~ /^\($orgcode\)\s*(\d+)/i or $w =~ /^\d+/ ) {
1314 my $engine = Koha::SearchEngine::Search->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
1316 if ( !$hostfld and $record->subfield('773','t') ) {
1317 # not linked using $w
1318 my $unlinkedf = $record->field('773');
1320 if ( C4::Context->preference("EasyAnalyticalRecords") ) {
1321 if ( $unlinkedf->subfield('0') ) {
1322 # use 773$0 host biblionumber
1323 $bibno = $unlinkedf->subfield('0');
1324 } elsif ( $unlinkedf->subfield('9') ) {
1325 # use 773$9 host itemnumber
1326 my $linkeditemnumber = $unlinkedf->subfield('9');
1327 $bibno = Koha::Items->find( $linkeditemnumber )->biblionumber;
1331 my $host = Koha::Biblios->find($bibno) or return;
1332 return wantarray ? ( $host, $unlinkedf->subfield('g') ) : $host;
1334 # just return plaintext and no host record
1335 my $hostinfo = join( ", ", $unlinkedf->subfield('a'), $unlinkedf->subfield('t'), $unlinkedf->subfield('g') );
1336 return wantarray ? ( undef, $unlinkedf->subfield('g'), $hostinfo ) : undef;
1338 return if !$hostfld;
1339 my $rcn = $hostfld->subfield('w');
1341 # Look for control number with/without orgcode
1342 for my $try (1..2) {
1343 my ( $error, $results, $total_hits ) = $engine->simple_search_compat( 'Control-number='.$rcn, 0,1 );
1344 if( !$error and $total_hits == 1 ) {
1345 $bibno = $engine->extract_biblionumber( $results->[0] );
1348 # Add or remove orgcode for second try
1349 if( $try == 1 && $rcn =~ /\)\s*(\d+)/ ) {
1350 $rcn = $1; # number only
1351 } elsif( $try == 1 && $rcn =~ /^\d+/ ) {
1352 $rcn = "($orgcode)$rcn";
1358 my $host = Koha::Biblios->find($bibno) or return;
1359 return wantarray ? ( $host, $hostfld->subfield('g') ) : $host;
1363 =head3 get_marc_host_only
1365 my $host = $biblio->get_marc_host_only;
1371 sub get_marc_host_only {
1374 my ( $host ) = $self->get_marc_host;
1379 =head3 get_marc_relatedparts_only
1381 my $relatedparts = $biblio->get_marc_relatedparts_only;
1383 Return related parts only
1387 sub get_marc_relatedparts_only {
1390 my ( undef, $relatedparts ) = $self->get_marc_host;
1392 return $relatedparts;
1395 =head3 get_marc_hostinfo_only
1397 my $hostinfo = $biblio->get_marc_hostinfo_only;
1399 Return host info only
1403 sub get_marc_hostinfo_only {
1406 my ( $host, $relatedparts, $hostinfo ) = $self->get_marc_host;
1413 my $recalls = $biblio->recalls;
1415 Return recalls linked to this biblio
1421 return Koha::Recalls->_new_from_dbic( scalar $self->_result->recalls );
1424 =head3 can_be_recalled
1426 my @items_for_recall = $biblio->can_be_recalled({ patron => $patron_object });
1428 Does biblio-level checks and returns the items attached to this biblio that are available for recall
1432 sub can_be_recalled {
1433 my ( $self, $params ) = @_;
1435 return 0 if !( C4::Context->preference('UseRecalls') );
1437 my $patron = $params->{patron};
1439 my $branchcode = C4::Context->userenv->{'branch'};
1440 if ( C4::Context->preference('CircControl') eq 'PatronLibrary' and $patron ) {
1441 $branchcode = $patron->branchcode;
1444 my @all_items = Koha::Items->search({ biblionumber => $self->biblionumber })->as_list;
1446 # if there are no available items at all, no recall can be placed
1447 return 0 if ( scalar @all_items == 0 );
1452 my @all_itemnumbers;
1453 foreach my $item ( @all_items ) {
1454 push( @all_itemnumbers, $item->itemnumber );
1455 if ( $item->can_be_recalled({ patron => $patron }) ) {
1456 push( @itemtypes, $item->effective_itemtype );
1457 push( @itemnumbers, $item->itemnumber );
1458 push( @items, $item );
1462 # if there are no recallable items, no recall can be placed
1463 return 0 if ( scalar @items == 0 );
1465 # Check the circulation rule for each relevant itemtype for this biblio
1466 my ( @recalls_allowed, @recalls_per_record, @on_shelf_recalls );
1467 foreach my $itemtype ( @itemtypes ) {
1468 my $rule = Koha::CirculationRules->get_effective_rules({
1469 branchcode => $branchcode,
1470 categorycode => $patron ? $patron->categorycode : undef,
1471 itemtype => $itemtype,
1474 'recalls_per_record',
1478 push( @recalls_allowed, $rule->{recalls_allowed} ) if $rule;
1479 push( @recalls_per_record, $rule->{recalls_per_record} ) if $rule;
1480 push( @on_shelf_recalls, $rule->{on_shelf_recalls} ) if $rule;
1482 my $recalls_allowed = (sort {$b <=> $a} @recalls_allowed)[0]; # take highest
1483 my $recalls_per_record = (sort {$b <=> $a} @recalls_per_record)[0]; # take highest
1484 my %on_shelf_recalls_count = ();
1485 foreach my $count ( @on_shelf_recalls ) {
1486 $on_shelf_recalls_count{$count}++;
1488 my $on_shelf_recalls = (sort {$on_shelf_recalls_count{$b} <=> $on_shelf_recalls_count{$a}} @on_shelf_recalls)[0]; # take most common
1490 # check recalls allowed has been set and is not zero
1491 return 0 if ( !defined($recalls_allowed) || $recalls_allowed == 0 );
1494 # check borrower has not reached open recalls allowed limit
1495 return 0 if ( $patron->recalls->filter_by_current->count >= $recalls_allowed );
1497 # check borrower has not reached open recalls allowed per record limit
1498 return 0 if ( $patron->recalls->filter_by_current->search({ biblio_id => $self->biblionumber })->count >= $recalls_per_record );
1500 # check if any of the items under this biblio are already checked out by this borrower
1501 return 0 if ( Koha::Checkouts->search({ itemnumber => [ @all_itemnumbers ], borrowernumber => $patron->borrowernumber })->count > 0 );
1504 # check item availability
1505 my $checked_out_count = 0;
1507 if ( Koha::Checkouts->search({ itemnumber => $_->itemnumber })->count > 0 ){ $checked_out_count++; }
1510 # can't recall if on shelf recalls only allowed when all unavailable, but items are still available for checkout
1511 return 0 if ( $on_shelf_recalls eq 'all' && $checked_out_count < scalar @items );
1513 # can't recall if no items have been checked out
1514 return 0 if ( $checked_out_count == 0 );
1520 =head2 Internal methods
1532 Kyle M Hall <kyle@bywatersolutions.com>