Bug 33083: Add a generic class to handle methods for collections of records
[koha.git] / Koha / Biblio.pm
1 package Koha::Biblio;
2
3 # Copyright ByWater Solutions 2014
4 #
5 # This file is part of Koha.
6 #
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.
11 #
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.
16 #
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>.
19
20 use Modern::Perl;
21
22 use List::MoreUtils qw( any );
23 use URI;
24 use URI::Escape qw( uri_escape_utf8 );
25
26 use C4::Koha qw( GetNormalizedISBN );
27
28 use Koha::Database;
29 use Koha::DateUtils qw( dt_from_string );
30
31 use base qw(Koha::Object);
32
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::Checkouts;
39 use Koha::CirculationRules;
40 use Koha::Item::Transfer::Limits;
41 use Koha::Items;
42 use Koha::Libraries;
43 use Koha::Old::Checkouts;
44 use Koha::Recalls;
45 use Koha::RecordProcessor;
46 use Koha::Suggestions;
47 use Koha::Subscriptions;
48 use Koha::SearchEngine;
49 use Koha::SearchEngine::Search;
50 use Koha::SearchEngine::QueryBuilder;
51 use Koha::Tickets;
52
53 =head1 NAME
54
55 Koha::Biblio - Koha Biblio Object class
56
57 =head1 API
58
59 =head2 Class Methods
60
61 =cut
62
63 =head3 store
64
65 Overloaded I<store> method to set default values
66
67 =cut
68
69 sub store {
70     my ( $self ) = @_;
71
72     $self->datecreated( dt_from_string ) unless $self->datecreated;
73
74     return $self->SUPER::store;
75 }
76
77 =head3 metadata
78
79 my $metadata = $biblio->metadata();
80
81 Returns a Koha::Biblio::Metadata object
82
83 =cut
84
85 sub metadata {
86     my ( $self ) = @_;
87
88     my $metadata = $self->_result->metadata;
89     return Koha::Biblio::Metadata->_new_from_dbic($metadata);
90 }
91
92 =head3 record
93
94 my $record = $biblio->record();
95
96 Returns a Marc::Record object
97
98 =cut
99
100 sub record {
101     my ( $self ) = @_;
102
103     return $self->metadata->record;
104 }
105
106 =head3 orders
107
108 my $orders = $biblio->orders();
109
110 Returns a Koha::Acquisition::Orders object
111
112 =cut
113
114 sub orders {
115     my ( $self ) = @_;
116
117     my $orders = $self->_result->orders;
118     return Koha::Acquisition::Orders->_new_from_dbic($orders);
119 }
120
121 =head3 active_orders
122
123 my $active_orders = $biblio->active_orders();
124
125 Returns the active acquisition orders related to this biblio.
126 An order is considered active when it is not cancelled (i.e. when datecancellation
127 is not undef).
128
129 =cut
130
131 sub active_orders {
132     my ( $self ) = @_;
133
134     return $self->orders->search({ datecancellationprinted => undef });
135 }
136
137 =head3 tickets
138
139   my $tickets = $biblio->tickets();
140
141 Returns all tickets linked to the biblio
142
143 =cut
144
145 sub tickets {
146     my ( $self ) = @_;
147     my $rs = $self->_result->tickets;
148     return Koha::Tickets->_new_from_dbic( $rs );
149 }
150
151 =head3 item_groups
152
153 my $item_groups = $biblio->item_groups();
154
155 Returns a Koha::Biblio::ItemGroups object
156
157 =cut
158
159 sub item_groups {
160     my ( $self ) = @_;
161
162     my $item_groups = $self->_result->item_groups;
163     return Koha::Biblio::ItemGroups->_new_from_dbic($item_groups);
164 }
165
166 =head3 can_article_request
167
168 my $bool = $biblio->can_article_request( $borrower );
169
170 Returns true if article requests can be made for this record
171
172 $borrower must be a Koha::Patron object
173
174 =cut
175
176 sub can_article_request {
177     my ( $self, $borrower ) = @_;
178
179     my $rule = $self->article_request_type($borrower);
180     return q{} if $rule eq 'item_only' && !$self->items()->count();
181     return 1 if $rule && $rule ne 'no';
182
183     return q{};
184 }
185
186 =head3 can_be_transferred
187
188 $biblio->can_be_transferred({ to => $to_library, from => $from_library })
189
190 Checks if at least one item of a biblio can be transferred to given library.
191
192 This feature is controlled by two system preferences:
193 UseBranchTransferLimits to enable / disable the feature
194 BranchTransferLimitsType to use either an itemnumber or ccode as an identifier
195                          for setting the limitations
196
197 Performance-wise, it is recommended to use this method for a biblio instead of
198 iterating each item of a biblio with Koha::Item->can_be_transferred().
199
200 Takes HASHref that can have the following parameters:
201     MANDATORY PARAMETERS:
202     $to   : Koha::Library
203     OPTIONAL PARAMETERS:
204     $from : Koha::Library # if given, only items from that
205                           # holdingbranch are considered
206
207 Returns 1 if at least one of the item of a biblio can be transferred
208 to $to_library, otherwise 0.
209
210 =cut
211
212 sub can_be_transferred {
213     my ($self, $params) = @_;
214
215     my $to   = $params->{to};
216     my $from = $params->{from};
217
218     return 1 unless C4::Context->preference('UseBranchTransferLimits');
219     my $limittype = C4::Context->preference('BranchTransferLimitsType');
220
221     my $items;
222     foreach my $item_of_bib ($self->items->as_list) {
223         next unless $item_of_bib->holdingbranch;
224         next if $from && $from->branchcode ne $item_of_bib->holdingbranch;
225         return 1 if $item_of_bib->holdingbranch eq $to->branchcode;
226         my $code = $limittype eq 'itemtype'
227             ? $item_of_bib->effective_itemtype
228             : $item_of_bib->ccode;
229         return 1 unless $code;
230         $items->{$code}->{$item_of_bib->holdingbranch} = 1;
231     }
232
233     # At this point we will have a HASHref containing each itemtype/ccode that
234     # this biblio has, inside which are all of the holdingbranches where those
235     # items are located at. Then, we will query Koha::Item::Transfer::Limits to
236     # find out whether a transfer limits for such $limittype from any of the
237     # listed holdingbranches to the given $to library exist. If at least one
238     # holdingbranch for that $limittype does not have a transfer limit to given
239     # $to library, then we know that the transfer is possible.
240     foreach my $code (keys %{$items}) {
241         my @holdingbranches = keys %{$items->{$code}};
242         return 1 if Koha::Item::Transfer::Limits->search({
243             toBranch => $to->branchcode,
244             fromBranch => { 'in' => \@holdingbranches },
245             $limittype => $code
246         }, {
247             group_by => [qw/fromBranch/]
248         })->count == scalar(@holdingbranches) ? 0 : 1;
249     }
250
251     return 0;
252 }
253
254
255 =head3 pickup_locations
256
257     my $pickup_locations = $biblio->pickup_locations( {patron => $patron } );
258
259 Returns a Koha::Libraries set of possible pickup locations for this biblio's items,
260 according to patron's home library (if patron is defined and holds are allowed
261 only from hold groups) and if item can be transferred to each pickup location.
262
263 =cut
264
265 sub pickup_locations {
266     my ( $self, $params ) = @_;
267
268     my $patron = $params->{patron};
269
270     my @pickup_locations;
271     foreach my $item_of_bib ( $self->items->as_list ) {
272         push @pickup_locations,
273           $item_of_bib->pickup_locations( { patron => $patron } )
274           ->_resultset->get_column('branchcode')->all;
275     }
276
277     return Koha::Libraries->search(
278         { branchcode => { '-in' => \@pickup_locations } }, { order_by => ['branchname'] } );
279 }
280
281 =head3 hidden_in_opac
282
283     my $bool = $biblio->hidden_in_opac({ [ rules => $rules ] })
284
285 Returns true if the biblio matches the hidding criteria defined in $rules.
286 Returns false otherwise. It involves the I<OpacHiddenItems> and
287 I<OpacHiddenItemsHidesRecord> system preferences.
288
289 Takes HASHref that can have the following parameters:
290     OPTIONAL PARAMETERS:
291     $rules : { <field> => [ value_1, ... ], ... }
292
293 Note: $rules inherits its structure from the parsed YAML from reading
294 the I<OpacHiddenItems> system preference.
295
296 =cut
297
298 sub hidden_in_opac {
299     my ( $self, $params ) = @_;
300
301     my $rules = $params->{rules} // {};
302
303     my @items = $self->items->as_list;
304
305     return 0 unless @items; # Do not hide if there is no item
306
307     # Ok, there are items, don't even try the rules unless OpacHiddenItemsHidesRecord
308     return 0 unless C4::Context->preference('OpacHiddenItemsHidesRecord');
309
310     return !(any { !$_->hidden_in_opac({ rules => $rules }) } @items);
311 }
312
313 =head3 article_request_type
314
315 my $type = $biblio->article_request_type( $borrower );
316
317 Returns the article request type based on items, or on the record
318 itself if there are no items.
319
320 $borrower must be a Koha::Patron object
321
322 =cut
323
324 sub article_request_type {
325     my ( $self, $borrower ) = @_;
326
327     return q{} unless $borrower;
328
329     my $rule = $self->article_request_type_for_items( $borrower );
330     return $rule if $rule;
331
332     # If the record has no items that are requestable, go by the record itemtype
333     $rule = $self->article_request_type_for_bib($borrower);
334     return $rule if $rule;
335
336     return q{};
337 }
338
339 =head3 article_request_type_for_bib
340
341 my $type = $biblio->article_request_type_for_bib
342
343 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record
344
345 =cut
346
347 sub article_request_type_for_bib {
348     my ( $self, $borrower ) = @_;
349
350     return q{} unless $borrower;
351
352     my $borrowertype = $borrower->categorycode;
353     my $itemtype     = $self->itemtype();
354
355     my $rule = Koha::CirculationRules->get_effective_rule(
356         {
357             rule_name    => 'article_requests',
358             categorycode => $borrowertype,
359             itemtype     => $itemtype,
360         }
361     );
362
363     return q{} unless $rule;
364     return $rule->rule_value || q{}
365 }
366
367 =head3 article_request_type_for_items
368
369 my $type = $biblio->article_request_type_for_items
370
371 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record's items
372
373 If there is a conflict where some items are 'bib_only' and some are 'item_only', 'bib_only' will be returned.
374
375 =cut
376
377 sub article_request_type_for_items {
378     my ( $self, $borrower ) = @_;
379
380     my $counts;
381     foreach my $item ( $self->items()->as_list() ) {
382         my $rule = $item->article_request_type($borrower);
383         return $rule if $rule eq 'bib_only';    # we don't need to go any further
384         $counts->{$rule}++;
385     }
386
387     return 'item_only' if $counts->{item_only};
388     return 'yes'       if $counts->{yes};
389     return 'no'        if $counts->{no};
390     return q{};
391 }
392
393 =head3 article_requests
394
395     my $article_requests = $biblio->article_requests
396
397 Returns the article requests associated with this biblio
398
399 =cut
400
401 sub article_requests {
402     my ( $self ) = @_;
403
404     return Koha::ArticleRequests->_new_from_dbic( scalar $self->_result->article_requests );
405 }
406
407 =head3 current_checkouts
408
409     my $current_checkouts = $biblio->current_checkouts
410
411 Returns the current checkouts associated with this biblio
412
413 =cut
414
415 sub current_checkouts {
416     my ($self) = @_;
417
418     return Koha::Checkouts->search( { "item.biblionumber" => $self->id },
419         { join => 'item' } );
420 }
421
422 =head3 old_checkouts
423
424     my $old_checkouts = $biblio->old_checkouts
425
426 Returns the past checkouts associated with this biblio
427
428 =cut
429
430 sub old_checkouts {
431     my ( $self ) = @_;
432
433     return Koha::Old::Checkouts->search( { "item.biblionumber" => $self->id },
434         { join => 'item' } );
435 }
436
437 =head3 items
438
439 my $items = $biblio->items();
440
441 Returns the related Koha::Items object for this biblio
442
443 =cut
444
445 sub items {
446     my ($self) = @_;
447
448     my $items_rs = $self->_result->items;
449
450     return Koha::Items->_new_from_dbic( $items_rs );
451 }
452
453 =head3 host_items
454
455 my $host_items = $biblio->host_items();
456
457 Return the host items (easy analytical record)
458
459 =cut
460
461 sub host_items {
462     my ($self) = @_;
463
464     return Koha::Items->new->empty
465       unless C4::Context->preference('EasyAnalyticalRecords');
466
467     my $marcflavour = C4::Context->preference("marcflavour");
468     my $analyticfield = '773';
469     if ( $marcflavour eq 'MARC21' ) {
470         $analyticfield = '773';
471     }
472     elsif ( $marcflavour eq 'UNIMARC' ) {
473         $analyticfield = '461';
474     }
475     my $marc_record = $self->metadata->record;
476     my @itemnumbers;
477     foreach my $field ( $marc_record->field($analyticfield) ) {
478         push @itemnumbers, $field->subfield('9');
479     }
480
481     return Koha::Items->search( { itemnumber => { -in => \@itemnumbers } } );
482 }
483
484 =head3 itemtype
485
486 my $itemtype = $biblio->itemtype();
487
488 Returns the itemtype for this record.
489
490 =cut
491
492 sub itemtype {
493     my ( $self ) = @_;
494
495     return $self->biblioitem()->itemtype();
496 }
497
498 =head3 holds
499
500 my $holds = $biblio->holds();
501
502 return the current holds placed on this record
503
504 =cut
505
506 sub holds {
507     my ( $self, $params, $attributes ) = @_;
508     $attributes->{order_by} = 'priority' unless exists $attributes->{order_by};
509     my $hold_rs = $self->_result->reserves->search( $params, $attributes );
510     return Koha::Holds->_new_from_dbic($hold_rs);
511 }
512
513 =head3 current_holds
514
515 my $holds = $biblio->current_holds
516
517 Return the holds placed on this bibliographic record.
518 It does not include future holds.
519
520 =cut
521
522 sub current_holds {
523     my ($self) = @_;
524     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
525     return $self->holds(
526         { reservedate => { '<=' => $dtf->format_date(dt_from_string) } } );
527 }
528
529 =head3 biblioitem
530
531 my $field = $self->biblioitem()->itemtype
532
533 Returns the related Koha::Biblioitem object for this Biblio object
534
535 =cut
536
537 sub biblioitem {
538     my ($self) = @_;
539
540     $self->{_biblioitem} ||= Koha::Biblioitems->find( { biblionumber => $self->biblionumber() } );
541
542     return $self->{_biblioitem};
543 }
544
545 =head3 suggestions
546
547 my $suggestions = $self->suggestions
548
549 Returns the related Koha::Suggestions object for this Biblio object
550
551 =cut
552
553 sub suggestions {
554     my ($self) = @_;
555
556     my $suggestions_rs = $self->_result->suggestions;
557     return Koha::Suggestions->_new_from_dbic( $suggestions_rs );
558 }
559
560 =head3 get_marc_components
561
562   my $components = $self->get_marc_components();
563
564 Returns an array of search results data, which are component parts of
565 this object (MARC21 773 points to this)
566
567 =cut
568
569 sub get_marc_components {
570     my ($self, $max_results) = @_;
571
572     return [] if (C4::Context->preference('marcflavour') ne 'MARC21');
573
574     my ( $searchstr, $sort ) = $self->get_components_query;
575
576     my $components;
577     if (defined($searchstr)) {
578         my $searcher = Koha::SearchEngine::Search->new({index => $Koha::SearchEngine::BIBLIOS_INDEX});
579         my ( $error, $results, $facets );
580         eval {
581             ( $error, $results, $facets ) = $searcher->search_compat( $searchstr, undef, [$sort], ['biblioserver'], $max_results, 0, undef, undef, 'ccl', 0 );
582         };
583         if( $error || $@ ) {
584             $error //= q{};
585             $error .= $@ if $@;
586             warn "Warning from search_compat: '$error'";
587             $self->add_message(
588                 {
589                     type    => 'error',
590                     message => 'component_search',
591                     payload => $error,
592                 }
593             );
594         }
595         $components = $results->{biblioserver}->{RECORDS} if defined($results) && $results->{biblioserver}->{hits};
596     }
597
598     return $components // [];
599 }
600
601 =head2 get_components_query
602
603 Returns a query which can be used to search for all component parts of MARC21 biblios
604
605 =cut
606
607 sub get_components_query {
608     my ($self) = @_;
609
610     my $builder = Koha::SearchEngine::QueryBuilder->new(
611         { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
612     my $marc = $self->metadata->record;
613     my $component_sort_field = C4::Context->preference('ComponentSortField') // "title";
614     my $component_sort_order = C4::Context->preference('ComponentSortOrder') // "asc";
615     my $sort = $component_sort_field . "_" . $component_sort_order;
616
617     my $searchstr;
618     if ( C4::Context->preference('UseControlNumber') ) {
619         my $pf001 = $marc->field('001') || undef;
620
621         if ( defined($pf001) ) {
622             $searchstr = "(";
623             my $pf003 = $marc->field('003') || undef;
624
625             if ( !defined($pf003) ) {
626                 # search for 773$w='Host001'
627                 $searchstr .= "rcn:\"" . $pf001->data()."\"";
628             }
629             else {
630                 $searchstr .= "(";
631                 # search for (773$w='Host001' and 003='Host003') or 773$w='(Host003)Host001'
632                 $searchstr .= "(rcn:\"" . $pf001->data() . "\" AND cni:\"" . $pf003->data() . "\")";
633                 $searchstr .= " OR rcn:\"" . $pf003->data() . " " . $pf001->data() . "\"";
634                 $searchstr .= ")";
635             }
636
637             # limit to monograph and serial component part records
638             $searchstr .= " AND (bib-level:a OR bib-level:b)";
639             $searchstr .= ")";
640         }
641     }
642     else {
643         my $cleaned_title = $marc->subfield('245', "a");
644         $cleaned_title =~ tr|/||;
645         $cleaned_title = $builder->clean_search_term($cleaned_title);
646         $searchstr = qq#Host-item:("$cleaned_title")#;
647     }
648     my ($error, $query ,$query_str) = $builder->build_query_compat( undef, [$searchstr], undef, undef, [$sort], 0 );
649     if( $error ){
650         warn $error;
651         return;
652     }
653
654     return ($query, $query_str, $sort);
655 }
656
657 =head3 subscriptions
658
659 my $subscriptions = $self->subscriptions
660
661 Returns the related Koha::Subscriptions object for this Biblio object
662
663 =cut
664
665 sub subscriptions {
666     my ($self) = @_;
667
668     $self->{_subscriptions} ||= Koha::Subscriptions->search( { biblionumber => $self->biblionumber } );
669
670     return $self->{_subscriptions};
671 }
672
673 =head3 has_items_waiting_or_intransit
674
675 my $itemsWaitingOrInTransit = $biblio->has_items_waiting_or_intransit
676
677 Tells if this bibliographic record has items waiting or in transit.
678
679 =cut
680
681 sub has_items_waiting_or_intransit {
682     my ( $self ) = @_;
683
684     if ( Koha::Holds->search({ biblionumber => $self->id,
685                                found => ['W', 'T'] })->count ) {
686         return 1;
687     }
688
689     foreach my $item ( $self->items->as_list ) {
690         return 1 if $item->get_transfer;
691     }
692
693     return 0;
694 }
695
696 =head2 get_coins
697
698 my $coins = $biblio->get_coins;
699
700 Returns the COinS (a span) which can be included in a biblio record
701
702 =cut
703
704 sub get_coins {
705     my ( $self ) = @_;
706
707     my $record = $self->metadata->record;
708
709     my $pos7 = substr $record->leader(), 7, 1;
710     my $pos6 = substr $record->leader(), 6, 1;
711     my $mtx;
712     my $genre;
713     my ( $aulast, $aufirst ) = ( '', '' );
714     my @authors;
715     my $title;
716     my $hosttitle;
717     my $pubyear   = '';
718     my $isbn      = '';
719     my $issn      = '';
720     my $publisher = '';
721     my $pages     = '';
722     my $titletype = '';
723
724     # For the purposes of generating COinS metadata, LDR/06-07 can be
725     # considered the same for UNIMARC and MARC21
726     my $fmts6 = {
727         'a' => 'book',
728         'b' => 'manuscript',
729         'c' => 'book',
730         'd' => 'manuscript',
731         'e' => 'map',
732         'f' => 'map',
733         'g' => 'film',
734         'i' => 'audioRecording',
735         'j' => 'audioRecording',
736         'k' => 'artwork',
737         'l' => 'document',
738         'm' => 'computerProgram',
739         'o' => 'document',
740         'r' => 'document',
741     };
742     my $fmts7 = {
743         'a' => 'journalArticle',
744         's' => 'journal',
745     };
746
747     $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
748
749     if ( $genre eq 'book' ) {
750             $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
751     }
752
753     ##### We must transform mtx to a valable mtx and document type ####
754     if ( $genre eq 'book' ) {
755             $mtx = 'book';
756             $titletype = 'b';
757     } elsif ( $genre eq 'journal' ) {
758             $mtx = 'journal';
759             $titletype = 'j';
760     } elsif ( $genre eq 'journalArticle' ) {
761             $mtx   = 'journal';
762             $genre = 'article';
763             $titletype = 'a';
764     } else {
765             $mtx = 'dc';
766     }
767
768     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
769
770         # Setting datas
771         $aulast  = $record->subfield( '700', 'a' ) || '';
772         $aufirst = $record->subfield( '700', 'b' ) || '';
773         push @authors, "$aufirst $aulast" if ($aufirst or $aulast);
774
775         # others authors
776         if ( $record->field('200') ) {
777             for my $au ( $record->field('200')->subfield('g') ) {
778                 push @authors, $au;
779             }
780         }
781
782         $title     = $record->subfield( '200', 'a' );
783         my $subfield_210d = $record->subfield('210', 'd');
784         if ($subfield_210d and $subfield_210d =~ /(\d{4})/) {
785             $pubyear = $1;
786         }
787         $publisher = $record->subfield( '210', 'c' ) || '';
788         $isbn      = $record->subfield( '010', 'a' ) || '';
789         $issn      = $record->subfield( '011', 'a' ) || '';
790     } else {
791
792         # MARC21 need some improve
793
794         # Setting datas
795         if ( $record->field('100') ) {
796             push @authors, $record->subfield( '100', 'a' );
797         }
798
799         # others authors
800         if ( $record->field('700') ) {
801             for my $au ( $record->field('700')->subfield('a') ) {
802                 push @authors, $au;
803             }
804         }
805         $title = $record->field('245');
806         $title &&= $title->as_string('ab');
807         if ($titletype eq 'a') {
808             $pubyear   = $record->field('008') || '';
809             $pubyear   = substr($pubyear->data(), 7, 4) if $pubyear;
810             $isbn      = $record->subfield( '773', 'z' ) || '';
811             $issn      = $record->subfield( '773', 'x' ) || '';
812             $hosttitle = $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{};
813             my @rels = $record->subfield( '773', 'g' );
814             $pages = join(', ', @rels);
815         } else {
816             $pubyear   = $record->subfield( '260', 'c' ) || '';
817             $publisher = $record->subfield( '260', 'b' ) || '';
818             $isbn      = $record->subfield( '020', 'a' ) || '';
819             $issn      = $record->subfield( '022', 'a' ) || '';
820         }
821
822     }
823
824     my @params = (
825         [ 'ctx_ver', 'Z39.88-2004' ],
826         [ 'rft_val_fmt', "info:ofi/fmt:kev:mtx:$mtx" ],
827         [ ($mtx eq 'dc' ? 'rft.type' : 'rft.genre'), $genre ],
828         [ "rft.${titletype}title", $title ],
829     );
830
831     # rft.title is authorized only once, so by checking $titletype
832     # we ensure that rft.title is not already in the list.
833     if ($hosttitle and $titletype) {
834         push @params, [ 'rft.title', $hosttitle ];
835     }
836
837     push @params, (
838         [ 'rft.isbn', $isbn ],
839         [ 'rft.issn', $issn ],
840     );
841
842     # If it's a subscription, these informations have no meaning.
843     if ($genre ne 'journal') {
844         push @params, (
845             [ 'rft.aulast', $aulast ],
846             [ 'rft.aufirst', $aufirst ],
847             (map { [ 'rft.au', $_ ] } @authors),
848             [ 'rft.pub', $publisher ],
849             [ 'rft.date', $pubyear ],
850             [ 'rft.pages', $pages ],
851         );
852     }
853
854     my $coins_value = join( '&amp;',
855         map { $$_[1] ? $$_[0] . '=' . uri_escape_utf8( $$_[1] ) : () } @params );
856
857     return $coins_value;
858 }
859
860 =head2 get_openurl
861
862 my $url = $biblio->get_openurl;
863
864 Returns url for OpenURL resolver set in OpenURLResolverURL system preference
865
866 =cut
867
868 sub get_openurl {
869     my ( $self ) = @_;
870
871     my $OpenURLResolverURL = C4::Context->preference('OpenURLResolverURL');
872
873     if ($OpenURLResolverURL) {
874         my $uri = URI->new($OpenURLResolverURL);
875
876         if (not defined $uri->query) {
877             $OpenURLResolverURL .= '?';
878         } else {
879             $OpenURLResolverURL .= '&amp;';
880         }
881         $OpenURLResolverURL .= $self->get_coins;
882     }
883
884     return $OpenURLResolverURL;
885 }
886
887 =head3 is_serial
888
889 my $serial = $biblio->is_serial
890
891 Return boolean true if this bibbliographic record is continuing resource
892
893 =cut
894
895 sub is_serial {
896     my ( $self ) = @_;
897
898     return 1 if $self->serial;
899
900     my $record = $self->metadata->record;
901     return 1 if substr($record->leader, 7, 1) eq 's';
902
903     return 0;
904 }
905
906 =head3 custom_cover_image_url
907
908 my $image_url = $biblio->custom_cover_image_url
909
910 Return the specific url of the cover image for this bibliographic record.
911 It is built regaring the value of the system preference CustomCoverImagesURL
912
913 =cut
914
915 sub custom_cover_image_url {
916     my ( $self ) = @_;
917     my $url = C4::Context->preference('CustomCoverImagesURL');
918     if ( $url =~ m|{isbn}| ) {
919         my $isbn = $self->biblioitem->isbn;
920         return unless $isbn;
921         $url =~ s|{isbn}|$isbn|g;
922     }
923     if ( $url =~ m|{normalized_isbn}| ) {
924         my $normalized_isbn = C4::Koha::GetNormalizedISBN($self->biblioitem->isbn);
925         return unless $normalized_isbn;
926         $url =~ s|{normalized_isbn}|$normalized_isbn|g;
927     }
928     if ( $url =~ m|{issn}| ) {
929         my $issn = $self->biblioitem->issn;
930         return unless $issn;
931         $url =~ s|{issn}|$issn|g;
932     }
933
934     my $re = qr|{(?<field>\d{3})(\$(?<subfield>.))?}|;
935     if ( $url =~ $re ) {
936         my $field = $+{field};
937         my $subfield = $+{subfield};
938         my $marc_record = $self->metadata->record;
939         my $value;
940         if ( $subfield ) {
941             $value = $marc_record->subfield( $field, $subfield );
942         } else {
943             my $controlfield = $marc_record->field($field);
944             $value = $controlfield->data() if $controlfield;
945         }
946         return unless $value;
947         $url =~ s|$re|$value|;
948     }
949
950     return $url;
951 }
952
953 =head3 cover_images
954
955 Return the cover images associated with this biblio.
956
957 =cut
958
959 sub cover_images {
960     my ( $self ) = @_;
961
962     my $cover_images_rs = $self->_result->cover_images;
963     return unless $cover_images_rs;
964     return Koha::CoverImages->_new_from_dbic($cover_images_rs);
965 }
966
967 =head3 get_marc_notes
968
969     $marcnotesarray = $biblio->get_marc_notes({ opac => 1 });
970
971 Get all notes from the MARC record and returns them in an array.
972 The notes are stored in different fields depending on MARC flavour.
973 MARC21 5XX $u subfields receive special attention as they are URIs.
974
975 =cut
976
977 sub get_marc_notes {
978     my ( $self, $params ) = @_;
979
980     my $marcflavour = C4::Context->preference('marcflavour');
981     my $opac = $params->{opac} // '0';
982     my $interface = $params->{opac} ? 'opac' : 'intranet';
983
984     my $record = $params->{record} // $self->metadata->record;
985     my $record_processor = Koha::RecordProcessor->new(
986         {
987             filters => [ 'ViewPolicy', 'ExpandCodedFields' ],
988             options => {
989                 interface     => $interface,
990                 frameworkcode => $self->frameworkcode
991             }
992         }
993     );
994     $record_processor->process($record);
995
996     my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
997     #MARC21 specs indicate some notes should be private if first indicator 0
998     my %maybe_private = (
999         541 => 1,
1000         542 => 1,
1001         561 => 1,
1002         583 => 1,
1003         590 => 1
1004     );
1005
1006     my %hiddenlist = map { $_ => 1 }
1007         split( /,/, C4::Context->preference('NotesToHide'));
1008
1009     my @marcnotes;
1010     foreach my $field ( $record->field($scope) ) {
1011         my $tag = $field->tag();
1012         next if $hiddenlist{ $tag };
1013         next if $opac && $maybe_private{$tag} && !$field->indicator(1);
1014         if( $marcflavour ne 'UNIMARC' && $field->subfield('u') ) {
1015             # Field 5XX$u always contains URI
1016             # Examples: 505u, 506u, 510u, 514u, 520u, 530u, 538u, 540u, 542u, 552u, 555u, 561u, 563u, 583u
1017             # We first push the other subfields, then all $u's separately
1018             # Leave further actions to the template (see e.g. opac-detail)
1019             my $othersub =
1020                 join '', ( 'a' .. 't', 'v' .. 'z', '0' .. '9' ); # excl 'u'
1021             push @marcnotes, { marcnote => $field->as_string($othersub) };
1022             foreach my $sub ( $field->subfield('u') ) {
1023                 $sub =~ s/^\s+|\s+$//g; # trim
1024                 push @marcnotes, { marcnote => $sub };
1025             }
1026         } else {
1027             push @marcnotes, { marcnote => $field->as_string() };
1028         }
1029     }
1030     return \@marcnotes;
1031 }
1032
1033 =head3 _get_marc_authors
1034
1035 Private method to return the list of authors contained in the MARC record.
1036 See get get_marc_contributors and get_marc_authors for the public methods.
1037
1038 =cut
1039
1040 sub _get_marc_authors {
1041     my ( $self, $params ) = @_;
1042
1043     my $fields_filter = $params->{fields_filter};
1044     my $mintag        = $params->{mintag};
1045     my $maxtag        = $params->{maxtag};
1046
1047     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1048     my $marcflavour        = C4::Context->preference('marcflavour');
1049
1050     # tagslib useful only for UNIMARC author responsibilities
1051     my $tagslib = $marcflavour eq "UNIMARC"
1052       ? C4::Biblio::GetMarcStructure( 1, $self->frameworkcode, { unsafe => 1 } )
1053       : undef;
1054
1055     my @marcauthors;
1056     foreach my $field ( $self->metadata->record->field($fields_filter) ) {
1057
1058         next
1059           if $mintag && $field->tag() < $mintag
1060           || $maxtag && $field->tag() > $maxtag;
1061
1062         my @subfields_loop;
1063         my @link_loop;
1064         my @subfields  = $field->subfields();
1065         my $count_auth = 0;
1066
1067         # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1068         my $subfield9 = $field->subfield('9');
1069         if ($subfield9) {
1070             my $linkvalue = $subfield9;
1071             $linkvalue =~ s/(\(|\))//g;
1072             @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1073         }
1074
1075         # other subfields
1076         my $unimarc3;
1077         for my $authors_subfield (@subfields) {
1078             next if ( $authors_subfield->[0] eq '9' );
1079
1080             # unimarc3 contains the $3 of the author for UNIMARC.
1081             # For french academic libraries, it's the "ppn", and it's required for idref webservice
1082             $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1083
1084             # don't load unimarc subfields 3, 5
1085             next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1086
1087             my $code = $authors_subfield->[0];
1088             my $value        = $authors_subfield->[1];
1089             my $linkvalue    = $value;
1090             $linkvalue =~ s/(\(|\))//g;
1091             # UNIMARC author responsibility
1092             if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1093                 $value = C4::Biblio::GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1094                 $linkvalue = "($value)";
1095             }
1096             # if no authority link, build a search query
1097             unless ($subfield9) {
1098                 push @link_loop, {
1099                     limit    => 'au',
1100                     'link'   => $linkvalue,
1101                     operator => (scalar @link_loop) ? ' AND ' : undef
1102                 };
1103             }
1104             my @this_link_loop = @link_loop;
1105             # do not display $0
1106             unless ( $code eq '0') {
1107                 push @subfields_loop, {
1108                     tag       => $field->tag(),
1109                     code      => $code,
1110                     value     => $value,
1111                     link_loop => \@this_link_loop,
1112                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1113                 };
1114             }
1115         }
1116         push @marcauthors, {
1117             MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1118             authoritylink => $subfield9,
1119             unimarc3 => $unimarc3
1120         };
1121     }
1122     return \@marcauthors;
1123 }
1124
1125 =head3 get_marc_contributors
1126
1127     my $contributors = $biblio->get_marc_contributors;
1128
1129 Get all contributors (but first author) from the MARC record and returns them in an array.
1130 They are stored in different fields depending on MARC flavour (700..720 for MARC21)
1131
1132 =cut
1133
1134 sub get_marc_contributors {
1135     my ( $self, $params ) = @_;
1136
1137     my ( $mintag, $maxtag, $fields_filter );
1138     my $marcflavour = C4::Context->preference('marcflavour');
1139
1140     if ( $marcflavour eq "UNIMARC" ) {
1141         $mintag = "700";
1142         $maxtag = "712";
1143         $fields_filter = '7..';
1144     } else { # marc21/normarc
1145         $mintag = "700";
1146         $maxtag = "720";
1147         $fields_filter = '7..';
1148     }
1149
1150     return $self->_get_marc_authors(
1151         {
1152             fields_filter => $fields_filter,
1153             mintag       => $mintag,
1154             maxtag       => $maxtag
1155         }
1156     );
1157 }
1158
1159 =head3 get_marc_authors
1160
1161     my $authors = $biblio->get_marc_authors;
1162
1163 Get all authors from the MARC record and returns them in an array.
1164 They are stored in different fields depending on MARC flavour
1165 (main author from 100 then secondary authors from 700..720).
1166
1167 =cut
1168
1169 sub get_marc_authors {
1170     my ( $self, $params ) = @_;
1171
1172     my ( $mintag, $maxtag, $fields_filter );
1173     my $marcflavour = C4::Context->preference('marcflavour');
1174
1175     if ( $marcflavour eq "UNIMARC" ) {
1176         $fields_filter = '200';
1177     } else { # marc21/normarc
1178         $fields_filter = '100';
1179     }
1180
1181     my @first_authors = @{$self->_get_marc_authors(
1182         {
1183             fields_filter => $fields_filter,
1184             mintag       => $mintag,
1185             maxtag       => $maxtag
1186         }
1187     )};
1188
1189     my @other_authors = @{$self->get_marc_contributors};
1190
1191     return [@first_authors, @other_authors];
1192 }
1193
1194
1195 =head3 to_api
1196
1197     my $json = $biblio->to_api;
1198
1199 Overloaded method that returns a JSON representation of the Koha::Biblio object,
1200 suitable for API output. The related Koha::Biblioitem object is merged as expected
1201 on the API.
1202
1203 =cut
1204
1205 sub to_api {
1206     my ($self, $args) = @_;
1207
1208     my $response = $self->SUPER::to_api( $args );
1209     my $biblioitem = $self->biblioitem->to_api;
1210
1211     return { %$response, %$biblioitem };
1212 }
1213
1214 =head3 to_api_mapping
1215
1216 This method returns the mapping for representing a Koha::Biblio object
1217 on the API.
1218
1219 =cut
1220
1221 sub to_api_mapping {
1222     return {
1223         biblionumber     => 'biblio_id',
1224         frameworkcode    => 'framework_id',
1225         unititle         => 'uniform_title',
1226         seriestitle      => 'series_title',
1227         copyrightdate    => 'copyright_date',
1228         datecreated      => 'creation_date',
1229         deleted_on       => undef,
1230     };
1231 }
1232
1233 =head3 get_marc_host
1234
1235     $host = $biblio->get_marc_host;
1236     # OR:
1237     ( $host, $relatedparts, $hostinfo ) = $biblio->get_marc_host;
1238
1239     Returns host biblio record from MARC21 773 (undef if no 773 present).
1240     It looks at the first 773 field with MARCorgCode or only a control
1241     number. Complete $w or numeric part is used to search host record.
1242     The optional parameter no_items triggers a check if $biblio has items.
1243     If there are, the sub returns undef.
1244     Called in list context, it also returns 773$g (related parts).
1245
1246     If there is no $w, we use $0 (host biblionumber) or $9 (host itemnumber)
1247     to search for the host record. If there is also no $0 and no $9, we search
1248     using author and title. Failing all of that, we return an undef host and
1249     form a concatenation of strings with 773$agt for host information,
1250     returned when called in list context.
1251
1252 =cut
1253
1254 sub get_marc_host {
1255     my ($self, $params) = @_;
1256     my $no_items = $params->{no_items};
1257     return if C4::Context->preference('marcflavour') eq 'UNIMARC'; # TODO
1258     return if $params->{no_items} && $self->items->count > 0;
1259
1260     my $record;
1261     eval { $record = $self->metadata->record };
1262     return if !$record;
1263
1264     # We pick the first $w with your MARCOrgCode or the first $w that has no
1265     # code (between parentheses) at all.
1266     my $orgcode = C4::Context->preference('MARCOrgCode') // q{};
1267     my $hostfld;
1268     foreach my $f ( $record->field('773') ) {
1269         my $w = $f->subfield('w') or next;
1270         if( $w =~ /^\($orgcode\)\s*(\d+)/i or $w =~ /^\d+/ ) {
1271             $hostfld = $f;
1272             last;
1273         }
1274     }
1275
1276     my $engine = Koha::SearchEngine::Search->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
1277     my $bibno;
1278     if ( !$hostfld and $record->subfield('773','t') ) {
1279         # not linked using $w
1280         my $unlinkedf = $record->field('773');
1281         my $host;
1282         if ( C4::Context->preference("EasyAnalyticalRecords") ) {
1283             if ( $unlinkedf->subfield('0') ) {
1284                 # use 773$0 host biblionumber
1285                 $bibno = $unlinkedf->subfield('0');
1286             } elsif ( $unlinkedf->subfield('9') ) {
1287                 # use 773$9 host itemnumber
1288                 my $linkeditemnumber = $unlinkedf->subfield('9');
1289                 $bibno = Koha::Items->find( $linkeditemnumber )->biblionumber;
1290             }
1291         }
1292         if ( $bibno ) {
1293             my $host = Koha::Biblios->find($bibno) or return;
1294             return wantarray ? ( $host, $unlinkedf->subfield('g') ) : $host;
1295         }
1296         # just return plaintext and no host record
1297         my $hostinfo = join( ", ", $unlinkedf->subfield('a'), $unlinkedf->subfield('t'), $unlinkedf->subfield('g') );
1298         return wantarray ? ( undef, $unlinkedf->subfield('g'), $hostinfo ) : undef;
1299     }
1300     return if !$hostfld;
1301     my $rcn = $hostfld->subfield('w');
1302
1303     # Look for control number with/without orgcode
1304     for my $try (1..2) {
1305         my ( $error, $results, $total_hits ) = $engine->simple_search_compat( 'Control-number='.$rcn, 0,1 );
1306         if( !$error and $total_hits == 1 ) {
1307             $bibno = $engine->extract_biblionumber( $results->[0] );
1308             last;
1309         }
1310         # Add or remove orgcode for second try
1311         if( $try == 1 && $rcn =~ /\)\s*(\d+)/ ) {
1312             $rcn = $1; # number only
1313         } elsif( $try == 1 && $rcn =~ /^\d+/ ) {
1314             $rcn = "($orgcode)$rcn";
1315         } else {
1316             last;
1317         }
1318     }
1319     if( $bibno ) {
1320         my $host = Koha::Biblios->find($bibno) or return;
1321         return wantarray ? ( $host, $hostfld->subfield('g') ) : $host;
1322     }
1323 }
1324
1325 =head3 recalls
1326
1327     my $recalls = $biblio->recalls;
1328
1329 Return recalls linked to this biblio
1330
1331 =cut
1332
1333 sub recalls {
1334     my ( $self ) = @_;
1335     return Koha::Recalls->_new_from_dbic( scalar $self->_result->recalls );
1336 }
1337
1338 =head3 can_be_recalled
1339
1340     my @items_for_recall = $biblio->can_be_recalled({ patron => $patron_object });
1341
1342 Does biblio-level checks and returns the items attached to this biblio that are available for recall
1343
1344 =cut
1345
1346 sub can_be_recalled {
1347     my ( $self, $params ) = @_;
1348
1349     return 0 if !( C4::Context->preference('UseRecalls') );
1350
1351     my $patron = $params->{patron};
1352
1353     my $branchcode = C4::Context->userenv->{'branch'};
1354     if ( C4::Context->preference('CircControl') eq 'PatronLibrary' and $patron ) {
1355         $branchcode = $patron->branchcode;
1356     }
1357
1358     my @all_items = Koha::Items->search({ biblionumber => $self->biblionumber })->as_list;
1359
1360     # if there are no available items at all, no recall can be placed
1361     return 0 if ( scalar @all_items == 0 );
1362
1363     my @itemtypes;
1364     my @itemnumbers;
1365     my @items;
1366     my @all_itemnumbers;
1367     foreach my $item ( @all_items ) {
1368         push( @all_itemnumbers, $item->itemnumber );
1369         if ( $item->can_be_recalled({ patron => $patron }) ) {
1370             push( @itemtypes, $item->effective_itemtype );
1371             push( @itemnumbers, $item->itemnumber );
1372             push( @items, $item );
1373         }
1374     }
1375
1376     # if there are no recallable items, no recall can be placed
1377     return 0 if ( scalar @items == 0 );
1378
1379     # Check the circulation rule for each relevant itemtype for this biblio
1380     my ( @recalls_allowed, @recalls_per_record, @on_shelf_recalls );
1381     foreach my $itemtype ( @itemtypes ) {
1382         my $rule = Koha::CirculationRules->get_effective_rules({
1383             branchcode => $branchcode,
1384             categorycode => $patron ? $patron->categorycode : undef,
1385             itemtype => $itemtype,
1386             rules => [
1387                 'recalls_allowed',
1388                 'recalls_per_record',
1389                 'on_shelf_recalls',
1390             ],
1391         });
1392         push( @recalls_allowed, $rule->{recalls_allowed} ) if $rule;
1393         push( @recalls_per_record, $rule->{recalls_per_record} ) if $rule;
1394         push( @on_shelf_recalls, $rule->{on_shelf_recalls} ) if $rule;
1395     }
1396     my $recalls_allowed = (sort {$b <=> $a} @recalls_allowed)[0]; # take highest
1397     my $recalls_per_record = (sort {$b <=> $a} @recalls_per_record)[0]; # take highest
1398     my %on_shelf_recalls_count = ();
1399     foreach my $count ( @on_shelf_recalls ) {
1400         $on_shelf_recalls_count{$count}++;
1401     }
1402     my $on_shelf_recalls = (sort {$on_shelf_recalls_count{$b} <=> $on_shelf_recalls_count{$a}} @on_shelf_recalls)[0]; # take most common
1403
1404     # check recalls allowed has been set and is not zero
1405     return 0 if ( !defined($recalls_allowed) || $recalls_allowed == 0 );
1406
1407     if ( $patron ) {
1408         # check borrower has not reached open recalls allowed limit
1409         return 0 if ( $patron->recalls->filter_by_current->count >= $recalls_allowed );
1410
1411         # check borrower has not reached open recalls allowed per record limit
1412         return 0 if ( $patron->recalls->filter_by_current->search({ biblio_id => $self->biblionumber })->count >= $recalls_per_record );
1413
1414         # check if any of the items under this biblio are already checked out by this borrower
1415         return 0 if ( Koha::Checkouts->search({ itemnumber => [ @all_itemnumbers ], borrowernumber => $patron->borrowernumber })->count > 0 );
1416     }
1417
1418     # check item availability
1419     my $checked_out_count = 0;
1420     foreach (@items) {
1421         if ( Koha::Checkouts->search({ itemnumber => $_->itemnumber })->count > 0 ){ $checked_out_count++; }
1422     }
1423
1424     # can't recall if on shelf recalls only allowed when all unavailable, but items are still available for checkout
1425     return 0 if ( $on_shelf_recalls eq 'all' && $checked_out_count < scalar @items );
1426
1427     # can't recall if no items have been checked out
1428     return 0 if ( $checked_out_count == 0 );
1429
1430     # can recall
1431     return @items;
1432 }
1433
1434 =head2 Internal methods
1435
1436 =head3 type
1437
1438 =cut
1439
1440 sub _type {
1441     return 'Biblio';
1442 }
1443
1444 =head1 AUTHOR
1445
1446 Kyle M Hall <kyle@bywatersolutions.com>
1447
1448 =cut
1449
1450 1;