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