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