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