Koha/Biblio.pm

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