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     return Koha::Biblioitems->find( { biblionumber => $self->biblionumber } );
 583 }
 584
 585 =head3 suggestions
 586
 587 my $suggestions = $self->suggestions
 588
 589 Returns the related Koha::Suggestions object for this Biblio object
 590
 591 =cut
 592
 593 sub suggestions {
 594     my ($self) = @_;
 595
 596     my $suggestions_rs = $self->_result->suggestions;
 597     return Koha::Suggestions->_new_from_dbic( $suggestions_rs );
 598 }
 599
 600 =head3 get_marc_components
 601
 602   my $components = $self->get_marc_components();
 603
 604 Returns an array of search results data, which are component parts of
 605 this object (MARC21 773 points to this)
 606
 607 =cut
 608
 609 sub get_marc_components {
 610     my ($self, $max_results) = @_;
 611
 612     return [] if (C4::Context->preference('marcflavour') ne 'MARC21');
 613
 614     my ( $searchstr, $sort ) = $self->get_components_query;
 615
 616     my $components;
 617     if (defined($searchstr)) {
 618         my $searcher = Koha::SearchEngine::Search->new({index => $Koha::SearchEngine::BIBLIOS_INDEX});
 619         my ( $error, $results, $facets );
 620         eval {
 621             ( $error, $results, $facets ) = $searcher->search_compat( $searchstr, undef, [$sort], ['biblioserver'], $max_results, 0, undef, undef, 'ccl', 0 );
 622         };
 623         if( $error || $@ ) {
 624             $error //= q{};
 625             $error .= $@ if $@;
 626             warn "Warning from search_compat: '$error'";
 627             $self->add_message(
 628                 {
 629                     type    => 'error',
 630                     message => 'component_search',
 631                     payload => $error,
 632                 }
 633             );
 634         }
 635         $components = $results->{biblioserver}->{RECORDS} if defined($results) && $results->{biblioserver}->{hits};
 636     }
 637
 638     return $components // [];
 639 }
 640
 641 =head2 get_components_query
 642
 643 Returns a query which can be used to search for all component parts of MARC21 biblios
 644
 645 =cut
 646
 647 sub get_components_query {
 648     my ($self) = @_;
 649
 650     my $builder = Koha::SearchEngine::QueryBuilder->new(
 651         { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
 652     my $marc = $self->metadata->record;
 653     my $component_sort_field = C4::Context->preference('ComponentSortField') // "title";
 654     my $component_sort_order = C4::Context->preference('ComponentSortOrder') // "asc";
 655     my $sort = $component_sort_field . "_" . $component_sort_order;
 656
 657     my $searchstr;
 658     if ( C4::Context->preference('UseControlNumber') ) {
 659         my $pf001 = $marc->field('001') || undef;
 660
 661         if ( defined($pf001) ) {
 662             $searchstr = "(";
 663             my $pf003 = $marc->field('003') || undef;
 664
 665             if ( !defined($pf003) ) {
 666                 # search for 773$w='Host001'
 667                 $searchstr .= "rcn:\"" . $pf001->data()."\"";
 668             }
 669             else {
 670                 $searchstr .= "(";
 671                 # search for (773$w='Host001' and 003='Host003') or 773$w='(Host003)Host001'
 672                 $searchstr .= "(rcn:\"" . $pf001->data() . "\" AND cni:\"" . $pf003->data() . "\")";
 673                 $searchstr .= " OR rcn:\"" . $pf003->data() . " " . $pf001->data() . "\"";
 674                 $searchstr .= ")";
 675             }
 676
 677             # limit to monograph and serial component part records
 678             $searchstr .= " AND (bib-level:a OR bib-level:b)";
 679             $searchstr .= ")";
 680         }
 681     }
 682     else {
 683         my $cleaned_title = $marc->subfield('245', "a");
 684         $cleaned_title =~ tr|/||;
 685         $cleaned_title = $builder->clean_search_term($cleaned_title);
 686         $searchstr = qq#Host-item:("$cleaned_title")#;
 687     }
 688     my ($error, $query ,$query_str) = $builder->build_query_compat( undef, [$searchstr], undef, undef, [$sort], 0 );
 689     if( $error ){
 690         warn $error;
 691         return;
 692     }
 693
 694     return ($query, $query_str, $sort);
 695 }
 696
 697 =head3 subscriptions
 698
 699 my $subscriptions = $self->subscriptions
 700
 701 Returns the related Koha::Subscriptions object for this Biblio object
 702
 703 =cut
 704
 705 sub subscriptions {
 706     my ($self) = @_;
 707     my $rs = $self->_result->subscriptions;
 708     return Koha::Subscriptions->_new_from_dbic($rs);
 709 }
 710
 711 =head3 has_items_waiting_or_intransit
 712
 713 my $itemsWaitingOrInTransit = $biblio->has_items_waiting_or_intransit
 714
 715 Tells if this bibliographic record has items waiting or in transit.
 716
 717 =cut
 718
 719 sub has_items_waiting_or_intransit {
 720     my ( $self ) = @_;
 721
 722     if ( Koha::Holds->search({ biblionumber => $self->id,
 723                                found => ['W', 'T'] })->count ) {
 724         return 1;
 725     }
 726
 727     foreach my $item ( $self->items->as_list ) {
 728         return 1 if $item->get_transfer;
 729     }
 730
 731     return 0;
 732 }
 733
 734 =head2 get_coins
 735
 736 my $coins = $biblio->get_coins;
 737
 738 Returns the COinS (a span) which can be included in a biblio record
 739
 740 =cut
 741
 742 sub get_coins {
 743     my ( $self ) = @_;
 744
 745     my $record = $self->metadata->record;
 746
 747     my $pos7 = substr $record->leader(), 7, 1;
 748     my $pos6 = substr $record->leader(), 6, 1;
 749     my $mtx;
 750     my $genre;
 751     my ( $aulast, $aufirst ) = ( '', '' );
 752     my @authors;
 753     my $title;
 754     my $hosttitle;
 755     my $pubyear   = '';
 756     my $isbn      = '';
 757     my $issn      = '';
 758     my $publisher = '';
 759     my $pages     = '';
 760     my $titletype = '';
 761
 762     # For the purposes of generating COinS metadata, LDR/06-07 can be
 763     # considered the same for UNIMARC and MARC21
 764     my $fmts6 = {
 765         'a' => 'book',
 766         'b' => 'manuscript',
 767         'c' => 'book',
 768         'd' => 'manuscript',
 769         'e' => 'map',
 770         'f' => 'map',
 771         'g' => 'film',
 772         'i' => 'audioRecording',
 773         'j' => 'audioRecording',
 774         'k' => 'artwork',
 775         'l' => 'document',
 776         'm' => 'computerProgram',
 777         'o' => 'document',
 778         'r' => 'document',
 779     };
 780     my $fmts7 = {
 781         'a' => 'journalArticle',
 782         's' => 'journal',
 783     };
 784
 785     $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
 786
 787     if ( $genre eq 'book' ) {
 788             $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
 789     }
 790
 791     ##### We must transform mtx to a valable mtx and document type ####
 792     if ( $genre eq 'book' ) {
 793             $mtx = 'book';
 794             $titletype = 'b';
 795     } elsif ( $genre eq 'journal' ) {
 796             $mtx = 'journal';
 797             $titletype = 'j';
 798     } elsif ( $genre eq 'journalArticle' ) {
 799             $mtx   = 'journal';
 800             $genre = 'article';
 801             $titletype = 'a';
 802     } else {
 803             $mtx = 'dc';
 804     }
 805
 806     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
 807
 808         # Setting datas
 809         $aulast  = $record->subfield( '700', 'a' ) || '';
 810         $aufirst = $record->subfield( '700', 'b' ) || '';
 811         push @authors, "$aufirst $aulast" if ($aufirst or $aulast);
 812
 813         # others authors
 814         if ( $record->field('200') ) {
 815             for my $au ( $record->field('200')->subfield('g') ) {
 816                 push @authors, $au;
 817             }
 818         }
 819
 820         $title     = $record->subfield( '200', 'a' );
 821         my $subfield_210d = $record->subfield('210', 'd');
 822         if ($subfield_210d and $subfield_210d =~ /(\d{4})/) {
 823             $pubyear = $1;
 824         }
 825         $publisher = $record->subfield( '210', 'c' ) || '';
 826         $isbn      = $record->subfield( '010', 'a' ) || '';
 827         $issn      = $record->subfield( '011', 'a' ) || '';
 828     } else {
 829
 830         # MARC21 need some improve
 831
 832         # Setting datas
 833         if ( $record->field('100') ) {
 834             push @authors, $record->subfield( '100', 'a' );
 835         }
 836
 837         # others authors
 838         if ( $record->field('700') ) {
 839             for my $au ( $record->field('700')->subfield('a') ) {
 840                 push @authors, $au;
 841             }
 842         }
 843         $title = $record->field('245');
 844         $title &&= $title->as_string('ab');
 845         if ($titletype eq 'a') {
 846             $pubyear   = $record->field('008') || '';
 847             $pubyear   = substr($pubyear->data(), 7, 4) if $pubyear;
 848             $isbn      = $record->subfield( '773', 'z' ) || '';
 849             $issn      = $record->subfield( '773', 'x' ) || '';
 850             $hosttitle = $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{};
 851             my @rels = $record->subfield( '773', 'g' );
 852             $pages = join(', ', @rels);
 853         } else {
 854             $pubyear   = $record->subfield( '260', 'c' ) || '';
 855             $publisher = $record->subfield( '260', 'b' ) || '';
 856             $isbn      = $record->subfield( '020', 'a' ) || '';
 857             $issn      = $record->subfield( '022', 'a' ) || '';
 858         }
 859
 860     }
 861
 862     my @params = (
 863         [ 'ctx_ver', 'Z39.88-2004' ],
 864         [ 'rft_val_fmt', "info:ofi/fmt:kev:mtx:$mtx" ],
 865         [ ($mtx eq 'dc' ? 'rft.type' : 'rft.genre'), $genre ],
 866         [ "rft.${titletype}title", $title ],
 867     );
 868
 869     # rft.title is authorized only once, so by checking $titletype
 870     # we ensure that rft.title is not already in the list.
 871     if ($hosttitle and $titletype) {
 872         push @params, [ 'rft.title', $hosttitle ];
 873     }
 874
 875     push @params, (
 876         [ 'rft.isbn', $isbn ],
 877         [ 'rft.issn', $issn ],
 878     );
 879
 880     # If it's a subscription, these informations have no meaning.
 881     if ($genre ne 'journal') {
 882         push @params, (
 883             [ 'rft.aulast', $aulast ],
 884             [ 'rft.aufirst', $aufirst ],
 885             (map { [ 'rft.au', $_ ] } @authors),
 886             [ 'rft.pub', $publisher ],
 887             [ 'rft.date', $pubyear ],
 888             [ 'rft.pages', $pages ],
 889         );
 890     }
 891
 892     my $coins_value = join( '&amp;',
 893         map { $$_[1] ? $$_[0] . '=' . uri_escape_utf8( $$_[1] ) : () } @params );
 894
 895     return $coins_value;
 896 }
 897
 898 =head2 get_openurl
 899
 900 my $url = $biblio->get_openurl;
 901
 902 Returns url for OpenURL resolver set in OpenURLResolverURL system preference
 903
 904 =cut
 905
 906 sub get_openurl {
 907     my ( $self ) = @_;
 908
 909     my $OpenURLResolverURL = C4::Context->preference('OpenURLResolverURL');
 910
 911     if ($OpenURLResolverURL) {
 912         my $uri = URI->new($OpenURLResolverURL);
 913
 914         if (not defined $uri->query) {
 915             $OpenURLResolverURL .= '?';
 916         } else {
 917             $OpenURLResolverURL .= '&amp;';
 918         }
 919         $OpenURLResolverURL .= $self->get_coins;
 920     }
 921
 922     return $OpenURLResolverURL;
 923 }
 924
 925 =head3 is_serial
 926
 927 my $serial = $biblio->is_serial
 928
 929 Return boolean true if this bibbliographic record is continuing resource
 930
 931 =cut
 932
 933 sub is_serial {
 934     my ( $self ) = @_;
 935
 936     return 1 if $self->serial;
 937
 938     my $record = $self->metadata->record;
 939     return 1 if substr($record->leader, 7, 1) eq 's';
 940
 941     return 0;
 942 }
 943
 944 =head3 custom_cover_image_url
 945
 946 my $image_url = $biblio->custom_cover_image_url
 947
 948 Return the specific url of the cover image for this bibliographic record.
 949 It is built regaring the value of the system preference CustomCoverImagesURL
 950
 951 =cut
 952
 953 sub custom_cover_image_url {
 954     my ( $self ) = @_;
 955     my $url = C4::Context->preference('CustomCoverImagesURL');
 956     if ( $url =~ m|{isbn}| ) {
 957         my $isbn = $self->biblioitem->isbn;
 958         return unless $isbn;
 959         $url =~ s|{isbn}|$isbn|g;
 960     }
 961     if ( $url =~ m|{normalized_isbn}| ) {
 962         my $normalized_isbn = C4::Koha::GetNormalizedISBN($self->biblioitem->isbn);
 963         return unless $normalized_isbn;
 964         $url =~ s|{normalized_isbn}|$normalized_isbn|g;
 965     }
 966     if ( $url =~ m|{issn}| ) {
 967         my $issn = $self->biblioitem->issn;
 968         return unless $issn;
 969         $url =~ s|{issn}|$issn|g;
 970     }
 971
 972     my $re = qr|{(?<field>\d{3})(\$(?<subfield>.))?}|;
 973     if ( $url =~ $re ) {
 974         my $field = $+{field};
 975         my $subfield = $+{subfield};
 976         my $marc_record = $self->metadata->record;
 977         my $value;
 978         if ( $subfield ) {
 979             $value = $marc_record->subfield( $field, $subfield );
 980         } else {
 981             my $controlfield = $marc_record->field($field);
 982             $value = $controlfield->data() if $controlfield;
 983         }
 984         return unless $value;
 985         $url =~ s|$re|$value|;
 986     }
 987
 988     return $url;
 989 }
 990
 991 =head3 cover_images
 992
 993 Return the cover images associated with this biblio.
 994
 995 =cut
 996
 997 sub cover_images {
 998     my ( $self ) = @_;
 999
1000     my $cover_images_rs = $self->_result->cover_images;
1001     return unless $cover_images_rs;
1002     return Koha::CoverImages->_new_from_dbic($cover_images_rs);
1003 }
1004
1005 =head3 get_marc_notes
1006
1007     $marcnotesarray = $biblio->get_marc_notes({ opac => 1 });
1008
1009 Get all notes from the MARC record and returns them in an array.
1010 The notes are stored in different fields depending on MARC flavour.
1011 MARC21 5XX $u subfields receive special attention as they are URIs.
1012
1013 =cut
1014
1015 sub get_marc_notes {
1016     my ( $self, $params ) = @_;
1017
1018     my $marcflavour = C4::Context->preference('marcflavour');
1019     my $opac = $params->{opac} // '0';
1020     my $interface = $params->{opac} ? 'opac' : 'intranet';
1021
1022     my $record = $params->{record} // $self->metadata->record;
1023     my $record_processor = Koha::RecordProcessor->new(
1024         {
1025             filters => [ 'ViewPolicy', 'ExpandCodedFields' ],
1026             options => {
1027                 interface     => $interface,
1028                 frameworkcode => $self->frameworkcode
1029             }
1030         }
1031     );
1032     $record_processor->process($record);
1033
1034     my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
1035     #MARC21 specs indicate some notes should be private if first indicator 0
1036     my %maybe_private = (
1037         541 => 1,
1038         542 => 1,
1039         561 => 1,
1040         583 => 1,
1041         590 => 1
1042     );
1043
1044     my %hiddenlist = map { $_ => 1 }
1045         split( /,/, C4::Context->preference('NotesToHide'));
1046
1047     my @marcnotes;
1048     foreach my $field ( $record->field($scope) ) {
1049         my $tag = $field->tag();
1050         next if $hiddenlist{ $tag };
1051         next if $opac && $maybe_private{$tag} && !$field->indicator(1);
1052         if( $marcflavour ne 'UNIMARC' && $field->subfield('u') ) {
1053             # Field 5XX$u always contains URI
1054             # Examples: 505u, 506u, 510u, 514u, 520u, 530u, 538u, 540u, 542u, 552u, 555u, 561u, 563u, 583u
1055             # We first push the other subfields, then all $u's separately
1056             # Leave further actions to the template (see e.g. opac-detail)
1057             my $othersub =
1058                 join '', ( 'a' .. 't', 'v' .. 'z', '0' .. '9' ); # excl 'u'
1059             push @marcnotes, { marcnote => $field->as_string($othersub) };
1060             foreach my $sub ( $field->subfield('u') ) {
1061                 $sub =~ s/^\s+|\s+$//g; # trim
1062                 push @marcnotes, { marcnote => $sub };
1063             }
1064         } else {
1065             push @marcnotes, { marcnote => $field->as_string() };
1066         }
1067     }
1068     return \@marcnotes;
1069 }
1070
1071 =head3 _get_marc_authors
1072
1073 Private method to return the list of authors contained in the MARC record.
1074 See get get_marc_contributors and get_marc_authors for the public methods.
1075
1076 =cut
1077
1078 sub _get_marc_authors {
1079     my ( $self, $params ) = @_;
1080
1081     my $fields_filter = $params->{fields_filter};
1082     my $mintag        = $params->{mintag};
1083     my $maxtag        = $params->{maxtag};
1084
1085     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1086     my $marcflavour        = C4::Context->preference('marcflavour');
1087
1088     # tagslib useful only for UNIMARC author responsibilities
1089     my $tagslib = $marcflavour eq "UNIMARC"
1090       ? C4::Biblio::GetMarcStructure( 1, $self->frameworkcode, { unsafe => 1 } )
1091       : undef;
1092
1093     my @marcauthors;
1094     foreach my $field ( $self->metadata->record->field($fields_filter) ) {
1095
1096         next
1097           if $mintag && $field->tag() < $mintag
1098           || $maxtag && $field->tag() > $maxtag;
1099
1100         my @subfields_loop;
1101         my @link_loop;
1102         my @subfields  = $field->subfields();
1103         my $count_auth = 0;
1104
1105         # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1106         my $subfield9 = $field->subfield('9');
1107         if ($subfield9) {
1108             my $linkvalue = $subfield9;
1109             $linkvalue =~ s/(\(|\))//g;
1110             @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1111         }
1112
1113         # other subfields
1114         my $unimarc3;
1115         for my $authors_subfield (@subfields) {
1116             next if ( $authors_subfield->[0] eq '9' );
1117
1118             # unimarc3 contains the $3 of the author for UNIMARC.
1119             # For french academic libraries, it's the "ppn", and it's required for idref webservice
1120             $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1121
1122             # don't load unimarc subfields 3, 5
1123             next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1124
1125             my $code = $authors_subfield->[0];
1126             my $value        = $authors_subfield->[1];
1127             my $linkvalue    = $value;
1128             $linkvalue =~ s/(\(|\))//g;
1129             # UNIMARC author responsibility
1130             if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1131                 $value = C4::Biblio::GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1132                 $linkvalue = "($value)";
1133             }
1134             # if no authority link, build a search query
1135             unless ($subfield9) {
1136                 push @link_loop, {
1137                     limit    => 'au',
1138                     'link'   => $linkvalue,
1139                     operator => (scalar @link_loop) ? ' AND ' : undef
1140                 };
1141             }
1142             my @this_link_loop = @link_loop;
1143             # do not display $0
1144             unless ( $code eq '0') {
1145                 push @subfields_loop, {
1146                     tag       => $field->tag(),
1147                     code      => $code,
1148                     value     => $value,
1149                     link_loop => \@this_link_loop,
1150                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1151                 };
1152             }
1153         }
1154         push @marcauthors, {
1155             MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1156             authoritylink => $subfield9,
1157             unimarc3 => $unimarc3
1158         };
1159     }
1160     return \@marcauthors;
1161 }
1162
1163 =head3 get_marc_contributors
1164
1165     my $contributors = $biblio->get_marc_contributors;
1166
1167 Get all contributors (but first author) from the MARC record and returns them in an array.
1168 They are stored in different fields depending on MARC flavour (700..720 for MARC21)
1169
1170 =cut
1171
1172 sub get_marc_contributors {
1173     my ( $self, $params ) = @_;
1174
1175     my ( $mintag, $maxtag, $fields_filter );
1176     my $marcflavour = C4::Context->preference('marcflavour');
1177
1178     if ( $marcflavour eq "UNIMARC" ) {
1179         $mintag = "700";
1180         $maxtag = "712";
1181         $fields_filter = '7..';
1182     } else { # marc21/normarc
1183         $mintag = "700";
1184         $maxtag = "720";
1185         $fields_filter = '7..';
1186     }
1187
1188     return $self->_get_marc_authors(
1189         {
1190             fields_filter => $fields_filter,
1191             mintag       => $mintag,
1192             maxtag       => $maxtag
1193         }
1194     );
1195 }
1196
1197 =head3 get_marc_authors
1198
1199     my $authors = $biblio->get_marc_authors;
1200
1201 Get all authors from the MARC record and returns them in an array.
1202 They are stored in different fields depending on MARC flavour
1203 (main author from 100 then secondary authors from 700..720).
1204
1205 =cut
1206
1207 sub get_marc_authors {
1208     my ( $self, $params ) = @_;
1209
1210     my ( $mintag, $maxtag, $fields_filter );
1211     my $marcflavour = C4::Context->preference('marcflavour');
1212
1213     if ( $marcflavour eq "UNIMARC" ) {
1214         $fields_filter = '200';
1215     } else { # marc21/normarc
1216         $fields_filter = '100';
1217     }
1218
1219     my @first_authors = @{$self->_get_marc_authors(
1220         {
1221             fields_filter => $fields_filter,
1222             mintag       => $mintag,
1223             maxtag       => $maxtag
1224         }
1225     )};
1226
1227     my @other_authors = @{$self->get_marc_contributors};
1228
1229     return [@first_authors, @other_authors];
1230 }
1231
1232
1233 =head3 to_api
1234
1235     my $json = $biblio->to_api;
1236
1237 Overloaded method that returns a JSON representation of the Koha::Biblio object,
1238 suitable for API output. The related Koha::Biblioitem object is merged as expected
1239 on the API.
1240
1241 =cut
1242
1243 sub to_api {
1244     my ($self, $args) = @_;
1245
1246     my $response = $self->SUPER::to_api( $args );
1247     my $biblioitem = $self->biblioitem->to_api;
1248
1249     return { %$response, %$biblioitem };
1250 }
1251
1252 =head3 to_api_mapping
1253
1254 This method returns the mapping for representing a Koha::Biblio object
1255 on the API.
1256
1257 =cut
1258
1259 sub to_api_mapping {
1260     return {
1261         biblionumber     => 'biblio_id',
1262         frameworkcode    => 'framework_id',
1263         unititle         => 'uniform_title',
1264         seriestitle      => 'series_title',
1265         copyrightdate    => 'copyright_date',
1266         datecreated      => 'creation_date',
1267         deleted_on       => undef,
1268     };
1269 }
1270
1271 =head3 get_marc_host
1272
1273     $host = $biblio->get_marc_host;
1274     # OR:
1275     ( $host, $relatedparts, $hostinfo ) = $biblio->get_marc_host;
1276
1277     Returns host biblio record from MARC21 773 (undef if no 773 present).
1278     It looks at the first 773 field with MARCorgCode or only a control
1279     number. Complete $w or numeric part is used to search host record.
1280     The optional parameter no_items triggers a check if $biblio has items.
1281     If there are, the sub returns undef.
1282     Called in list context, it also returns 773$g (related parts).
1283
1284     If there is no $w, we use $0 (host biblionumber) or $9 (host itemnumber)
1285     to search for the host record. If there is also no $0 and no $9, we search
1286     using author and title. Failing all of that, we return an undef host and
1287     form a concatenation of strings with 773$agt for host information,
1288     returned when called in list context.
1289
1290 =cut
1291
1292 sub get_marc_host {
1293     my ($self, $params) = @_;
1294     my $no_items = $params->{no_items};
1295     return if C4::Context->preference('marcflavour') eq 'UNIMARC'; # TODO
1296     return if $params->{no_items} && $self->items->count > 0;
1297
1298     my $record;
1299     eval { $record = $self->metadata->record };
1300     return if !$record;
1301
1302     # We pick the first $w with your MARCOrgCode or the first $w that has no
1303     # code (between parentheses) at all.
1304     my $orgcode = C4::Context->preference('MARCOrgCode') // q{};
1305     my $hostfld;
1306     foreach my $f ( $record->field('773') ) {
1307         my $w = $f->subfield('w') or next;
1308         if( $w =~ /^\($orgcode\)\s*(\d+)/i or $w =~ /^\d+/ ) {
1309             $hostfld = $f;
1310             last;
1311         }
1312     }
1313
1314     my $engine = Koha::SearchEngine::Search->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
1315     my $bibno;
1316     if ( !$hostfld and $record->subfield('773','t') ) {
1317         # not linked using $w
1318         my $unlinkedf = $record->field('773');
1319         my $host;
1320         if ( C4::Context->preference("EasyAnalyticalRecords") ) {
1321             if ( $unlinkedf->subfield('0') ) {
1322                 # use 773$0 host biblionumber
1323                 $bibno = $unlinkedf->subfield('0');
1324             } elsif ( $unlinkedf->subfield('9') ) {
1325                 # use 773$9 host itemnumber
1326                 my $linkeditemnumber = $unlinkedf->subfield('9');
1327                 $bibno = Koha::Items->find( $linkeditemnumber )->biblionumber;
1328             }
1329         }
1330         if ( $bibno ) {
1331             my $host = Koha::Biblios->find($bibno) or return;
1332             return wantarray ? ( $host, $unlinkedf->subfield('g') ) : $host;
1333         }
1334         # just return plaintext and no host record
1335         my $hostinfo = join( ", ", $unlinkedf->subfield('a'), $unlinkedf->subfield('t'), $unlinkedf->subfield('g') );
1336         return wantarray ? ( undef, $unlinkedf->subfield('g'), $hostinfo ) : undef;
1337     }
1338     return if !$hostfld;
1339     my $rcn = $hostfld->subfield('w');
1340
1341     # Look for control number with/without orgcode
1342     for my $try (1..2) {
1343         my ( $error, $results, $total_hits ) = $engine->simple_search_compat( 'Control-number='.$rcn, 0,1 );
1344         if( !$error and $total_hits == 1 ) {
1345             $bibno = $engine->extract_biblionumber( $results->[0] );
1346             last;
1347         }
1348         # Add or remove orgcode for second try
1349         if( $try == 1 && $rcn =~ /\)\s*(\d+)/ ) {
1350             $rcn = $1; # number only
1351         } elsif( $try == 1 && $rcn =~ /^\d+/ ) {
1352             $rcn = "($orgcode)$rcn";
1353         } else {
1354             last;
1355         }
1356     }
1357     if( $bibno ) {
1358         my $host = Koha::Biblios->find($bibno) or return;
1359         return wantarray ? ( $host, $hostfld->subfield('g') ) : $host;
1360     }
1361 }
1362
1363 =head3 get_marc_host_only
1364
1365     my $host = $biblio->get_marc_host_only;
1366
1367 Return host only
1368
1369 =cut
1370
1371 sub get_marc_host_only {
1372     my ($self) = @_;
1373
1374     my ( $host ) = $self->get_marc_host;
1375
1376     return $host;
1377 }
1378
1379 =head3 get_marc_relatedparts_only
1380
1381     my $relatedparts = $biblio->get_marc_relatedparts_only;
1382
1383 Return related parts only
1384
1385 =cut
1386
1387 sub get_marc_relatedparts_only {
1388     my ($self) = @_;
1389
1390     my ( undef, $relatedparts ) = $self->get_marc_host;
1391
1392     return $relatedparts;
1393 }
1394
1395 =head3 get_marc_hostinfo_only
1396
1397     my $hostinfo = $biblio->get_marc_hostinfo_only;
1398
1399 Return host info only
1400
1401 =cut
1402
1403 sub get_marc_hostinfo_only {
1404     my ($self) = @_;
1405
1406     my ( $host, $relatedparts, $hostinfo ) = $self->get_marc_host;
1407
1408     return $hostinfo;
1409 }
1410
1411 =head3 recalls
1412
1413     my $recalls = $biblio->recalls;
1414
1415 Return recalls linked to this biblio
1416
1417 =cut
1418
1419 sub recalls {
1420     my ( $self ) = @_;
1421     return Koha::Recalls->_new_from_dbic( scalar $self->_result->recalls );
1422 }
1423
1424 =head3 can_be_recalled
1425
1426     my @items_for_recall = $biblio->can_be_recalled({ patron => $patron_object });
1427
1428 Does biblio-level checks and returns the items attached to this biblio that are available for recall
1429
1430 =cut
1431
1432 sub can_be_recalled {
1433     my ( $self, $params ) = @_;
1434
1435     return 0 if !( C4::Context->preference('UseRecalls') );
1436
1437     my $patron = $params->{patron};
1438
1439     my $branchcode = C4::Context->userenv->{'branch'};
1440     if ( C4::Context->preference('CircControl') eq 'PatronLibrary' and $patron ) {
1441         $branchcode = $patron->branchcode;
1442     }
1443
1444     my @all_items = Koha::Items->search({ biblionumber => $self->biblionumber })->as_list;
1445
1446     # if there are no available items at all, no recall can be placed
1447     return 0 if ( scalar @all_items == 0 );
1448
1449     my @itemtypes;
1450     my @itemnumbers;
1451     my @items;
1452     my @all_itemnumbers;
1453     foreach my $item ( @all_items ) {
1454         push( @all_itemnumbers, $item->itemnumber );
1455         if ( $item->can_be_recalled({ patron => $patron }) ) {
1456             push( @itemtypes, $item->effective_itemtype );
1457             push( @itemnumbers, $item->itemnumber );
1458             push( @items, $item );
1459         }
1460     }
1461
1462     # if there are no recallable items, no recall can be placed
1463     return 0 if ( scalar @items == 0 );
1464
1465     # Check the circulation rule for each relevant itemtype for this biblio
1466     my ( @recalls_allowed, @recalls_per_record, @on_shelf_recalls );
1467     foreach my $itemtype ( @itemtypes ) {
1468         my $rule = Koha::CirculationRules->get_effective_rules({
1469             branchcode => $branchcode,
1470             categorycode => $patron ? $patron->categorycode : undef,
1471             itemtype => $itemtype,
1472             rules => [
1473                 'recalls_allowed',
1474                 'recalls_per_record',
1475                 'on_shelf_recalls',
1476             ],
1477         });
1478         push( @recalls_allowed, $rule->{recalls_allowed} ) if $rule;
1479         push( @recalls_per_record, $rule->{recalls_per_record} ) if $rule;
1480         push( @on_shelf_recalls, $rule->{on_shelf_recalls} ) if $rule;
1481     }
1482     my $recalls_allowed = (sort {$b <=> $a} @recalls_allowed)[0]; # take highest
1483     my $recalls_per_record = (sort {$b <=> $a} @recalls_per_record)[0]; # take highest
1484     my %on_shelf_recalls_count = ();
1485     foreach my $count ( @on_shelf_recalls ) {
1486         $on_shelf_recalls_count{$count}++;
1487     }
1488     my $on_shelf_recalls = (sort {$on_shelf_recalls_count{$b} <=> $on_shelf_recalls_count{$a}} @on_shelf_recalls)[0]; # take most common
1489
1490     # check recalls allowed has been set and is not zero
1491     return 0 if ( !defined($recalls_allowed) || $recalls_allowed == 0 );
1492
1493     if ( $patron ) {
1494         # check borrower has not reached open recalls allowed limit
1495         return 0 if ( $patron->recalls->filter_by_current->count >= $recalls_allowed );
1496
1497         # check borrower has not reached open recalls allowed per record limit
1498         return 0 if ( $patron->recalls->filter_by_current->search({ biblio_id => $self->biblionumber })->count >= $recalls_per_record );
1499
1500         # check if any of the items under this biblio are already checked out by this borrower
1501         return 0 if ( Koha::Checkouts->search({ itemnumber => [ @all_itemnumbers ], borrowernumber => $patron->borrowernumber })->count > 0 );
1502     }
1503
1504     # check item availability
1505     my $checked_out_count = 0;
1506     foreach (@items) {
1507         if ( Koha::Checkouts->search({ itemnumber => $_->itemnumber })->count > 0 ){ $checked_out_count++; }
1508     }
1509
1510     # can't recall if on shelf recalls only allowed when all unavailable, but items are still available for checkout
1511     return 0 if ( $on_shelf_recalls eq 'all' && $checked_out_count < scalar @items );
1512
1513     # can't recall if no items have been checked out
1514     return 0 if ( $checked_out_count == 0 );
1515
1516     # can recall
1517     return @items;
1518 }
1519
1520 =head2 Internal methods
1521
1522 =head3 type
1523
1524 =cut
1525
1526 sub _type {
1527     return 'Biblio';
1528 }
1529
1530 =head1 AUTHOR
1531
1532 Kyle M Hall <kyle@bywatersolutions.com>
1533
1534 =cut
1535
1536 1;