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::Ratings;
  48 use Koha::Recalls;
  49 use Koha::RecordProcessor;
  50 use Koha::Suggestions;
  51 use Koha::Subscriptions;
  52 use Koha::SearchEngine;
  53 use Koha::SearchEngine::Search;
  54 use Koha::SearchEngine::QueryBuilder;
  55 use Koha::Tickets;
  56
  57 =head1 NAME
  58
  59 Koha::Biblio - Koha Biblio Object class
  60
  61 =head1 API
  62
  63 =head2 Class Methods
  64
  65 =cut
  66
  67 =head3 store
  68
  69 Overloaded I<store> method to set default values
  70
  71 =cut
  72
  73 sub store {
  74     my ( $self ) = @_;
  75
  76     $self->datecreated( dt_from_string ) unless $self->datecreated;
  77
  78     return $self->SUPER::store;
  79 }
  80
  81 =head3 metadata
  82
  83 my $metadata = $biblio->metadata();
  84
  85 Returns a Koha::Biblio::Metadata object
  86
  87 =cut
  88
  89 sub metadata {
  90     my ( $self ) = @_;
  91
  92     my $metadata = $self->_result->metadata;
  93     return Koha::Biblio::Metadata->_new_from_dbic($metadata);
  94 }
  95
  96 =head3 record
  97
  98 my $record = $biblio->record();
  99
 100 Returns a Marc::Record object
 101
 102 =cut
 103
 104 sub record {
 105     my ( $self ) = @_;
 106
 107     return $self->metadata->record;
 108 }
 109
 110 =head3 record_schema
 111
 112 my $schema = $biblio->record_schema();
 113
 114 Returns the record schema (MARC21, USMARC or UNIMARC).
 115
 116 =cut
 117
 118 sub record_schema {
 119     my ( $self ) = @_;
 120
 121     return $self->metadata->schema // C4::Context->preference("marcflavour");
 122 }
 123
 124 =head3 orders
 125
 126 my $orders = $biblio->orders();
 127
 128 Returns a Koha::Acquisition::Orders object
 129
 130 =cut
 131
 132 sub orders {
 133     my ( $self ) = @_;
 134
 135     my $orders = $self->_result->orders;
 136     return Koha::Acquisition::Orders->_new_from_dbic($orders);
 137 }
 138
 139 =head3 active_orders
 140
 141 my $active_orders = $biblio->active_orders();
 142
 143 Returns the active acquisition orders related to this biblio.
 144 An order is considered active when it is not cancelled (i.e. when datecancellation
 145 is not undef).
 146
 147 =cut
 148
 149 sub active_orders {
 150     my ( $self ) = @_;
 151
 152     return $self->orders->search({ datecancellationprinted => undef });
 153 }
 154
 155 =head3 tickets
 156
 157   my $tickets = $biblio->tickets();
 158
 159 Returns all tickets linked to the biblio
 160
 161 =cut
 162
 163 sub tickets {
 164     my ( $self ) = @_;
 165     my $rs = $self->_result->tickets;
 166     return Koha::Tickets->_new_from_dbic( $rs );
 167 }
 168
 169 =head3 ill_requests
 170
 171     my $ill_requests = $biblio->ill_requests();
 172
 173 Returns a Koha::Illrequests object
 174
 175 =cut
 176
 177 sub ill_requests {
 178     my ( $self ) = @_;
 179
 180     my $ill_requests = $self->_result->ill_requests;
 181     return Koha::Illrequests->_new_from_dbic($ill_requests);
 182 }
 183
 184 =head3 item_groups
 185
 186 my $item_groups = $biblio->item_groups();
 187
 188 Returns a Koha::Biblio::ItemGroups object
 189
 190 =cut
 191
 192 sub item_groups {
 193     my ( $self ) = @_;
 194
 195     my $item_groups = $self->_result->item_groups;
 196     return Koha::Biblio::ItemGroups->_new_from_dbic($item_groups);
 197 }
 198
 199 =head3 can_article_request
 200
 201 my $bool = $biblio->can_article_request( $borrower );
 202
 203 Returns true if article requests can be made for this record
 204
 205 $borrower must be a Koha::Patron object
 206
 207 =cut
 208
 209 sub can_article_request {
 210     my ( $self, $borrower ) = @_;
 211
 212     my $rule = $self->article_request_type($borrower);
 213     return q{} if $rule eq 'item_only' && !$self->items()->count();
 214     return 1 if $rule && $rule ne 'no';
 215
 216     return q{};
 217 }
 218
 219 =head3 can_be_transferred
 220
 221 $biblio->can_be_transferred({ to => $to_library, from => $from_library })
 222
 223 Checks if at least one item of a biblio can be transferred to given library.
 224
 225 This feature is controlled by two system preferences:
 226 UseBranchTransferLimits to enable / disable the feature
 227 BranchTransferLimitsType to use either an itemnumber or ccode as an identifier
 228                          for setting the limitations
 229
 230 Performance-wise, it is recommended to use this method for a biblio instead of
 231 iterating each item of a biblio with Koha::Item->can_be_transferred().
 232
 233 Takes HASHref that can have the following parameters:
 234     MANDATORY PARAMETERS:
 235     $to   : Koha::Library
 236     OPTIONAL PARAMETERS:
 237     $from : Koha::Library # if given, only items from that
 238                           # holdingbranch are considered
 239
 240 Returns 1 if at least one of the item of a biblio can be transferred
 241 to $to_library, otherwise 0.
 242
 243 =cut
 244
 245 sub can_be_transferred {
 246     my ($self, $params) = @_;
 247
 248     my $to   = $params->{to};
 249     my $from = $params->{from};
 250
 251     return 1 unless C4::Context->preference('UseBranchTransferLimits');
 252     my $limittype = C4::Context->preference('BranchTransferLimitsType');
 253
 254     my $items;
 255     foreach my $item_of_bib ($self->items->as_list) {
 256         next unless $item_of_bib->holdingbranch;
 257         next if $from && $from->branchcode ne $item_of_bib->holdingbranch;
 258         return 1 if $item_of_bib->holdingbranch eq $to->branchcode;
 259         my $code = $limittype eq 'itemtype'
 260             ? $item_of_bib->effective_itemtype
 261             : $item_of_bib->ccode;
 262         return 1 unless $code;
 263         $items->{$code}->{$item_of_bib->holdingbranch} = 1;
 264     }
 265
 266     # At this point we will have a HASHref containing each itemtype/ccode that
 267     # this biblio has, inside which are all of the holdingbranches where those
 268     # items are located at. Then, we will query Koha::Item::Transfer::Limits to
 269     # find out whether a transfer limits for such $limittype from any of the
 270     # listed holdingbranches to the given $to library exist. If at least one
 271     # holdingbranch for that $limittype does not have a transfer limit to given
 272     # $to library, then we know that the transfer is possible.
 273     foreach my $code (keys %{$items}) {
 274         my @holdingbranches = keys %{$items->{$code}};
 275         return 1 if Koha::Item::Transfer::Limits->search({
 276             toBranch => $to->branchcode,
 277             fromBranch => { 'in' => \@holdingbranches },
 278             $limittype => $code
 279         }, {
 280             group_by => [qw/fromBranch/]
 281         })->count == scalar(@holdingbranches) ? 0 : 1;
 282     }
 283
 284     return 0;
 285 }
 286
 287
 288 =head3 pickup_locations
 289
 290     my $pickup_locations = $biblio->pickup_locations({ patron => $patron });
 291
 292 Returns a Koha::Libraries set of possible pickup locations for this biblio's items,
 293 according to patron's home library and if item can be transferred to each pickup location.
 294
 295 Throws a I<Koha::Exceptions::MissingParameter> exception if the B<mandatory> parameter I<patron>
 296 is not passed.
 297
 298 =cut
 299
 300 sub pickup_locations {
 301     my ( $self, $params ) = @_;
 302
 303     Koha::Exceptions::MissingParameter->throw( parameter => 'patron' )
 304       unless exists $params->{patron};
 305
 306     my $patron = $params->{patron};
 307
 308     my $memory_cache = Koha::Cache::Memory::Lite->get_instance();
 309     my @pickup_locations;
 310     foreach my $item ( $self->items->as_list ) {
 311         my $cache_key = sprintf "Pickup_locations:%s:%s:%s:%s:%s",
 312            $item->itype,$item->homebranch,$item->holdingbranch,$item->ccode || "",$patron->branchcode||"" ;
 313         my $item_pickup_locations = $memory_cache->get_from_cache( $cache_key );
 314         unless( $item_pickup_locations ){
 315           @{ $item_pickup_locations } = $item->pickup_locations( { patron => $patron } )->_resultset->get_column('branchcode')->all;
 316           $memory_cache->set_in_cache( $cache_key, $item_pickup_locations );
 317         }
 318         push @pickup_locations, @{ $item_pickup_locations }
 319     }
 320
 321     return Koha::Libraries->search(
 322         { branchcode => { '-in' => \@pickup_locations } }, { order_by => ['branchname'] } );
 323 }
 324
 325 =head3 hidden_in_opac
 326
 327     my $bool = $biblio->hidden_in_opac({ [ rules => $rules ] })
 328
 329 Returns true if the biblio matches the hidding criteria defined in $rules.
 330 Returns false otherwise. It involves the I<OpacHiddenItems> and
 331 I<OpacHiddenItemsHidesRecord> system preferences.
 332
 333 Takes HASHref that can have the following parameters:
 334     OPTIONAL PARAMETERS:
 335     $rules : { <field> => [ value_1, ... ], ... }
 336
 337 Note: $rules inherits its structure from the parsed YAML from reading
 338 the I<OpacHiddenItems> system preference.
 339
 340 =cut
 341
 342 sub hidden_in_opac {
 343     my ( $self, $params ) = @_;
 344
 345     my $rules = $params->{rules} // {};
 346
 347     my @items = $self->items->as_list;
 348
 349     return 0 unless @items; # Do not hide if there is no item
 350
 351     # Ok, there are items, don't even try the rules unless OpacHiddenItemsHidesRecord
 352     return 0 unless C4::Context->preference('OpacHiddenItemsHidesRecord');
 353
 354     return !(any { !$_->hidden_in_opac({ rules => $rules }) } @items);
 355 }
 356
 357 =head3 article_request_type
 358
 359 my $type = $biblio->article_request_type( $borrower );
 360
 361 Returns the article request type based on items, or on the record
 362 itself if there are no items.
 363
 364 $borrower must be a Koha::Patron object
 365
 366 =cut
 367
 368 sub article_request_type {
 369     my ( $self, $borrower ) = @_;
 370
 371     return q{} unless $borrower;
 372
 373     my $rule = $self->article_request_type_for_items( $borrower );
 374     return $rule if $rule;
 375
 376     # If the record has no items that are requestable, go by the record itemtype
 377     $rule = $self->article_request_type_for_bib($borrower);
 378     return $rule if $rule;
 379
 380     return q{};
 381 }
 382
 383 =head3 article_request_type_for_bib
 384
 385 my $type = $biblio->article_request_type_for_bib
 386
 387 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record
 388
 389 =cut
 390
 391 sub article_request_type_for_bib {
 392     my ( $self, $borrower ) = @_;
 393
 394     return q{} unless $borrower;
 395
 396     my $borrowertype = $borrower->categorycode;
 397     my $itemtype     = $self->itemtype();
 398
 399     my $rule = Koha::CirculationRules->get_effective_rule(
 400         {
 401             rule_name    => 'article_requests',
 402             categorycode => $borrowertype,
 403             itemtype     => $itemtype,
 404         }
 405     );
 406
 407     return q{} unless $rule;
 408     return $rule->rule_value || q{}
 409 }
 410
 411 =head3 article_request_type_for_items
 412
 413 my $type = $biblio->article_request_type_for_items
 414
 415 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record's items
 416
 417 If there is a conflict where some items are 'bib_only' and some are 'item_only', 'bib_only' will be returned.
 418
 419 =cut
 420
 421 sub article_request_type_for_items {
 422     my ( $self, $borrower ) = @_;
 423
 424     my $counts;
 425     foreach my $item ( $self->items()->as_list() ) {
 426         my $rule = $item->article_request_type($borrower);
 427         return $rule if $rule eq 'bib_only';    # we don't need to go any further
 428         $counts->{$rule}++;
 429     }
 430
 431     return 'item_only' if $counts->{item_only};
 432     return 'yes'       if $counts->{yes};
 433     return 'no'        if $counts->{no};
 434     return q{};
 435 }
 436
 437 =head3 article_requests
 438
 439     my $article_requests = $biblio->article_requests
 440
 441 Returns the article requests associated with this biblio
 442
 443 =cut
 444
 445 sub article_requests {
 446     my ( $self ) = @_;
 447
 448     return Koha::ArticleRequests->_new_from_dbic( scalar $self->_result->article_requests );
 449 }
 450
 451 =head3 current_checkouts
 452
 453     my $current_checkouts = $biblio->current_checkouts
 454
 455 Returns the current checkouts associated with this biblio
 456
 457 =cut
 458
 459 sub current_checkouts {
 460     my ($self) = @_;
 461
 462     return Koha::Checkouts->search( { "item.biblionumber" => $self->id },
 463         { join => 'item' } );
 464 }
 465
 466 =head3 old_checkouts
 467
 468     my $old_checkouts = $biblio->old_checkouts
 469
 470 Returns the past checkouts associated with this biblio
 471
 472 =cut
 473
 474 sub old_checkouts {
 475     my ( $self ) = @_;
 476
 477     return Koha::Old::Checkouts->search( { "item.biblionumber" => $self->id },
 478         { join => 'item' } );
 479 }
 480
 481 =head3 items
 482
 483 my $items = $biblio->items({ [ host_items => 1 ] });
 484
 485 The optional param host_items allows you to include 'analytical' items.
 486
 487 Returns the related Koha::Items object for this biblio
 488
 489 =cut
 490
 491 sub items {
 492     my ($self,$params) = @_;
 493
 494     my $items_rs = $self->_result->items;
 495
 496     return Koha::Items->_new_from_dbic( $items_rs ) unless $params->{host_items};
 497
 498     my @itemnumbers = $items_rs->get_column('itemnumber')->all;
 499     my $host_itemnumbers = $self->_host_itemnumbers();
 500     push @itemnumbers, @{ $host_itemnumbers };
 501     return Koha::Items->search({ "me.itemnumber" => { -in => \@itemnumbers } });
 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 = $self->normalized_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 =head3 normalized_isbn
1254
1255     my $normalized_isbn = $biblio->normalized_isbn
1256
1257 Normalizes and returns the first valid ISBN found in the record.
1258 ISBN13 are converted into ISBN10. This is required to get some book cover images.
1259
1260 =cut
1261
1262 sub normalized_isbn {
1263     my ( $self) = @_;
1264     return C4::Koha::GetNormalizedISBN($self->biblioitem->isbn);
1265 }
1266
1267 =head3 to_api
1268
1269     my $json = $biblio->to_api;
1270
1271 Overloaded method that returns a JSON representation of the Koha::Biblio object,
1272 suitable for API output. The related Koha::Biblioitem object is merged as expected
1273 on the API.
1274
1275 =cut
1276
1277 sub to_api {
1278     my ($self, $args) = @_;
1279
1280     my $response = $self->SUPER::to_api( $args );
1281     my $biblioitem = $self->biblioitem->to_api;
1282
1283     return { %$response, %$biblioitem };
1284 }
1285
1286 =head3 to_api_mapping
1287
1288 This method returns the mapping for representing a Koha::Biblio object
1289 on the API.
1290
1291 =cut
1292
1293 sub to_api_mapping {
1294     return {
1295         biblionumber     => 'biblio_id',
1296         frameworkcode    => 'framework_id',
1297         unititle         => 'uniform_title',
1298         seriestitle      => 'series_title',
1299         copyrightdate    => 'copyright_date',
1300         datecreated      => 'creation_date',
1301         deleted_on       => undef,
1302     };
1303 }
1304
1305 =head3 get_marc_host
1306
1307     $host = $biblio->get_marc_host;
1308     # OR:
1309     ( $host, $relatedparts, $hostinfo ) = $biblio->get_marc_host;
1310
1311     Returns host biblio record from MARC21 773 (undef if no 773 present).
1312     It looks at the first 773 field with MARCorgCode or only a control
1313     number. Complete $w or numeric part is used to search host record.
1314     The optional parameter no_items triggers a check if $biblio has items.
1315     If there are, the sub returns undef.
1316     Called in list context, it also returns 773$g (related parts).
1317
1318     If there is no $w, we use $0 (host biblionumber) or $9 (host itemnumber)
1319     to search for the host record. If there is also no $0 and no $9, we search
1320     using author and title. Failing all of that, we return an undef host and
1321     form a concatenation of strings with 773$agt for host information,
1322     returned when called in list context.
1323
1324 =cut
1325
1326 sub get_marc_host {
1327     my ($self, $params) = @_;
1328     my $no_items = $params->{no_items};
1329     return if C4::Context->preference('marcflavour') eq 'UNIMARC'; # TODO
1330     return if $params->{no_items} && $self->items->count > 0;
1331
1332     my $record;
1333     eval { $record = $self->metadata->record };
1334     return if !$record;
1335
1336     # We pick the first $w with your MARCOrgCode or the first $w that has no
1337     # code (between parentheses) at all.
1338     my $orgcode = C4::Context->preference('MARCOrgCode') // q{};
1339     my $hostfld;
1340     foreach my $f ( $record->field('773') ) {
1341         my $w = $f->subfield('w') or next;
1342         if( $w =~ /^\($orgcode\)\s*(\d+)/i or $w =~ /^\d+/ ) {
1343             $hostfld = $f;
1344             last;
1345         }
1346     }
1347
1348     my $engine = Koha::SearchEngine::Search->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
1349     my $bibno;
1350     if ( !$hostfld and $record->subfield('773','t') ) {
1351         # not linked using $w
1352         my $unlinkedf = $record->field('773');
1353         my $host;
1354         if ( C4::Context->preference("EasyAnalyticalRecords") ) {
1355             if ( $unlinkedf->subfield('0') ) {
1356                 # use 773$0 host biblionumber
1357                 $bibno = $unlinkedf->subfield('0');
1358             } elsif ( $unlinkedf->subfield('9') ) {
1359                 # use 773$9 host itemnumber
1360                 my $linkeditemnumber = $unlinkedf->subfield('9');
1361                 $bibno = Koha::Items->find( $linkeditemnumber )->biblionumber;
1362             }
1363         }
1364         if ( $bibno ) {
1365             my $host = Koha::Biblios->find($bibno) or return;
1366             return wantarray ? ( $host, $unlinkedf->subfield('g') ) : $host;
1367         }
1368         # just return plaintext and no host record
1369         my $hostinfo = join( ", ", $unlinkedf->subfield('a'), $unlinkedf->subfield('t'), $unlinkedf->subfield('g') );
1370         return wantarray ? ( undef, $unlinkedf->subfield('g'), $hostinfo ) : undef;
1371     }
1372     return if !$hostfld;
1373     my $rcn = $hostfld->subfield('w');
1374
1375     # Look for control number with/without orgcode
1376     for my $try (1..2) {
1377         my ( $error, $results, $total_hits ) = $engine->simple_search_compat( 'Control-number='.$rcn, 0,1 );
1378         if( !$error and $total_hits == 1 ) {
1379             $bibno = $engine->extract_biblionumber( $results->[0] );
1380             last;
1381         }
1382         # Add or remove orgcode for second try
1383         if( $try == 1 && $rcn =~ /\)\s*(\d+)/ ) {
1384             $rcn = $1; # number only
1385         } elsif( $try == 1 && $rcn =~ /^\d+/ ) {
1386             $rcn = "($orgcode)$rcn";
1387         } else {
1388             last;
1389         }
1390     }
1391     if( $bibno ) {
1392         my $host = Koha::Biblios->find($bibno) or return;
1393         return wantarray ? ( $host, $hostfld->subfield('g') ) : $host;
1394     }
1395 }
1396
1397 =head3 get_marc_host_only
1398
1399     my $host = $biblio->get_marc_host_only;
1400
1401 Return host only
1402
1403 =cut
1404
1405 sub get_marc_host_only {
1406     my ($self) = @_;
1407
1408     my ( $host ) = $self->get_marc_host;
1409
1410     return $host;
1411 }
1412
1413 =head3 get_marc_relatedparts_only
1414
1415     my $relatedparts = $biblio->get_marc_relatedparts_only;
1416
1417 Return related parts only
1418
1419 =cut
1420
1421 sub get_marc_relatedparts_only {
1422     my ($self) = @_;
1423
1424     my ( undef, $relatedparts ) = $self->get_marc_host;
1425
1426     return $relatedparts;
1427 }
1428
1429 =head3 get_marc_hostinfo_only
1430
1431     my $hostinfo = $biblio->get_marc_hostinfo_only;
1432
1433 Return host info only
1434
1435 =cut
1436
1437 sub get_marc_hostinfo_only {
1438     my ($self) = @_;
1439
1440     my ( $host, $relatedparts, $hostinfo ) = $self->get_marc_host;
1441
1442     return $hostinfo;
1443 }
1444
1445 =head3 recalls
1446
1447     my $recalls = $biblio->recalls;
1448
1449 Return recalls linked to this biblio
1450
1451 =cut
1452
1453 sub recalls {
1454     my ( $self ) = @_;
1455     return Koha::Recalls->_new_from_dbic( scalar $self->_result->recalls );
1456 }
1457
1458 =head3 can_be_recalled
1459
1460     my @items_for_recall = $biblio->can_be_recalled({ patron => $patron_object });
1461
1462 Does biblio-level checks and returns the items attached to this biblio that are available for recall
1463
1464 =cut
1465
1466 sub can_be_recalled {
1467     my ( $self, $params ) = @_;
1468
1469     return 0 if !( C4::Context->preference('UseRecalls') );
1470
1471     my $patron = $params->{patron};
1472
1473     my $branchcode = C4::Context->userenv->{'branch'};
1474     if ( C4::Context->preference('CircControl') eq 'PatronLibrary' and $patron ) {
1475         $branchcode = $patron->branchcode;
1476     }
1477
1478     my @all_items = Koha::Items->search({ biblionumber => $self->biblionumber })->as_list;
1479
1480     # if there are no available items at all, no recall can be placed
1481     return 0 if ( scalar @all_items == 0 );
1482
1483     my @itemtypes;
1484     my @itemnumbers;
1485     my @items;
1486     my @all_itemnumbers;
1487     foreach my $item ( @all_items ) {
1488         push( @all_itemnumbers, $item->itemnumber );
1489         if ( $item->can_be_recalled({ patron => $patron }) ) {
1490             push( @itemtypes, $item->effective_itemtype );
1491             push( @itemnumbers, $item->itemnumber );
1492             push( @items, $item );
1493         }
1494     }
1495
1496     # if there are no recallable items, no recall can be placed
1497     return 0 if ( scalar @items == 0 );
1498
1499     # Check the circulation rule for each relevant itemtype for this biblio
1500     my ( @recalls_allowed, @recalls_per_record, @on_shelf_recalls );
1501     foreach my $itemtype ( @itemtypes ) {
1502         my $rule = Koha::CirculationRules->get_effective_rules({
1503             branchcode => $branchcode,
1504             categorycode => $patron ? $patron->categorycode : undef,
1505             itemtype => $itemtype,
1506             rules => [
1507                 'recalls_allowed',
1508                 'recalls_per_record',
1509                 'on_shelf_recalls',
1510             ],
1511         });
1512         push( @recalls_allowed, $rule->{recalls_allowed} ) if $rule;
1513         push( @recalls_per_record, $rule->{recalls_per_record} ) if $rule;
1514         push( @on_shelf_recalls, $rule->{on_shelf_recalls} ) if $rule;
1515     }
1516     my $recalls_allowed = (sort {$b <=> $a} @recalls_allowed)[0]; # take highest
1517     my $recalls_per_record = (sort {$b <=> $a} @recalls_per_record)[0]; # take highest
1518     my %on_shelf_recalls_count = ();
1519     foreach my $count ( @on_shelf_recalls ) {
1520         $on_shelf_recalls_count{$count}++;
1521     }
1522     my $on_shelf_recalls = (sort {$on_shelf_recalls_count{$b} <=> $on_shelf_recalls_count{$a}} @on_shelf_recalls)[0]; # take most common
1523
1524     # check recalls allowed has been set and is not zero
1525     return 0 if ( !defined($recalls_allowed) || $recalls_allowed == 0 );
1526
1527     if ( $patron ) {
1528         # check borrower has not reached open recalls allowed limit
1529         return 0 if ( $patron->recalls->filter_by_current->count >= $recalls_allowed );
1530
1531         # check borrower has not reached open recalls allowed per record limit
1532         return 0 if ( $patron->recalls->filter_by_current->search({ biblio_id => $self->biblionumber })->count >= $recalls_per_record );
1533
1534         # check if any of the items under this biblio are already checked out by this borrower
1535         return 0 if ( Koha::Checkouts->search({ itemnumber => [ @all_itemnumbers ], borrowernumber => $patron->borrowernumber })->count > 0 );
1536     }
1537
1538     # check item availability
1539     my $checked_out_count = 0;
1540     foreach (@items) {
1541         if ( Koha::Checkouts->search({ itemnumber => $_->itemnumber })->count > 0 ){ $checked_out_count++; }
1542     }
1543
1544     # can't recall if on shelf recalls only allowed when all unavailable, but items are still available for checkout
1545     return 0 if ( $on_shelf_recalls eq 'all' && $checked_out_count < scalar @items );
1546
1547     # can't recall if no items have been checked out
1548     return 0 if ( $checked_out_count == 0 );
1549
1550     # can recall
1551     return @items;
1552 }
1553
1554 =head3 ratings
1555
1556     my $ratings = $biblio->ratings
1557
1558 Return a Koha::Ratings object representing the ratings of this bibliographic record
1559
1560 =cut
1561
1562 sub ratings {
1563     my ( $self ) = @_;
1564     my $rs = $self->_result->ratings;
1565     return Koha::Ratings->_new_from_dbic($rs);
1566 }
1567
1568 =head3 opac_summary_html
1569
1570     my $summary_html = $biblio->opac_summary_html
1571
1572 Based on the syspref OPACMySummaryHTML, returns a string representing the
1573 summary of this bibliographic record.
1574 {AUTHOR}, {TITLE}, {ISBN} and {BIBLIONUMBER} will be replaced.
1575
1576 =cut
1577
1578 sub opac_summary_html {
1579     my ($self) = @_;
1580
1581     my $summary_html = C4::Context->preference('OPACMySummaryHTML');
1582     return q{} unless $summary_html;
1583     my $author = $self->author || q{};
1584     my $title  = $self->title  || q{};
1585     $title =~ s/\/+$//;    # remove trailing slash
1586     $title =~ s/\s+$//;    # remove trailing space
1587     my $normalized_isbn = $self->normalized_isbn || q{};
1588     my $biblionumber    = $self->biblionumber;
1589
1590     $summary_html =~ s/{AUTHOR}/$author/g;
1591     $summary_html =~ s/{TITLE}/$title/g;
1592     $summary_html =~ s/{ISBN}/$normalized_isbn/g;
1593     $summary_html =~ s/{BIBLIONUMBER}/$biblionumber/g;
1594
1595     return $summary_html;
1596 }
1597
1598 =head2 Internal methods
1599
1600 =head3 type
1601
1602 =cut
1603
1604 sub _type {
1605     return 'Biblio';
1606 }
1607
1608 =head1 AUTHOR
1609
1610 Kyle M Hall <kyle@bywatersolutions.com>
1611
1612 =cut
1613
1614 1;