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