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