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