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 GetNormalizedUPC GetNormalizedOCLCNumber );
  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, tag => $tag };
1084             }
1085         } else {
1086             push @marcnotes, { marcnote => $field->as_string(), tag => $tag };
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 public_read_list
1268
1269 This method returns the list of publicly readable database fields for both API and UI output purposes
1270
1271 =cut
1272
1273 sub public_read_list {
1274     return [
1275         'biblionumber',   'frameworkcode',   'author',
1276         'title',          'medium',          'subtitle',
1277         'part_number',    'part_name',       'unititle',
1278         'notes',          'serial',          'seriestitle',
1279         'copyrightdate',  'abstract'
1280     ];
1281 }
1282
1283 =head3 normalized_upc
1284
1285     my $normalized_upc = $biblio->normalized_upc
1286
1287 Normalizes and returns the UPC value found in the MARC record.
1288
1289 =cut
1290
1291 sub normalized_upc {
1292     my ($self) = @_;
1293     my $marc_record = $self->metadata->record;
1294     return C4::Koha::GetNormalizedUPC($marc_record);
1295 }
1296
1297 =head3 normalized_oclc
1298
1299     my $normalized_oclc = $biblio->normalized_oclc
1300
1301 Normalizes and returns the OCLC number found in the MARC record.
1302
1303 =cut
1304
1305 sub normalized_oclc {
1306     my ( $self ) = @_;
1307     my $marc_record = $self->metadata->record;
1308     return C4::Koha::GetNormalizedOCLCNumber( $marc_record );
1309 }
1310
1311 =head3 to_api
1312
1313     my $json = $biblio->to_api;
1314
1315 Overloaded method that returns a JSON representation of the Koha::Biblio object,
1316 suitable for API output. The related Koha::Biblioitem object is merged as expected
1317 on the API.
1318
1319 =cut
1320
1321 sub to_api {
1322     my ($self, $args) = @_;
1323
1324     my $response = $self->SUPER::to_api( $args );
1325
1326     $args = defined $args ? {%$args} : {};
1327     delete $args->{embed};
1328
1329     my $biblioitem = $self->biblioitem->to_api( $args );
1330
1331     return { %$response, %$biblioitem };
1332 }
1333
1334 =head3 to_api_mapping
1335
1336 This method returns the mapping for representing a Koha::Biblio object
1337 on the API.
1338
1339 =cut
1340
1341 sub to_api_mapping {
1342     return {
1343         biblionumber     => 'biblio_id',
1344         frameworkcode    => 'framework_id',
1345         unititle         => 'uniform_title',
1346         seriestitle      => 'series_title',
1347         copyrightdate    => 'copyright_date',
1348         datecreated      => 'creation_date',
1349         deleted_on       => undef,
1350     };
1351 }
1352
1353 =head3 get_marc_host
1354
1355     $host = $biblio->get_marc_host;
1356     # OR:
1357     ( $host, $relatedparts, $hostinfo ) = $biblio->get_marc_host;
1358
1359     Returns host biblio record from MARC21 773 (undef if no 773 present).
1360     It looks at the first 773 field with MARCorgCode or only a control
1361     number. Complete $w or numeric part is used to search host record.
1362     The optional parameter no_items triggers a check if $biblio has items.
1363     If there are, the sub returns undef.
1364     Called in list context, it also returns 773$g (related parts).
1365
1366     If there is no $w, we use $0 (host biblionumber) or $9 (host itemnumber)
1367     to search for the host record. If there is also no $0 and no $9, we search
1368     using author and title. Failing all of that, we return an undef host and
1369     form a concatenation of strings with 773$agt for host information,
1370     returned when called in list context.
1371
1372 =cut
1373
1374 sub get_marc_host {
1375     my ($self, $params) = @_;
1376     my $no_items = $params->{no_items};
1377     return if C4::Context->preference('marcflavour') eq 'UNIMARC'; # TODO
1378     return if $params->{no_items} && $self->items->count > 0;
1379
1380     my $record;
1381     eval { $record = $self->metadata->record };
1382     return if !$record;
1383
1384     # We pick the first $w with your MARCOrgCode or the first $w that has no
1385     # code (between parentheses) at all.
1386     my $orgcode = C4::Context->preference('MARCOrgCode') // q{};
1387     my $hostfld;
1388     foreach my $f ( $record->field('773') ) {
1389         my $w = $f->subfield('w') or next;
1390         if( $w =~ /^\($orgcode\)\s*(\d+)/i or $w =~ /^\d+/ ) {
1391             $hostfld = $f;
1392             last;
1393         }
1394     }
1395
1396     my $engine = Koha::SearchEngine::Search->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
1397     my $bibno;
1398     if ( !$hostfld and $record->subfield('773','t') ) {
1399         # not linked using $w
1400         my $unlinkedf = $record->field('773');
1401         my $host;
1402         if ( C4::Context->preference("EasyAnalyticalRecords") ) {
1403             if ( $unlinkedf->subfield('0') ) {
1404                 # use 773$0 host biblionumber
1405                 $bibno = $unlinkedf->subfield('0');
1406             } elsif ( $unlinkedf->subfield('9') ) {
1407                 # use 773$9 host itemnumber
1408                 my $linkeditemnumber = $unlinkedf->subfield('9');
1409                 $bibno = Koha::Items->find( $linkeditemnumber )->biblionumber;
1410             }
1411         }
1412         if ( $bibno ) {
1413             my $host = Koha::Biblios->find($bibno) or return;
1414             return wantarray ? ( $host, $unlinkedf->subfield('g') ) : $host;
1415         }
1416         # just return plaintext and no host record
1417         my $hostinfo = join( ", ", $unlinkedf->subfield('a'), $unlinkedf->subfield('t'), $unlinkedf->subfield('g') );
1418         return wantarray ? ( undef, $unlinkedf->subfield('g'), $hostinfo ) : undef;
1419     }
1420     return if !$hostfld;
1421     my $rcn = $hostfld->subfield('w');
1422
1423     # Look for control number with/without orgcode
1424     for my $try (1..2) {
1425         my ( $error, $results, $total_hits ) = $engine->simple_search_compat( 'Control-number='.$rcn, 0,1 );
1426         if( !$error and $total_hits == 1 ) {
1427             $bibno = $engine->extract_biblionumber( $results->[0] );
1428             last;
1429         }
1430         # Add or remove orgcode for second try
1431         if( $try == 1 && $rcn =~ /\)\s*(\d+)/ ) {
1432             $rcn = $1; # number only
1433         } elsif( $try == 1 && $rcn =~ /^\d+/ ) {
1434             $rcn = "($orgcode)$rcn";
1435         } else {
1436             last;
1437         }
1438     }
1439     if( $bibno ) {
1440         my $host = Koha::Biblios->find($bibno) or return;
1441         return wantarray ? ( $host, $hostfld->subfield('g') ) : $host;
1442     }
1443 }
1444
1445 =head3 get_marc_host_only
1446
1447     my $host = $biblio->get_marc_host_only;
1448
1449 Return host only
1450
1451 =cut
1452
1453 sub get_marc_host_only {
1454     my ($self) = @_;
1455
1456     my ( $host ) = $self->get_marc_host;
1457
1458     return $host;
1459 }
1460
1461 =head3 get_marc_relatedparts_only
1462
1463     my $relatedparts = $biblio->get_marc_relatedparts_only;
1464
1465 Return related parts only
1466
1467 =cut
1468
1469 sub get_marc_relatedparts_only {
1470     my ($self) = @_;
1471
1472     my ( undef, $relatedparts ) = $self->get_marc_host;
1473
1474     return $relatedparts;
1475 }
1476
1477 =head3 get_marc_hostinfo_only
1478
1479     my $hostinfo = $biblio->get_marc_hostinfo_only;
1480
1481 Return host info only
1482
1483 =cut
1484
1485 sub get_marc_hostinfo_only {
1486     my ($self) = @_;
1487
1488     my ( $host, $relatedparts, $hostinfo ) = $self->get_marc_host;
1489
1490     return $hostinfo;
1491 }
1492
1493 =head3 recalls
1494
1495     my $recalls = $biblio->recalls;
1496
1497 Return recalls linked to this biblio
1498
1499 =cut
1500
1501 sub recalls {
1502     my ( $self ) = @_;
1503     return Koha::Recalls->_new_from_dbic( scalar $self->_result->recalls );
1504 }
1505
1506 =head3 can_be_recalled
1507
1508     my @items_for_recall = $biblio->can_be_recalled({ patron => $patron_object });
1509
1510 Does biblio-level checks and returns the items attached to this biblio that are available for recall
1511
1512 =cut
1513
1514 sub can_be_recalled {
1515     my ( $self, $params ) = @_;
1516
1517     return 0 if !( C4::Context->preference('UseRecalls') );
1518
1519     my $patron = $params->{patron};
1520
1521     my $branchcode = C4::Context->userenv->{'branch'};
1522     if ( C4::Context->preference('CircControl') eq 'PatronLibrary' and $patron ) {
1523         $branchcode = $patron->branchcode;
1524     }
1525
1526     my @all_items = Koha::Items->search({ biblionumber => $self->biblionumber })->as_list;
1527
1528     # if there are no available items at all, no recall can be placed
1529     return 0 if ( scalar @all_items == 0 );
1530
1531     my @itemtypes;
1532     my @itemnumbers;
1533     my @items;
1534     my @all_itemnumbers;
1535     foreach my $item ( @all_items ) {
1536         push( @all_itemnumbers, $item->itemnumber );
1537         if ( $item->can_be_recalled({ patron => $patron }) ) {
1538             push( @itemtypes, $item->effective_itemtype );
1539             push( @itemnumbers, $item->itemnumber );
1540             push( @items, $item );
1541         }
1542     }
1543
1544     # if there are no recallable items, no recall can be placed
1545     return 0 if ( scalar @items == 0 );
1546
1547     # Check the circulation rule for each relevant itemtype for this biblio
1548     my ( @recalls_allowed, @recalls_per_record, @on_shelf_recalls );
1549     foreach my $itemtype ( @itemtypes ) {
1550         my $rule = Koha::CirculationRules->get_effective_rules({
1551             branchcode => $branchcode,
1552             categorycode => $patron ? $patron->categorycode : undef,
1553             itemtype => $itemtype,
1554             rules => [
1555                 'recalls_allowed',
1556                 'recalls_per_record',
1557                 'on_shelf_recalls',
1558             ],
1559         });
1560         push( @recalls_allowed, $rule->{recalls_allowed} ) if $rule;
1561         push( @recalls_per_record, $rule->{recalls_per_record} ) if $rule;
1562         push( @on_shelf_recalls, $rule->{on_shelf_recalls} ) if $rule;
1563     }
1564     my $recalls_allowed = (sort {$b <=> $a} @recalls_allowed)[0]; # take highest
1565     my $recalls_per_record = (sort {$b <=> $a} @recalls_per_record)[0]; # take highest
1566     my %on_shelf_recalls_count = ();
1567     foreach my $count ( @on_shelf_recalls ) {
1568         $on_shelf_recalls_count{$count}++;
1569     }
1570     my $on_shelf_recalls = (sort {$on_shelf_recalls_count{$b} <=> $on_shelf_recalls_count{$a}} @on_shelf_recalls)[0]; # take most common
1571
1572     # check recalls allowed has been set and is not zero
1573     return 0 if ( !defined($recalls_allowed) || $recalls_allowed == 0 );
1574
1575     if ( $patron ) {
1576         # check borrower has not reached open recalls allowed limit
1577         return 0 if ( $patron->recalls->filter_by_current->count >= $recalls_allowed );
1578
1579         # check borrower has not reached open recalls allowed per record limit
1580         return 0 if ( $patron->recalls->filter_by_current->search({ biblio_id => $self->biblionumber })->count >= $recalls_per_record );
1581
1582         # check if any of the items under this biblio are already checked out by this borrower
1583         return 0 if ( Koha::Checkouts->search({ itemnumber => [ @all_itemnumbers ], borrowernumber => $patron->borrowernumber })->count > 0 );
1584     }
1585
1586     # check item availability
1587     my $checked_out_count = 0;
1588     foreach (@items) {
1589         if ( Koha::Checkouts->search({ itemnumber => $_->itemnumber })->count > 0 ){ $checked_out_count++; }
1590     }
1591
1592     # can't recall if on shelf recalls only allowed when all unavailable, but items are still available for checkout
1593     return 0 if ( $on_shelf_recalls eq 'all' && $checked_out_count < scalar @items );
1594
1595     # can't recall if no items have been checked out
1596     return 0 if ( $checked_out_count == 0 );
1597
1598     # can recall
1599     return @items;
1600 }
1601
1602 =head3 ratings
1603
1604     my $ratings = $biblio->ratings
1605
1606 Return a Koha::Ratings object representing the ratings of this bibliographic record
1607
1608 =cut
1609
1610 sub ratings {
1611     my ( $self ) = @_;
1612     my $rs = $self->_result->ratings;
1613     return Koha::Ratings->_new_from_dbic($rs);
1614 }
1615
1616 =head3 opac_summary_html
1617
1618     my $summary_html = $biblio->opac_summary_html
1619
1620 Based on the syspref OPACMySummaryHTML, returns a string representing the
1621 summary of this bibliographic record.
1622 {AUTHOR}, {TITLE}, {ISBN} and {BIBLIONUMBER} will be replaced.
1623
1624 =cut
1625
1626 sub opac_summary_html {
1627     my ($self) = @_;
1628
1629     my $summary_html = C4::Context->preference('OPACMySummaryHTML');
1630     return q{} unless $summary_html;
1631     my $author = $self->author || q{};
1632     my $title  = $self->title  || q{};
1633     $title =~ s/\/+$//;    # remove trailing slash
1634     $title =~ s/\s+$//;    # remove trailing space
1635     my $normalized_isbn = $self->normalized_isbn || q{};
1636     my $biblionumber    = $self->biblionumber;
1637
1638     $summary_html =~ s/{AUTHOR}/$author/g;
1639     $summary_html =~ s/{TITLE}/$title/g;
1640     $summary_html =~ s/{ISBN}/$normalized_isbn/g;
1641     $summary_html =~ s/{BIBLIONUMBER}/$biblionumber/g;
1642
1643     return $summary_html;
1644 }
1645
1646 =head2 Internal methods
1647
1648 =head3 type
1649
1650 =cut
1651
1652 sub _type {
1653     return 'Biblio';
1654 }
1655
1656 =head1 AUTHOR
1657
1658 Kyle M Hall <kyle@bywatersolutions.com>
1659
1660 =cut
1661
1662 1;