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