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