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