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 subscriptions
 720
 721 my $subscriptions = $self->subscriptions
 722
 723 Returns the related Koha::Subscriptions object for this Biblio object
 724
 725 =cut
 726
 727 sub subscriptions {
 728     my ($self) = @_;
 729     my $rs = $self->_result->subscriptions;
 730     return Koha::Subscriptions->_new_from_dbic($rs);
 731 }
 732
 733 =head3 has_items_waiting_or_intransit
 734
 735 my $itemsWaitingOrInTransit = $biblio->has_items_waiting_or_intransit
 736
 737 Tells if this bibliographic record has items waiting or in transit.
 738
 739 =cut
 740
 741 sub has_items_waiting_or_intransit {
 742     my ( $self ) = @_;
 743
 744     if ( Koha::Holds->search({ biblionumber => $self->id,
 745                                found => ['W', 'T'] })->count ) {
 746         return 1;
 747     }
 748
 749     foreach my $item ( $self->items->as_list ) {
 750         return 1 if $item->get_transfer;
 751     }
 752
 753     return 0;
 754 }
 755
 756 =head2 get_coins
 757
 758 my $coins = $biblio->get_coins;
 759
 760 Returns the COinS (a span) which can be included in a biblio record
 761
 762 =cut
 763
 764 sub get_coins {
 765     my ( $self ) = @_;
 766
 767     my $record = $self->metadata->record;
 768
 769     my $pos7 = substr $record->leader(), 7, 1;
 770     my $pos6 = substr $record->leader(), 6, 1;
 771     my $mtx;
 772     my $genre;
 773     my ( $aulast, $aufirst ) = ( '', '' );
 774     my @authors;
 775     my $title;
 776     my $hosttitle;
 777     my $pubyear   = '';
 778     my $isbn      = '';
 779     my $issn      = '';
 780     my $publisher = '';
 781     my $pages     = '';
 782     my $titletype = '';
 783
 784     # For the purposes of generating COinS metadata, LDR/06-07 can be
 785     # considered the same for UNIMARC and MARC21
 786     my $fmts6 = {
 787         'a' => 'book',
 788         'b' => 'manuscript',
 789         'c' => 'book',
 790         'd' => 'manuscript',
 791         'e' => 'map',
 792         'f' => 'map',
 793         'g' => 'film',
 794         'i' => 'audioRecording',
 795         'j' => 'audioRecording',
 796         'k' => 'artwork',
 797         'l' => 'document',
 798         'm' => 'computerProgram',
 799         'o' => 'document',
 800         'r' => 'document',
 801     };
 802     my $fmts7 = {
 803         'a' => 'journalArticle',
 804         's' => 'journal',
 805     };
 806
 807     $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
 808
 809     if ( $genre eq 'book' ) {
 810             $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
 811     }
 812
 813     ##### We must transform mtx to a valable mtx and document type ####
 814     if ( $genre eq 'book' ) {
 815             $mtx = 'book';
 816             $titletype = 'b';
 817     } elsif ( $genre eq 'journal' ) {
 818             $mtx = 'journal';
 819             $titletype = 'j';
 820     } elsif ( $genre eq 'journalArticle' ) {
 821             $mtx   = 'journal';
 822             $genre = 'article';
 823             $titletype = 'a';
 824     } else {
 825             $mtx = 'dc';
 826     }
 827
 828     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
 829
 830         # Setting datas
 831         $aulast  = $record->subfield( '700', 'a' ) || '';
 832         $aufirst = $record->subfield( '700', 'b' ) || '';
 833         push @authors, "$aufirst $aulast" if ($aufirst or $aulast);
 834
 835         # others authors
 836         if ( $record->field('200') ) {
 837             for my $au ( $record->field('200')->subfield('g') ) {
 838                 push @authors, $au;
 839             }
 840         }
 841
 842         $title     = $record->subfield( '200', 'a' );
 843         my $subfield_210d = $record->subfield('210', 'd');
 844         if ($subfield_210d and $subfield_210d =~ /(\d{4})/) {
 845             $pubyear = $1;
 846         }
 847         $publisher = $record->subfield( '210', 'c' ) || '';
 848         $isbn      = $record->subfield( '010', 'a' ) || '';
 849         $issn      = $record->subfield( '011', 'a' ) || '';
 850     } else {
 851
 852         # MARC21 need some improve
 853
 854         # Setting datas
 855         if ( $record->field('100') ) {
 856             push @authors, $record->subfield( '100', 'a' );
 857         }
 858
 859         # others authors
 860         if ( $record->field('700') ) {
 861             for my $au ( $record->field('700')->subfield('a') ) {
 862                 push @authors, $au;
 863             }
 864         }
 865         $title = $record->field('245');
 866         $title &&= $title->as_string('ab');
 867         if ($titletype eq 'a') {
 868             $pubyear   = $record->field('008') || '';
 869             $pubyear   = substr($pubyear->data(), 7, 4) if $pubyear;
 870             $isbn      = $record->subfield( '773', 'z' ) || '';
 871             $issn      = $record->subfield( '773', 'x' ) || '';
 872             $hosttitle = $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{};
 873             my @rels = $record->subfield( '773', 'g' );
 874             $pages = join(', ', @rels);
 875         } else {
 876             $pubyear   = $record->subfield( '260', 'c' ) || '';
 877             $publisher = $record->subfield( '260', 'b' ) || '';
 878             $isbn      = $record->subfield( '020', 'a' ) || '';
 879             $issn      = $record->subfield( '022', 'a' ) || '';
 880         }
 881
 882     }
 883
 884     my @params = (
 885         [ 'ctx_ver', 'Z39.88-2004' ],
 886         [ 'rft_val_fmt', "info:ofi/fmt:kev:mtx:$mtx" ],
 887         [ ($mtx eq 'dc' ? 'rft.type' : 'rft.genre'), $genre ],
 888         [ "rft.${titletype}title", $title ],
 889     );
 890
 891     # rft.title is authorized only once, so by checking $titletype
 892     # we ensure that rft.title is not already in the list.
 893     if ($hosttitle and $titletype) {
 894         push @params, [ 'rft.title', $hosttitle ];
 895     }
 896
 897     push @params, (
 898         [ 'rft.isbn', $isbn ],
 899         [ 'rft.issn', $issn ],
 900     );
 901
 902     # If it's a subscription, these informations have no meaning.
 903     if ($genre ne 'journal') {
 904         push @params, (
 905             [ 'rft.aulast', $aulast ],
 906             [ 'rft.aufirst', $aufirst ],
 907             (map { [ 'rft.au', $_ ] } @authors),
 908             [ 'rft.pub', $publisher ],
 909             [ 'rft.date', $pubyear ],
 910             [ 'rft.pages', $pages ],
 911         );
 912     }
 913
 914     my $coins_value = join( '&amp;',
 915         map { $$_[1] ? $$_[0] . '=' . uri_escape_utf8( $$_[1] ) : () } @params );
 916
 917     return $coins_value;
 918 }
 919
 920 =head2 get_openurl
 921
 922 my $url = $biblio->get_openurl;
 923
 924 Returns url for OpenURL resolver set in OpenURLResolverURL system preference
 925
 926 =cut
 927
 928 sub get_openurl {
 929     my ( $self ) = @_;
 930
 931     my $OpenURLResolverURL = C4::Context->preference('OpenURLResolverURL');
 932
 933     if ($OpenURLResolverURL) {
 934         my $uri = URI->new($OpenURLResolverURL);
 935
 936         if (not defined $uri->query) {
 937             $OpenURLResolverURL .= '?';
 938         } else {
 939             $OpenURLResolverURL .= '&amp;';
 940         }
 941         $OpenURLResolverURL .= $self->get_coins;
 942     }
 943
 944     return $OpenURLResolverURL;
 945 }
 946
 947 =head3 is_serial
 948
 949 my $serial = $biblio->is_serial
 950
 951 Return boolean true if this bibbliographic record is continuing resource
 952
 953 =cut
 954
 955 sub is_serial {
 956     my ( $self ) = @_;
 957
 958     return 1 if $self->serial;
 959
 960     my $record = $self->metadata->record;
 961     return 1 if substr($record->leader, 7, 1) eq 's';
 962
 963     return 0;
 964 }
 965
 966 =head3 custom_cover_image_url
 967
 968 my $image_url = $biblio->custom_cover_image_url
 969
 970 Return the specific url of the cover image for this bibliographic record.
 971 It is built regaring the value of the system preference CustomCoverImagesURL
 972
 973 =cut
 974
 975 sub custom_cover_image_url {
 976     my ( $self ) = @_;
 977     my $url = C4::Context->preference('CustomCoverImagesURL');
 978     if ( $url =~ m|{isbn}| ) {
 979         my $isbn = $self->biblioitem->isbn;
 980         return unless $isbn;
 981         $url =~ s|{isbn}|$isbn|g;
 982     }
 983     if ( $url =~ m|{normalized_isbn}| ) {
 984         my $normalized_isbn = $self->normalized_isbn;
 985         return unless $normalized_isbn;
 986         $url =~ s|{normalized_isbn}|$normalized_isbn|g;
 987     }
 988     if ( $url =~ m|{issn}| ) {
 989         my $issn = $self->biblioitem->issn;
 990         return unless $issn;
 991         $url =~ s|{issn}|$issn|g;
 992     }
 993
 994     my $re = qr|{(?<field>\d{3})(\$(?<subfield>.))?}|;
 995     if ( $url =~ $re ) {
 996         my $field = $+{field};
 997         my $subfield = $+{subfield};
 998         my $marc_record = $self->metadata->record;
 999         my $value;
1000         if ( $subfield ) {
1001             $value = $marc_record->subfield( $field, $subfield );
1002         } else {
1003             my $controlfield = $marc_record->field($field);
1004             $value = $controlfield->data() if $controlfield;
1005         }
1006         return unless $value;
1007         $url =~ s|$re|$value|;
1008     }
1009
1010     return $url;
1011 }
1012
1013 =head3 cover_images
1014
1015 Return the cover images associated with this biblio.
1016
1017 =cut
1018
1019 sub cover_images {
1020     my ( $self ) = @_;
1021
1022     my $cover_images_rs = $self->_result->cover_images;
1023     return unless $cover_images_rs;
1024     return Koha::CoverImages->_new_from_dbic($cover_images_rs);
1025 }
1026
1027 =head3 get_marc_notes
1028
1029     $marcnotesarray = $biblio->get_marc_notes({ opac => 1 });
1030
1031 Get all notes from the MARC record and returns them in an array.
1032 The notes are stored in different fields depending on MARC flavour.
1033 MARC21 5XX $u subfields receive special attention as they are URIs.
1034
1035 =cut
1036
1037 sub get_marc_notes {
1038     my ( $self, $params ) = @_;
1039
1040     my $marcflavour = C4::Context->preference('marcflavour');
1041     my $opac = $params->{opac} // '0';
1042     my $interface = $params->{opac} ? 'opac' : 'intranet';
1043
1044     my $record = $params->{record} // $self->metadata->record;
1045     my $record_processor = Koha::RecordProcessor->new(
1046         {
1047             filters => [ 'ViewPolicy', 'ExpandCodedFields' ],
1048             options => {
1049                 interface     => $interface,
1050                 frameworkcode => $self->frameworkcode
1051             }
1052         }
1053     );
1054     $record_processor->process($record);
1055
1056     my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
1057     #MARC21 specs indicate some notes should be private if first indicator 0
1058     my %maybe_private = (
1059         541 => 1,
1060         542 => 1,
1061         561 => 1,
1062         583 => 1,
1063         590 => 1
1064     );
1065
1066     my %hiddenlist = map { $_ => 1 }
1067         split( /,/, C4::Context->preference('NotesToHide'));
1068
1069     my @marcnotes;
1070     foreach my $field ( $record->field($scope) ) {
1071         my $tag = $field->tag();
1072         next if $hiddenlist{ $tag };
1073         next if $opac && $maybe_private{$tag} && !$field->indicator(1);
1074         if( $marcflavour ne 'UNIMARC' && $field->subfield('u') ) {
1075             # Field 5XX$u always contains URI
1076             # Examples: 505u, 506u, 510u, 514u, 520u, 530u, 538u, 540u, 542u, 552u, 555u, 561u, 563u, 583u
1077             # We first push the other subfields, then all $u's separately
1078             # Leave further actions to the template (see e.g. opac-detail)
1079             my $othersub =
1080                 join '', ( 'a' .. 't', 'v' .. 'z', '0' .. '9' ); # excl 'u'
1081             push @marcnotes, { marcnote => $field->as_string($othersub) };
1082             foreach my $sub ( $field->subfield('u') ) {
1083                 $sub =~ s/^\s+|\s+$//g; # trim
1084                 push @marcnotes, { marcnote => $sub, tag => $tag };
1085             }
1086         } else {
1087             push @marcnotes, { marcnote => $field->as_string(), tag => $tag };
1088         }
1089     }
1090     return \@marcnotes;
1091 }
1092
1093 =head3 _get_marc_authors
1094
1095 Private method to return the list of authors contained in the MARC record.
1096 See get get_marc_contributors and get_marc_authors for the public methods.
1097
1098 =cut
1099
1100 sub _get_marc_authors {
1101     my ( $self, $params ) = @_;
1102
1103     my $fields_filter = $params->{fields_filter};
1104     my $mintag        = $params->{mintag};
1105     my $maxtag        = $params->{maxtag};
1106
1107     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1108     my $marcflavour        = C4::Context->preference('marcflavour');
1109
1110     # tagslib useful only for UNIMARC author responsibilities
1111     my $tagslib = $marcflavour eq "UNIMARC"
1112       ? C4::Biblio::GetMarcStructure( 1, $self->frameworkcode, { unsafe => 1 } )
1113       : undef;
1114
1115     my @marcauthors;
1116     foreach my $field ( $self->metadata->record->field($fields_filter) ) {
1117
1118         next
1119           if $mintag && $field->tag() < $mintag
1120           || $maxtag && $field->tag() > $maxtag;
1121
1122         my @subfields_loop;
1123         my @link_loop;
1124         my @subfields  = $field->subfields();
1125         my $count_auth = 0;
1126
1127         # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1128         my $subfield9 = $field->subfield('9');
1129         if ($subfield9) {
1130             my $linkvalue = $subfield9;
1131             $linkvalue =~ s/(\(|\))//g;
1132             @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1133         }
1134
1135         # other subfields
1136         my $unimarc3;
1137         for my $authors_subfield (@subfields) {
1138             next if ( $authors_subfield->[0] eq '9' );
1139
1140             # unimarc3 contains the $3 of the author for UNIMARC.
1141             # For french academic libraries, it's the "ppn", and it's required for idref webservice
1142             $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1143
1144             # don't load unimarc subfields 3, 5
1145             next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1146
1147             my $code = $authors_subfield->[0];
1148             my $value        = $authors_subfield->[1];
1149             my $linkvalue    = $value;
1150             $linkvalue =~ s/(\(|\))//g;
1151             # UNIMARC author responsibility
1152             if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1153                 $value = C4::Biblio::GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1154                 $linkvalue = "($value)";
1155             }
1156             # if no authority link, build a search query
1157             unless ($subfield9) {
1158                 push @link_loop, {
1159                     limit    => 'au',
1160                     'link'   => $linkvalue,
1161                     operator => (scalar @link_loop) ? ' AND ' : undef
1162                 };
1163             }
1164             my @this_link_loop = @link_loop;
1165             # do not display $0
1166             unless ( $code eq '0') {
1167                 push @subfields_loop, {
1168                     tag       => $field->tag(),
1169                     code      => $code,
1170                     value     => $value,
1171                     link_loop => \@this_link_loop,
1172                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1173                 };
1174             }
1175         }
1176         push @marcauthors, {
1177             MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1178             authoritylink => $subfield9,
1179             unimarc3 => $unimarc3
1180         };
1181     }
1182     return \@marcauthors;
1183 }
1184
1185 =head3 get_marc_contributors
1186
1187     my $contributors = $biblio->get_marc_contributors;
1188
1189 Get all contributors (but first author) from the MARC record and returns them in an array.
1190 They are stored in different fields depending on MARC flavour (700..720 for MARC21)
1191
1192 =cut
1193
1194 sub get_marc_contributors {
1195     my ( $self, $params ) = @_;
1196
1197     my ( $mintag, $maxtag, $fields_filter );
1198     my $marcflavour = C4::Context->preference('marcflavour');
1199
1200     if ( $marcflavour eq "UNIMARC" ) {
1201         $mintag = "700";
1202         $maxtag = "712";
1203         $fields_filter = '7..';
1204     } else { # marc21/normarc
1205         $mintag = "700";
1206         $maxtag = "720";
1207         $fields_filter = '7..';
1208     }
1209
1210     return $self->_get_marc_authors(
1211         {
1212             fields_filter => $fields_filter,
1213             mintag       => $mintag,
1214             maxtag       => $maxtag
1215         }
1216     );
1217 }
1218
1219 =head3 get_marc_authors
1220
1221     my $authors = $biblio->get_marc_authors;
1222
1223 Get all authors from the MARC record and returns them in an array.
1224 They are stored in different fields depending on MARC flavour
1225 (main author from 100 then secondary authors from 700..720).
1226
1227 =cut
1228
1229 sub get_marc_authors {
1230     my ( $self, $params ) = @_;
1231
1232     my ( $mintag, $maxtag, $fields_filter );
1233     my $marcflavour = C4::Context->preference('marcflavour');
1234
1235     if ( $marcflavour eq "UNIMARC" ) {
1236         $fields_filter = '200';
1237     } else { # marc21/normarc
1238         $fields_filter = '100';
1239     }
1240
1241     my @first_authors = @{$self->_get_marc_authors(
1242         {
1243             fields_filter => $fields_filter,
1244             mintag       => $mintag,
1245             maxtag       => $maxtag
1246         }
1247     )};
1248
1249     my @other_authors = @{$self->get_marc_contributors};
1250
1251     return [@first_authors, @other_authors];
1252 }
1253
1254 =head3 normalized_isbn
1255
1256     my $normalized_isbn = $biblio->normalized_isbn
1257
1258 Normalizes and returns the first valid ISBN found in the record.
1259 ISBN13 are converted into ISBN10. This is required to get some book cover images.
1260
1261 =cut
1262
1263 sub normalized_isbn {
1264     my ( $self) = @_;
1265     return C4::Koha::GetNormalizedISBN($self->biblioitem->isbn);
1266 }
1267
1268 =head3 public_read_list
1269
1270 This method returns the list of publicly readable database fields for both API and UI output purposes
1271
1272 =cut
1273
1274 sub public_read_list {
1275     return [
1276         'biblionumber',   'frameworkcode',   'author',
1277         'title',          'medium',          'subtitle',
1278         'part_number',    'part_name',       'unititle',
1279         'notes',          'serial',          'seriestitle',
1280         'copyrightdate',  'abstract'
1281     ];
1282 }
1283
1284 =head3 metadata_extractor
1285
1286     my $extractor = $biblio->metadata_extractor
1287
1288 Return a Koha::Biblio::Metadata::Extractor object to use to extract data from the metadata (ie. MARC record for now)
1289
1290 =cut
1291
1292 sub metadata_extractor {
1293     my ($self) = @_;
1294
1295     $self->{metadata_extractor} ||= Koha::Biblio::Metadata::Extractor->new( { biblio => $self } );
1296
1297     return $self->{metadata_extractor};
1298 }
1299
1300 =head3 normalized_upc
1301
1302     my $normalized_upc = $biblio->normalized_upc
1303
1304 Normalizes and returns the UPC value found in the MARC record.
1305
1306 =cut
1307
1308 sub normalized_upc {
1309     my ($self) = @_;
1310     return $self->metadata_extractor->get_normalized_upc;
1311 }
1312
1313 =head3 normalized_oclc
1314
1315     my $normalized_oclc = $biblio->normalized_oclc
1316
1317 Normalizes and returns the OCLC number found in the MARC record.
1318
1319 =cut
1320
1321 sub normalized_oclc {
1322     my ($self) = @_;
1323     return $self->metadata_extractor->get_normalized_oclc;
1324 }
1325
1326 =head3 to_api
1327
1328     my $json = $biblio->to_api;
1329
1330 Overloaded method that returns a JSON representation of the Koha::Biblio object,
1331 suitable for API output. The related Koha::Biblioitem object is merged as expected
1332 on the API.
1333
1334 =cut
1335
1336 sub to_api {
1337     my ($self, $args) = @_;
1338
1339     my $response = $self->SUPER::to_api( $args );
1340
1341     $args = defined $args ? {%$args} : {};
1342     delete $args->{embed};
1343
1344     my $biblioitem = $self->biblioitem->to_api( $args );
1345
1346     return { %$response, %$biblioitem };
1347 }
1348
1349 =head3 to_api_mapping
1350
1351 This method returns the mapping for representing a Koha::Biblio object
1352 on the API.
1353
1354 =cut
1355
1356 sub to_api_mapping {
1357     return {
1358         biblionumber     => 'biblio_id',
1359         frameworkcode    => 'framework_id',
1360         unititle         => 'uniform_title',
1361         seriestitle      => 'series_title',
1362         copyrightdate    => 'copyright_date',
1363         datecreated      => 'creation_date',
1364         deleted_on       => undef,
1365     };
1366 }
1367
1368 =head3 get_marc_host
1369
1370     $host = $biblio->get_marc_host;
1371     # OR:
1372     ( $host, $relatedparts, $hostinfo ) = $biblio->get_marc_host;
1373
1374     Returns host biblio record from MARC21 773 (undef if no 773 present).
1375     It looks at the first 773 field with MARCorgCode or only a control
1376     number. Complete $w or numeric part is used to search host record.
1377     The optional parameter no_items triggers a check if $biblio has items.
1378     If there are, the sub returns undef.
1379     Called in list context, it also returns 773$g (related parts).
1380
1381     If there is no $w, we use $0 (host biblionumber) or $9 (host itemnumber)
1382     to search for the host record. If there is also no $0 and no $9, we search
1383     using author and title. Failing all of that, we return an undef host and
1384     form a concatenation of strings with 773$agt for host information,
1385     returned when called in list context.
1386
1387 =cut
1388
1389 sub get_marc_host {
1390     my ($self, $params) = @_;
1391     my $no_items = $params->{no_items};
1392     return if C4::Context->preference('marcflavour') eq 'UNIMARC'; # TODO
1393     return if $params->{no_items} && $self->items->count > 0;
1394
1395     my $record;
1396     eval { $record = $self->metadata->record };
1397     return if !$record;
1398
1399     # We pick the first $w with your MARCOrgCode or the first $w that has no
1400     # code (between parentheses) at all.
1401     my $orgcode = C4::Context->preference('MARCOrgCode') // q{};
1402     my $hostfld;
1403     foreach my $f ( $record->field('773') ) {
1404         my $w = $f->subfield('w') or next;
1405         if( $w =~ /^\($orgcode\)\s*(\d+)/i or $w =~ /^\d+/ ) {
1406             $hostfld = $f;
1407             last;
1408         }
1409     }
1410
1411     my $engine = Koha::SearchEngine::Search->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
1412     my $bibno;
1413     if ( !$hostfld and $record->subfield('773','t') ) {
1414         # not linked using $w
1415         my $unlinkedf = $record->field('773');
1416         my $host;
1417         if ( C4::Context->preference("EasyAnalyticalRecords") ) {
1418             if ( $unlinkedf->subfield('0') ) {
1419                 # use 773$0 host biblionumber
1420                 $bibno = $unlinkedf->subfield('0');
1421             } elsif ( $unlinkedf->subfield('9') ) {
1422                 # use 773$9 host itemnumber
1423                 my $linkeditemnumber = $unlinkedf->subfield('9');
1424                 $bibno = Koha::Items->find( $linkeditemnumber )->biblionumber;
1425             }
1426         }
1427         if ( $bibno ) {
1428             my $host = Koha::Biblios->find($bibno) or return;
1429             return wantarray ? ( $host, $unlinkedf->subfield('g') ) : $host;
1430         }
1431         # just return plaintext and no host record
1432         my $hostinfo = join( ", ", $unlinkedf->subfield('a'), $unlinkedf->subfield('t'), $unlinkedf->subfield('g') );
1433         return wantarray ? ( undef, $unlinkedf->subfield('g'), $hostinfo ) : undef;
1434     }
1435     return if !$hostfld;
1436     my $rcn = $hostfld->subfield('w');
1437
1438     # Look for control number with/without orgcode
1439     for my $try (1..2) {
1440         my ( $error, $results, $total_hits ) = $engine->simple_search_compat( 'Control-number='.$rcn, 0,1 );
1441         if( !$error and $total_hits == 1 ) {
1442             $bibno = $engine->extract_biblionumber( $results->[0] );
1443             last;
1444         }
1445         # Add or remove orgcode for second try
1446         if( $try == 1 && $rcn =~ /\)\s*(\d+)/ ) {
1447             $rcn = $1; # number only
1448         } elsif( $try == 1 && $rcn =~ /^\d+/ ) {
1449             $rcn = "($orgcode)$rcn";
1450         } else {
1451             last;
1452         }
1453     }
1454     if( $bibno ) {
1455         my $host = Koha::Biblios->find($bibno) or return;
1456         return wantarray ? ( $host, $hostfld->subfield('g') ) : $host;
1457     }
1458 }
1459
1460 =head3 get_marc_host_only
1461
1462     my $host = $biblio->get_marc_host_only;
1463
1464 Return host only
1465
1466 =cut
1467
1468 sub get_marc_host_only {
1469     my ($self) = @_;
1470
1471     my ( $host ) = $self->get_marc_host;
1472
1473     return $host;
1474 }
1475
1476 =head3 get_marc_relatedparts_only
1477
1478     my $relatedparts = $biblio->get_marc_relatedparts_only;
1479
1480 Return related parts only
1481
1482 =cut
1483
1484 sub get_marc_relatedparts_only {
1485     my ($self) = @_;
1486
1487     my ( undef, $relatedparts ) = $self->get_marc_host;
1488
1489     return $relatedparts;
1490 }
1491
1492 =head3 get_marc_hostinfo_only
1493
1494     my $hostinfo = $biblio->get_marc_hostinfo_only;
1495
1496 Return host info only
1497
1498 =cut
1499
1500 sub get_marc_hostinfo_only {
1501     my ($self) = @_;
1502
1503     my ( $host, $relatedparts, $hostinfo ) = $self->get_marc_host;
1504
1505     return $hostinfo;
1506 }
1507
1508 =head3 recalls
1509
1510     my $recalls = $biblio->recalls;
1511
1512 Return recalls linked to this biblio
1513
1514 =cut
1515
1516 sub recalls {
1517     my ( $self ) = @_;
1518     return Koha::Recalls->_new_from_dbic( scalar $self->_result->recalls );
1519 }
1520
1521 =head3 can_be_recalled
1522
1523     my @items_for_recall = $biblio->can_be_recalled({ patron => $patron_object });
1524
1525 Does biblio-level checks and returns the items attached to this biblio that are available for recall
1526
1527 =cut
1528
1529 sub can_be_recalled {
1530     my ( $self, $params ) = @_;
1531
1532     return 0 if !( C4::Context->preference('UseRecalls') );
1533
1534     my $patron = $params->{patron};
1535
1536     my $branchcode = C4::Context->userenv->{'branch'};
1537     if ( C4::Context->preference('CircControl') eq 'PatronLibrary' and $patron ) {
1538         $branchcode = $patron->branchcode;
1539     }
1540
1541     my @all_items = Koha::Items->search({ biblionumber => $self->biblionumber })->as_list;
1542
1543     # if there are no available items at all, no recall can be placed
1544     return 0 if ( scalar @all_items == 0 );
1545
1546     my @itemtypes;
1547     my @itemnumbers;
1548     my @items;
1549     my @all_itemnumbers;
1550     foreach my $item ( @all_items ) {
1551         push( @all_itemnumbers, $item->itemnumber );
1552         if ( $item->can_be_recalled({ patron => $patron }) ) {
1553             push( @itemtypes, $item->effective_itemtype );
1554             push( @itemnumbers, $item->itemnumber );
1555             push( @items, $item );
1556         }
1557     }
1558
1559     # if there are no recallable items, no recall can be placed
1560     return 0 if ( scalar @items == 0 );
1561
1562     # Check the circulation rule for each relevant itemtype for this biblio
1563     my ( @recalls_allowed, @recalls_per_record, @on_shelf_recalls );
1564     foreach my $itemtype ( @itemtypes ) {
1565         my $rule = Koha::CirculationRules->get_effective_rules({
1566             branchcode => $branchcode,
1567             categorycode => $patron ? $patron->categorycode : undef,
1568             itemtype => $itemtype,
1569             rules => [
1570                 'recalls_allowed',
1571                 'recalls_per_record',
1572                 'on_shelf_recalls',
1573             ],
1574         });
1575         push( @recalls_allowed, $rule->{recalls_allowed} ) if $rule;
1576         push( @recalls_per_record, $rule->{recalls_per_record} ) if $rule;
1577         push( @on_shelf_recalls, $rule->{on_shelf_recalls} ) if $rule;
1578     }
1579     my $recalls_allowed = (sort {$b <=> $a} @recalls_allowed)[0]; # take highest
1580     my $recalls_per_record = (sort {$b <=> $a} @recalls_per_record)[0]; # take highest
1581     my %on_shelf_recalls_count = ();
1582     foreach my $count ( @on_shelf_recalls ) {
1583         $on_shelf_recalls_count{$count}++;
1584     }
1585     my $on_shelf_recalls = (sort {$on_shelf_recalls_count{$b} <=> $on_shelf_recalls_count{$a}} @on_shelf_recalls)[0]; # take most common
1586
1587     # check recalls allowed has been set and is not zero
1588     return 0 if ( !defined($recalls_allowed) || $recalls_allowed == 0 );
1589
1590     if ( $patron ) {
1591         # check borrower has not reached open recalls allowed limit
1592         return 0 if ( $patron->recalls->filter_by_current->count >= $recalls_allowed );
1593
1594         # check borrower has not reached open recalls allowed per record limit
1595         return 0 if ( $patron->recalls->filter_by_current->search({ biblio_id => $self->biblionumber })->count >= $recalls_per_record );
1596
1597         # check if any of the items under this biblio are already checked out by this borrower
1598         return 0 if ( Koha::Checkouts->search({ itemnumber => [ @all_itemnumbers ], borrowernumber => $patron->borrowernumber })->count > 0 );
1599     }
1600
1601     # check item availability
1602     my $checked_out_count = 0;
1603     foreach (@items) {
1604         if ( Koha::Checkouts->search({ itemnumber => $_->itemnumber })->count > 0 ){ $checked_out_count++; }
1605     }
1606
1607     # can't recall if on shelf recalls only allowed when all unavailable, but items are still available for checkout
1608     return 0 if ( $on_shelf_recalls eq 'all' && $checked_out_count < scalar @items );
1609
1610     # can't recall if no items have been checked out
1611     return 0 if ( $checked_out_count == 0 );
1612
1613     # can recall
1614     return @items;
1615 }
1616
1617 =head3 ratings
1618
1619     my $ratings = $biblio->ratings
1620
1621 Return a Koha::Ratings object representing the ratings of this bibliographic record
1622
1623 =cut
1624
1625 sub ratings {
1626     my ( $self ) = @_;
1627     my $rs = $self->_result->ratings;
1628     return Koha::Ratings->_new_from_dbic($rs);
1629 }
1630
1631 =head3 opac_summary_html
1632
1633     my $summary_html = $biblio->opac_summary_html
1634
1635 Based on the syspref OPACMySummaryHTML, returns a string representing the
1636 summary of this bibliographic record.
1637 {AUTHOR}, {TITLE}, {ISBN} and {BIBLIONUMBER} will be replaced.
1638
1639 =cut
1640
1641 sub opac_summary_html {
1642     my ($self) = @_;
1643
1644     my $summary_html = C4::Context->preference('OPACMySummaryHTML');
1645     return q{} unless $summary_html;
1646     my $author = $self->author || q{};
1647     my $title  = $self->title  || q{};
1648     $title =~ s/\/+$//;    # remove trailing slash
1649     $title =~ s/\s+$//;    # remove trailing space
1650     my $normalized_isbn = $self->normalized_isbn || q{};
1651     my $biblionumber    = $self->biblionumber;
1652
1653     $summary_html =~ s/{AUTHOR}/$author/g;
1654     $summary_html =~ s/{TITLE}/$title/g;
1655     $summary_html =~ s/{ISBN}/$normalized_isbn/g;
1656     $summary_html =~ s/{BIBLIONUMBER}/$biblionumber/g;
1657
1658     return $summary_html;
1659 }
1660
1661 =head3 get_marc_volumes
1662
1663   my $volumes = $self->get_marc_volumes();
1664
1665 Returns an array of MARCXML data, which are volumes parts of
1666 this object (MARC21 773$w points to this)
1667
1668 =cut
1669
1670 sub get_marc_volumes {
1671     my ($self, $max_results) = @_;
1672
1673     return [] if (C4::Context->preference('marcflavour') ne 'MARC21');
1674
1675     my $searchstr = $self->get_volumes_query;
1676
1677     if (defined($searchstr)) {
1678         my $searcher = Koha::SearchEngine::Search->new({index => $Koha::SearchEngine::BIBLIOS_INDEX});
1679         my ( $errors, $results, $total_hits ) = $searcher->simple_search_compat( $searchstr, 0, $max_results );
1680         $self->{_volumes} = $results if ( defined($results) && scalar(@$results) );
1681     }
1682
1683     return $self->{_volumes} || [];
1684 }
1685
1686 =head2 get_volumes_query
1687
1688 Returns a query which can be used to search for all component parts of MARC21 biblios
1689
1690 =cut
1691
1692 sub get_volumes_query {
1693     my ($self) = @_;
1694
1695     my $builder = Koha::SearchEngine::QueryBuilder->new(
1696         { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
1697     my $marc = $self->metadata->record;
1698
1699     my $searchstr;
1700     if ( C4::Context->preference('UseControlNumber') ) {
1701         my $pf001 = $marc->field('001') || undef;
1702
1703         if ( defined($pf001) ) {
1704             $searchstr = "(";
1705             my $pf003 = $marc->field('003') || undef;
1706
1707             if ( !defined($pf003) ) {
1708                 # search for 773$w='Host001'
1709                 $searchstr .= "rcn:" . $pf001->data();
1710             }
1711             else {
1712                 $searchstr .= "(";
1713                 # search for (773$w='Host001' and 003='Host003') or 773$w='(Host003)Host001'
1714                 $searchstr .= "(rcn:" . $pf001->data() . " AND cni:" . $pf003->data() . ")";
1715                 $searchstr .= " OR rcn:\"" . $pf003->data() . " " . $pf001->data() . "\"";
1716                 $searchstr .= ")";
1717             }
1718
1719             # exclude monograph and serial component part records
1720             $searchstr .= " NOT (bib-level:a OR bib-level:b)";
1721             $searchstr .= ")";
1722         }
1723     }
1724     else {
1725         my $cleaned_title = $marc->title;
1726         $cleaned_title =~ tr|/||;
1727         $cleaned_title = $builder->clean_search_term($cleaned_title);
1728         $searchstr = "ti,phr:($cleaned_title)";
1729     }
1730
1731     return $searchstr;
1732 }
1733
1734 =head2 Internal methods
1735
1736 =head3 type
1737
1738 =cut
1739
1740 sub _type {
1741     return 'Biblio';
1742 }
1743
1744 =head1 AUTHOR
1745
1746 Kyle M Hall <kyle@bywatersolutions.com>
1747
1748 =cut
1749
1750 1;