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