Koha/Biblio.pm

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