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     my $marc_record = $self->metadata->record;
1324     return $self->metadata_extractor->get_normalized_oclc;
1325 }
1326
1327 =head3 to_api
1328
1329     my $json = $biblio->to_api;
1330
1331 Overloaded method that returns a JSON representation of the Koha::Biblio object,
1332 suitable for API output. The related Koha::Biblioitem object is merged as expected
1333 on the API.
1334
1335 =cut
1336
1337 sub to_api {
1338     my ($self, $args) = @_;
1339
1340     my $response = $self->SUPER::to_api( $args );
1341
1342     $args = defined $args ? {%$args} : {};
1343     delete $args->{embed};
1344
1345     my $biblioitem = $self->biblioitem->to_api( $args );
1346
1347     return { %$response, %$biblioitem };
1348 }
1349
1350 =head3 to_api_mapping
1351
1352 This method returns the mapping for representing a Koha::Biblio object
1353 on the API.
1354
1355 =cut
1356
1357 sub to_api_mapping {
1358     return {
1359         biblionumber     => 'biblio_id',
1360         frameworkcode    => 'framework_id',
1361         unititle         => 'uniform_title',
1362         seriestitle      => 'series_title',
1363         copyrightdate    => 'copyright_date',
1364         datecreated      => 'creation_date',
1365         deleted_on       => undef,
1366     };
1367 }
1368
1369 =head3 get_marc_host
1370
1371     $host = $biblio->get_marc_host;
1372     # OR:
1373     ( $host, $relatedparts, $hostinfo ) = $biblio->get_marc_host;
1374
1375     Returns host biblio record from MARC21 773 (undef if no 773 present).
1376     It looks at the first 773 field with MARCorgCode or only a control
1377     number. Complete $w or numeric part is used to search host record.
1378     The optional parameter no_items triggers a check if $biblio has items.
1379     If there are, the sub returns undef.
1380     Called in list context, it also returns 773$g (related parts).
1381
1382     If there is no $w, we use $0 (host biblionumber) or $9 (host itemnumber)
1383     to search for the host record. If there is also no $0 and no $9, we search
1384     using author and title. Failing all of that, we return an undef host and
1385     form a concatenation of strings with 773$agt for host information,
1386     returned when called in list context.
1387
1388 =cut
1389
1390 sub get_marc_host {
1391     my ($self, $params) = @_;
1392     my $no_items = $params->{no_items};
1393     return if C4::Context->preference('marcflavour') eq 'UNIMARC'; # TODO
1394     return if $params->{no_items} && $self->items->count > 0;
1395
1396     my $record;
1397     eval { $record = $self->metadata->record };
1398     return if !$record;
1399
1400     # We pick the first $w with your MARCOrgCode or the first $w that has no
1401     # code (between parentheses) at all.
1402     my $orgcode = C4::Context->preference('MARCOrgCode') // q{};
1403     my $hostfld;
1404     foreach my $f ( $record->field('773') ) {
1405         my $w = $f->subfield('w') or next;
1406         if( $w =~ /^\($orgcode\)\s*(\d+)/i or $w =~ /^\d+/ ) {
1407             $hostfld = $f;
1408             last;
1409         }
1410     }
1411
1412     my $engine = Koha::SearchEngine::Search->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
1413     my $bibno;
1414     if ( !$hostfld and $record->subfield('773','t') ) {
1415         # not linked using $w
1416         my $unlinkedf = $record->field('773');
1417         my $host;
1418         if ( C4::Context->preference("EasyAnalyticalRecords") ) {
1419             if ( $unlinkedf->subfield('0') ) {
1420                 # use 773$0 host biblionumber
1421                 $bibno = $unlinkedf->subfield('0');
1422             } elsif ( $unlinkedf->subfield('9') ) {
1423                 # use 773$9 host itemnumber
1424                 my $linkeditemnumber = $unlinkedf->subfield('9');
1425                 $bibno = Koha::Items->find( $linkeditemnumber )->biblionumber;
1426             }
1427         }
1428         if ( $bibno ) {
1429             my $host = Koha::Biblios->find($bibno) or return;
1430             return wantarray ? ( $host, $unlinkedf->subfield('g') ) : $host;
1431         }
1432         # just return plaintext and no host record
1433         my $hostinfo = join( ", ", $unlinkedf->subfield('a'), $unlinkedf->subfield('t'), $unlinkedf->subfield('g') );
1434         return wantarray ? ( undef, $unlinkedf->subfield('g'), $hostinfo ) : undef;
1435     }
1436     return if !$hostfld;
1437     my $rcn = $hostfld->subfield('w');
1438
1439     # Look for control number with/without orgcode
1440     for my $try (1..2) {
1441         my ( $error, $results, $total_hits ) = $engine->simple_search_compat( 'Control-number='.$rcn, 0,1 );
1442         if( !$error and $total_hits == 1 ) {
1443             $bibno = $engine->extract_biblionumber( $results->[0] );
1444             last;
1445         }
1446         # Add or remove orgcode for second try
1447         if( $try == 1 && $rcn =~ /\)\s*(\d+)/ ) {
1448             $rcn = $1; # number only
1449         } elsif( $try == 1 && $rcn =~ /^\d+/ ) {
1450             $rcn = "($orgcode)$rcn";
1451         } else {
1452             last;
1453         }
1454     }
1455     if( $bibno ) {
1456         my $host = Koha::Biblios->find($bibno) or return;
1457         return wantarray ? ( $host, $hostfld->subfield('g') ) : $host;
1458     }
1459 }
1460
1461 =head3 get_marc_host_only
1462
1463     my $host = $biblio->get_marc_host_only;
1464
1465 Return host only
1466
1467 =cut
1468
1469 sub get_marc_host_only {
1470     my ($self) = @_;
1471
1472     my ( $host ) = $self->get_marc_host;
1473
1474     return $host;
1475 }
1476
1477 =head3 get_marc_relatedparts_only
1478
1479     my $relatedparts = $biblio->get_marc_relatedparts_only;
1480
1481 Return related parts only
1482
1483 =cut
1484
1485 sub get_marc_relatedparts_only {
1486     my ($self) = @_;
1487
1488     my ( undef, $relatedparts ) = $self->get_marc_host;
1489
1490     return $relatedparts;
1491 }
1492
1493 =head3 get_marc_hostinfo_only
1494
1495     my $hostinfo = $biblio->get_marc_hostinfo_only;
1496
1497 Return host info only
1498
1499 =cut
1500
1501 sub get_marc_hostinfo_only {
1502     my ($self) = @_;
1503
1504     my ( $host, $relatedparts, $hostinfo ) = $self->get_marc_host;
1505
1506     return $hostinfo;
1507 }
1508
1509 =head3 recalls
1510
1511     my $recalls = $biblio->recalls;
1512
1513 Return recalls linked to this biblio
1514
1515 =cut
1516
1517 sub recalls {
1518     my ( $self ) = @_;
1519     return Koha::Recalls->_new_from_dbic( scalar $self->_result->recalls );
1520 }
1521
1522 =head3 can_be_recalled
1523
1524     my @items_for_recall = $biblio->can_be_recalled({ patron => $patron_object });
1525
1526 Does biblio-level checks and returns the items attached to this biblio that are available for recall
1527
1528 =cut
1529
1530 sub can_be_recalled {
1531     my ( $self, $params ) = @_;
1532
1533     return 0 if !( C4::Context->preference('UseRecalls') );
1534
1535     my $patron = $params->{patron};
1536
1537     my $branchcode = C4::Context->userenv->{'branch'};
1538     if ( C4::Context->preference('CircControl') eq 'PatronLibrary' and $patron ) {
1539         $branchcode = $patron->branchcode;
1540     }
1541
1542     my @all_items = Koha::Items->search({ biblionumber => $self->biblionumber })->as_list;
1543
1544     # if there are no available items at all, no recall can be placed
1545     return 0 if ( scalar @all_items == 0 );
1546
1547     my @itemtypes;
1548     my @itemnumbers;
1549     my @items;
1550     my @all_itemnumbers;
1551     foreach my $item ( @all_items ) {
1552         push( @all_itemnumbers, $item->itemnumber );
1553         if ( $item->can_be_recalled({ patron => $patron }) ) {
1554             push( @itemtypes, $item->effective_itemtype );
1555             push( @itemnumbers, $item->itemnumber );
1556             push( @items, $item );
1557         }
1558     }
1559
1560     # if there are no recallable items, no recall can be placed
1561     return 0 if ( scalar @items == 0 );
1562
1563     # Check the circulation rule for each relevant itemtype for this biblio
1564     my ( @recalls_allowed, @recalls_per_record, @on_shelf_recalls );
1565     foreach my $itemtype ( @itemtypes ) {
1566         my $rule = Koha::CirculationRules->get_effective_rules({
1567             branchcode => $branchcode,
1568             categorycode => $patron ? $patron->categorycode : undef,
1569             itemtype => $itemtype,
1570             rules => [
1571                 'recalls_allowed',
1572                 'recalls_per_record',
1573                 'on_shelf_recalls',
1574             ],
1575         });
1576         push( @recalls_allowed, $rule->{recalls_allowed} ) if $rule;
1577         push( @recalls_per_record, $rule->{recalls_per_record} ) if $rule;
1578         push( @on_shelf_recalls, $rule->{on_shelf_recalls} ) if $rule;
1579     }
1580     my $recalls_allowed = (sort {$b <=> $a} @recalls_allowed)[0]; # take highest
1581     my $recalls_per_record = (sort {$b <=> $a} @recalls_per_record)[0]; # take highest
1582     my %on_shelf_recalls_count = ();
1583     foreach my $count ( @on_shelf_recalls ) {
1584         $on_shelf_recalls_count{$count}++;
1585     }
1586     my $on_shelf_recalls = (sort {$on_shelf_recalls_count{$b} <=> $on_shelf_recalls_count{$a}} @on_shelf_recalls)[0]; # take most common
1587
1588     # check recalls allowed has been set and is not zero
1589     return 0 if ( !defined($recalls_allowed) || $recalls_allowed == 0 );
1590
1591     if ( $patron ) {
1592         # check borrower has not reached open recalls allowed limit
1593         return 0 if ( $patron->recalls->filter_by_current->count >= $recalls_allowed );
1594
1595         # check borrower has not reached open recalls allowed per record limit
1596         return 0 if ( $patron->recalls->filter_by_current->search({ biblio_id => $self->biblionumber })->count >= $recalls_per_record );
1597
1598         # check if any of the items under this biblio are already checked out by this borrower
1599         return 0 if ( Koha::Checkouts->search({ itemnumber => [ @all_itemnumbers ], borrowernumber => $patron->borrowernumber })->count > 0 );
1600     }
1601
1602     # check item availability
1603     my $checked_out_count = 0;
1604     foreach (@items) {
1605         if ( Koha::Checkouts->search({ itemnumber => $_->itemnumber })->count > 0 ){ $checked_out_count++; }
1606     }
1607
1608     # can't recall if on shelf recalls only allowed when all unavailable, but items are still available for checkout
1609     return 0 if ( $on_shelf_recalls eq 'all' && $checked_out_count < scalar @items );
1610
1611     # can't recall if no items have been checked out
1612     return 0 if ( $checked_out_count == 0 );
1613
1614     # can recall
1615     return @items;
1616 }
1617
1618 =head3 ratings
1619
1620     my $ratings = $biblio->ratings
1621
1622 Return a Koha::Ratings object representing the ratings of this bibliographic record
1623
1624 =cut
1625
1626 sub ratings {
1627     my ( $self ) = @_;
1628     my $rs = $self->_result->ratings;
1629     return Koha::Ratings->_new_from_dbic($rs);
1630 }
1631
1632 =head3 opac_summary_html
1633
1634     my $summary_html = $biblio->opac_summary_html
1635
1636 Based on the syspref OPACMySummaryHTML, returns a string representing the
1637 summary of this bibliographic record.
1638 {AUTHOR}, {TITLE}, {ISBN} and {BIBLIONUMBER} will be replaced.
1639
1640 =cut
1641
1642 sub opac_summary_html {
1643     my ($self) = @_;
1644
1645     my $summary_html = C4::Context->preference('OPACMySummaryHTML');
1646     return q{} unless $summary_html;
1647     my $author = $self->author || q{};
1648     my $title  = $self->title  || q{};
1649     $title =~ s/\/+$//;    # remove trailing slash
1650     $title =~ s/\s+$//;    # remove trailing space
1651     my $normalized_isbn = $self->normalized_isbn || q{};
1652     my $biblionumber    = $self->biblionumber;
1653
1654     $summary_html =~ s/{AUTHOR}/$author/g;
1655     $summary_html =~ s/{TITLE}/$title/g;
1656     $summary_html =~ s/{ISBN}/$normalized_isbn/g;
1657     $summary_html =~ s/{BIBLIONUMBER}/$biblionumber/g;
1658
1659     return $summary_html;
1660 }
1661
1662 =head2 Internal methods
1663
1664 =head3 type
1665
1666 =cut
1667
1668 sub _type {
1669     return 'Biblio';
1670 }
1671
1672 =head1 AUTHOR
1673
1674 Kyle M Hall <kyle@bywatersolutions.com>
1675
1676 =cut
1677
1678 1;