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