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