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