Koha/Biblio.pm

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