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