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 );
  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::Biblioitems;
  37 use Koha::Checkouts;
  38 use Koha::CirculationRules;
  39 use Koha::Item::Transfer::Limits;
  40 use Koha::Items;
  41 use Koha::Libraries;
  42 use Koha::Old::Checkouts;
  43 use Koha::Recalls;
  44 use Koha::RecordProcessor;
  45 use Koha::Suggestions;
  46 use Koha::Subscriptions;
  47 use Koha::SearchEngine;
  48 use Koha::SearchEngine::Search;
  49 use Koha::SearchEngine::QueryBuilder;
  50
  51 =head1 NAME
  52
  53 Koha::Biblio - Koha Biblio Object class
  54
  55 =head1 API
  56
  57 =head2 Class Methods
  58
  59 =cut
  60
  61 =head3 store
  62
  63 Overloaded I<store> method to set default values
  64
  65 =cut
  66
  67 sub store {
  68     my ( $self ) = @_;
  69
  70     $self->datecreated( dt_from_string ) unless $self->datecreated;
  71
  72     return $self->SUPER::store;
  73 }
  74
  75 =head3 metadata
  76
  77 my $metadata = $biblio->metadata();
  78
  79 Returns a Koha::Biblio::Metadata object
  80
  81 =cut
  82
  83 sub metadata {
  84     my ( $self ) = @_;
  85
  86     my $metadata = $self->_result->metadata;
  87     return Koha::Biblio::Metadata->_new_from_dbic($metadata);
  88 }
  89
  90 =head3 orders
  91
  92 my $orders = $biblio->orders();
  93
  94 Returns a Koha::Acquisition::Orders object
  95
  96 =cut
  97
  98 sub orders {
  99     my ( $self ) = @_;
 100
 101     my $orders = $self->_result->orders;
 102     return Koha::Acquisition::Orders->_new_from_dbic($orders);
 103 }
 104
 105 =head3 active_orders
 106
 107 my $active_orders = $biblio->active_orders();
 108
 109 Returns the active acquisition orders related to this biblio.
 110 An order is considered active when it is not cancelled (i.e. when datecancellation
 111 is not undef).
 112
 113 =cut
 114
 115 sub active_orders {
 116     my ( $self ) = @_;
 117
 118     return $self->orders->search({ datecancellationprinted => undef });
 119 }
 120
 121 =head3 can_article_request
 122
 123 my $bool = $biblio->can_article_request( $borrower );
 124
 125 Returns true if article requests can be made for this record
 126
 127 $borrower must be a Koha::Patron object
 128
 129 =cut
 130
 131 sub can_article_request {
 132     my ( $self, $borrower ) = @_;
 133
 134     my $rule = $self->article_request_type($borrower);
 135     return q{} if $rule eq 'item_only' && !$self->items()->count();
 136     return 1 if $rule && $rule ne 'no';
 137
 138     return q{};
 139 }
 140
 141 =head3 can_be_transferred
 142
 143 $biblio->can_be_transferred({ to => $to_library, from => $from_library })
 144
 145 Checks if at least one item of a biblio can be transferred to given library.
 146
 147 This feature is controlled by two system preferences:
 148 UseBranchTransferLimits to enable / disable the feature
 149 BranchTransferLimitsType to use either an itemnumber or ccode as an identifier
 150                          for setting the limitations
 151
 152 Performance-wise, it is recommended to use this method for a biblio instead of
 153 iterating each item of a biblio with Koha::Item->can_be_transferred().
 154
 155 Takes HASHref that can have the following parameters:
 156     MANDATORY PARAMETERS:
 157     $to   : Koha::Library
 158     OPTIONAL PARAMETERS:
 159     $from : Koha::Library # if given, only items from that
 160                           # holdingbranch are considered
 161
 162 Returns 1 if at least one of the item of a biblio can be transferred
 163 to $to_library, otherwise 0.
 164
 165 =cut
 166
 167 sub can_be_transferred {
 168     my ($self, $params) = @_;
 169
 170     my $to   = $params->{to};
 171     my $from = $params->{from};
 172
 173     return 1 unless C4::Context->preference('UseBranchTransferLimits');
 174     my $limittype = C4::Context->preference('BranchTransferLimitsType');
 175
 176     my $items;
 177     foreach my $item_of_bib ($self->items->as_list) {
 178         next unless $item_of_bib->holdingbranch;
 179         next if $from && $from->branchcode ne $item_of_bib->holdingbranch;
 180         return 1 if $item_of_bib->holdingbranch eq $to->branchcode;
 181         my $code = $limittype eq 'itemtype'
 182             ? $item_of_bib->effective_itemtype
 183             : $item_of_bib->ccode;
 184         return 1 unless $code;
 185         $items->{$code}->{$item_of_bib->holdingbranch} = 1;
 186     }
 187
 188     # At this point we will have a HASHref containing each itemtype/ccode that
 189     # this biblio has, inside which are all of the holdingbranches where those
 190     # items are located at. Then, we will query Koha::Item::Transfer::Limits to
 191     # find out whether a transfer limits for such $limittype from any of the
 192     # listed holdingbranches to the given $to library exist. If at least one
 193     # holdingbranch for that $limittype does not have a transfer limit to given
 194     # $to library, then we know that the transfer is possible.
 195     foreach my $code (keys %{$items}) {
 196         my @holdingbranches = keys %{$items->{$code}};
 197         return 1 if Koha::Item::Transfer::Limits->search({
 198             toBranch => $to->branchcode,
 199             fromBranch => { 'in' => \@holdingbranches },
 200             $limittype => $code
 201         }, {
 202             group_by => [qw/fromBranch/]
 203         })->count == scalar(@holdingbranches) ? 0 : 1;
 204     }
 205
 206     return 0;
 207 }
 208
 209
 210 =head3 pickup_locations
 211
 212     my $pickup_locations = $biblio->pickup_locations( {patron => $patron } );
 213
 214 Returns a Koha::Libraries set of possible pickup locations for this biblio's items,
 215 according to patron's home library (if patron is defined and holds are allowed
 216 only from hold groups) and if item can be transferred to each pickup location.
 217
 218 =cut
 219
 220 sub pickup_locations {
 221     my ( $self, $params ) = @_;
 222
 223     my $patron = $params->{patron};
 224
 225     my @pickup_locations;
 226     foreach my $item_of_bib ( $self->items->as_list ) {
 227         push @pickup_locations,
 228           $item_of_bib->pickup_locations( { patron => $patron } )
 229           ->_resultset->get_column('branchcode')->all;
 230     }
 231
 232     return Koha::Libraries->search(
 233         { branchcode => { '-in' => \@pickup_locations } }, { order_by => ['branchname'] } );
 234 }
 235
 236 =head3 hidden_in_opac
 237
 238     my $bool = $biblio->hidden_in_opac({ [ rules => $rules ] })
 239
 240 Returns true if the biblio matches the hidding criteria defined in $rules.
 241 Returns false otherwise. It involves the I<OpacHiddenItems> and
 242 I<OpacHiddenItemsHidesRecord> system preferences.
 243
 244 Takes HASHref that can have the following parameters:
 245     OPTIONAL PARAMETERS:
 246     $rules : { <field> => [ value_1, ... ], ... }
 247
 248 Note: $rules inherits its structure from the parsed YAML from reading
 249 the I<OpacHiddenItems> system preference.
 250
 251 =cut
 252
 253 sub hidden_in_opac {
 254     my ( $self, $params ) = @_;
 255
 256     my $rules = $params->{rules} // {};
 257
 258     my @items = $self->items->as_list;
 259
 260     return 0 unless @items; # Do not hide if there is no item
 261
 262     # Ok, there are items, don't even try the rules unless OpacHiddenItemsHidesRecord
 263     return 0 unless C4::Context->preference('OpacHiddenItemsHidesRecord');
 264
 265     return !(any { !$_->hidden_in_opac({ rules => $rules }) } @items);
 266 }
 267
 268 =head3 article_request_type
 269
 270 my $type = $biblio->article_request_type( $borrower );
 271
 272 Returns the article request type based on items, or on the record
 273 itself if there are no items.
 274
 275 $borrower must be a Koha::Patron object
 276
 277 =cut
 278
 279 sub article_request_type {
 280     my ( $self, $borrower ) = @_;
 281
 282     return q{} unless $borrower;
 283
 284     my $rule = $self->article_request_type_for_items( $borrower );
 285     return $rule if $rule;
 286
 287     # If the record has no items that are requestable, go by the record itemtype
 288     $rule = $self->article_request_type_for_bib($borrower);
 289     return $rule if $rule;
 290
 291     return q{};
 292 }
 293
 294 =head3 article_request_type_for_bib
 295
 296 my $type = $biblio->article_request_type_for_bib
 297
 298 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record
 299
 300 =cut
 301
 302 sub article_request_type_for_bib {
 303     my ( $self, $borrower ) = @_;
 304
 305     return q{} unless $borrower;
 306
 307     my $borrowertype = $borrower->categorycode;
 308     my $itemtype     = $self->itemtype();
 309
 310     my $rule = Koha::CirculationRules->get_effective_rule(
 311         {
 312             rule_name    => 'article_requests',
 313             categorycode => $borrowertype,
 314             itemtype     => $itemtype,
 315         }
 316     );
 317
 318     return q{} unless $rule;
 319     return $rule->rule_value || q{}
 320 }
 321
 322 =head3 article_request_type_for_items
 323
 324 my $type = $biblio->article_request_type_for_items
 325
 326 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record's items
 327
 328 If there is a conflict where some items are 'bib_only' and some are 'item_only', 'bib_only' will be returned.
 329
 330 =cut
 331
 332 sub article_request_type_for_items {
 333     my ( $self, $borrower ) = @_;
 334
 335     my $counts;
 336     foreach my $item ( $self->items()->as_list() ) {
 337         my $rule = $item->article_request_type($borrower);
 338         return $rule if $rule eq 'bib_only';    # we don't need to go any further
 339         $counts->{$rule}++;
 340     }
 341
 342     return 'item_only' if $counts->{item_only};
 343     return 'yes'       if $counts->{yes};
 344     return 'no'        if $counts->{no};
 345     return q{};
 346 }
 347
 348 =head3 article_requests
 349
 350     my $article_requests = $biblio->article_requests
 351
 352 Returns the article requests associated with this biblio
 353
 354 =cut
 355
 356 sub article_requests {
 357     my ( $self ) = @_;
 358
 359     return Koha::ArticleRequests->_new_from_dbic( scalar $self->_result->article_requests );
 360 }
 361
 362 =head3 current_checkouts
 363
 364     my $current_checkouts = $biblio->current_checkouts
 365
 366 Returns the current checkouts associated with this biblio
 367
 368 =cut
 369
 370 sub current_checkouts {
 371     my ($self) = @_;
 372
 373     return Koha::Checkouts->search( { "item.biblionumber" => $self->id },
 374         { join => 'item' } );
 375 }
 376
 377 =head3 old_checkouts
 378
 379     my $old_checkouts = $biblio->old_checkouts
 380
 381 Returns the past checkouts associated with this biblio
 382
 383 =cut
 384
 385 sub old_checkouts {
 386     my ( $self ) = @_;
 387
 388     return Koha::Old::Checkouts->search( { "item.biblionumber" => $self->id },
 389         { join => 'item' } );
 390 }
 391
 392 =head3 items
 393
 394 my $items = $biblio->items();
 395
 396 Returns the related Koha::Items object for this biblio
 397
 398 =cut
 399
 400 sub items {
 401     my ($self) = @_;
 402
 403     my $items_rs = $self->_result->items;
 404
 405     return Koha::Items->_new_from_dbic( $items_rs );
 406 }
 407
 408 =head3 host_items
 409
 410 my $host_items = $biblio->host_items();
 411
 412 Return the host items (easy analytical record)
 413
 414 =cut
 415
 416 sub host_items {
 417     my ($self) = @_;
 418
 419     return Koha::Items->new->empty
 420       unless C4::Context->preference('EasyAnalyticalRecords');
 421
 422     my $marcflavour = C4::Context->preference("marcflavour");
 423     my $analyticfield = '773';
 424     if ( $marcflavour eq 'MARC21' ) {
 425         $analyticfield = '773';
 426     }
 427     elsif ( $marcflavour eq 'UNIMARC' ) {
 428         $analyticfield = '461';
 429     }
 430     my $marc_record = $self->metadata->record;
 431     my @itemnumbers;
 432     foreach my $field ( $marc_record->field($analyticfield) ) {
 433         push @itemnumbers, $field->subfield('9');
 434     }
 435
 436     return Koha::Items->search( { itemnumber => { -in => \@itemnumbers } } );
 437 }
 438
 439 =head3 itemtype
 440
 441 my $itemtype = $biblio->itemtype();
 442
 443 Returns the itemtype for this record.
 444
 445 =cut
 446
 447 sub itemtype {
 448     my ( $self ) = @_;
 449
 450     return $self->biblioitem()->itemtype();
 451 }
 452
 453 =head3 holds
 454
 455 my $holds = $biblio->holds();
 456
 457 return the current holds placed on this record
 458
 459 =cut
 460
 461 sub holds {
 462     my ( $self, $params, $attributes ) = @_;
 463     $attributes->{order_by} = 'priority' unless exists $attributes->{order_by};
 464     my $hold_rs = $self->_result->reserves->search( $params, $attributes );
 465     return Koha::Holds->_new_from_dbic($hold_rs);
 466 }
 467
 468 =head3 current_holds
 469
 470 my $holds = $biblio->current_holds
 471
 472 Return the holds placed on this bibliographic record.
 473 It does not include future holds.
 474
 475 =cut
 476
 477 sub current_holds {
 478     my ($self) = @_;
 479     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 480     return $self->holds(
 481         { reservedate => { '<=' => $dtf->format_date(dt_from_string) } } );
 482 }
 483
 484 =head3 biblioitem
 485
 486 my $field = $self->biblioitem()->itemtype
 487
 488 Returns the related Koha::Biblioitem object for this Biblio object
 489
 490 =cut
 491
 492 sub biblioitem {
 493     my ($self) = @_;
 494
 495     $self->{_biblioitem} ||= Koha::Biblioitems->find( { biblionumber => $self->biblionumber() } );
 496
 497     return $self->{_biblioitem};
 498 }
 499
 500 =head3 suggestions
 501
 502 my $suggestions = $self->suggestions
 503
 504 Returns the related Koha::Suggestions object for this Biblio object
 505
 506 =cut
 507
 508 sub suggestions {
 509     my ($self) = @_;
 510
 511     my $suggestions_rs = $self->_result->suggestions;
 512     return Koha::Suggestions->_new_from_dbic( $suggestions_rs );
 513 }
 514
 515 =head3 get_marc_components
 516
 517   my $components = $self->get_marc_components();
 518
 519 Returns an array of search results data, which are component parts of
 520 this object (MARC21 773 points to this)
 521
 522 =cut
 523
 524 sub get_marc_components {
 525     my ($self, $max_results) = @_;
 526
 527     return [] if (C4::Context->preference('marcflavour') ne 'MARC21');
 528
 529     my ( $searchstr, $sort ) = $self->get_components_query;
 530
 531     my $components;
 532     if (defined($searchstr)) {
 533         my $searcher = Koha::SearchEngine::Search->new({index => $Koha::SearchEngine::BIBLIOS_INDEX});
 534         my ( $error, $results, $facets );
 535         eval {
 536             ( $error, $results, $facets ) = $searcher->search_compat( $searchstr, undef, [$sort], ['biblioserver'], $max_results, 0, undef, undef, 'ccl', 0 );
 537         };
 538         if( $error || $@ ) {
 539             $error //= q{};
 540             $error .= $@ if $@;
 541             warn "Warning from search_compat: '$error'";
 542             $self->add_message(
 543                 {
 544                     type    => 'error',
 545                     message => 'component_search',
 546                     payload => $error,
 547                 }
 548             );
 549         }
 550         $components = $results->{biblioserver}->{RECORDS} if defined($results) && $results->{biblioserver}->{hits};
 551     }
 552
 553     return $components // [];
 554 }
 555
 556 =head2 get_components_query
 557
 558 Returns a query which can be used to search for all component parts of MARC21 biblios
 559
 560 =cut
 561
 562 sub get_components_query {
 563     my ($self) = @_;
 564
 565     my $builder = Koha::SearchEngine::QueryBuilder->new(
 566         { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
 567     my $marc = $self->metadata->record;
 568     my $component_sort_field = C4::Context->preference('ComponentSortField') // "title";
 569     my $component_sort_order = C4::Context->preference('ComponentSortOrder') // "asc";
 570     my $sort = $component_sort_field . "_" . $component_sort_order;
 571
 572     my $searchstr;
 573     if ( C4::Context->preference('UseControlNumber') ) {
 574         my $pf001 = $marc->field('001') || undef;
 575
 576         if ( defined($pf001) ) {
 577             $searchstr = "(";
 578             my $pf003 = $marc->field('003') || undef;
 579
 580             if ( !defined($pf003) ) {
 581                 # search for 773$w='Host001'
 582                 $searchstr .= "rcn:" . $pf001->data();
 583             }
 584             else {
 585                 $searchstr .= "(";
 586                 # search for (773$w='Host001' and 003='Host003') or 773$w='(Host003)Host001'
 587                 $searchstr .= "(rcn:" . $pf001->data() . " AND cni:" . $pf003->data() . ")";
 588                 $searchstr .= " OR rcn:\"" . $pf003->data() . " " . $pf001->data() . "\"";
 589                 $searchstr .= ")";
 590             }
 591
 592             # limit to monograph and serial component part records
 593             $searchstr .= " AND (bib-level:a OR bib-level:b)";
 594             $searchstr .= ")";
 595         }
 596     }
 597     else {
 598         my $cleaned_title = $marc->subfield('245', "a");
 599         $cleaned_title =~ tr|/||;
 600         $cleaned_title = $builder->clean_search_term($cleaned_title);
 601         $searchstr = qq#Host-item:("$cleaned_title")#;
 602     }
 603     my ($error, $query_str) = $builder->build_query_compat( undef, [$searchstr], undef, undef, [$sort], 0 );
 604     if( $error ){
 605         warn $error;
 606         return;
 607     }
 608
 609     return ($query_str, $sort);
 610 }
 611
 612 =head3 subscriptions
 613
 614 my $subscriptions = $self->subscriptions
 615
 616 Returns the related Koha::Subscriptions object for this Biblio object
 617
 618 =cut
 619
 620 sub subscriptions {
 621     my ($self) = @_;
 622
 623     $self->{_subscriptions} ||= Koha::Subscriptions->search( { biblionumber => $self->biblionumber } );
 624
 625     return $self->{_subscriptions};
 626 }
 627
 628 =head3 has_items_waiting_or_intransit
 629
 630 my $itemsWaitingOrInTransit = $biblio->has_items_waiting_or_intransit
 631
 632 Tells if this bibliographic record has items waiting or in transit.
 633
 634 =cut
 635
 636 sub has_items_waiting_or_intransit {
 637     my ( $self ) = @_;
 638
 639     if ( Koha::Holds->search({ biblionumber => $self->id,
 640                                found => ['W', 'T'] })->count ) {
 641         return 1;
 642     }
 643
 644     foreach my $item ( $self->items->as_list ) {
 645         return 1 if $item->get_transfer;
 646     }
 647
 648     return 0;
 649 }
 650
 651 =head2 get_coins
 652
 653 my $coins = $biblio->get_coins;
 654
 655 Returns the COinS (a span) which can be included in a biblio record
 656
 657 =cut
 658
 659 sub get_coins {
 660     my ( $self ) = @_;
 661
 662     my $record = $self->metadata->record;
 663
 664     my $pos7 = substr $record->leader(), 7, 1;
 665     my $pos6 = substr $record->leader(), 6, 1;
 666     my $mtx;
 667     my $genre;
 668     my ( $aulast, $aufirst ) = ( '', '' );
 669     my @authors;
 670     my $title;
 671     my $hosttitle;
 672     my $pubyear   = '';
 673     my $isbn      = '';
 674     my $issn      = '';
 675     my $publisher = '';
 676     my $pages     = '';
 677     my $titletype = '';
 678
 679     # For the purposes of generating COinS metadata, LDR/06-07 can be
 680     # considered the same for UNIMARC and MARC21
 681     my $fmts6 = {
 682         'a' => 'book',
 683         'b' => 'manuscript',
 684         'c' => 'book',
 685         'd' => 'manuscript',
 686         'e' => 'map',
 687         'f' => 'map',
 688         'g' => 'film',
 689         'i' => 'audioRecording',
 690         'j' => 'audioRecording',
 691         'k' => 'artwork',
 692         'l' => 'document',
 693         'm' => 'computerProgram',
 694         'o' => 'document',
 695         'r' => 'document',
 696     };
 697     my $fmts7 = {
 698         'a' => 'journalArticle',
 699         's' => 'journal',
 700     };
 701
 702     $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
 703
 704     if ( $genre eq 'book' ) {
 705             $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
 706     }
 707
 708     ##### We must transform mtx to a valable mtx and document type ####
 709     if ( $genre eq 'book' ) {
 710             $mtx = 'book';
 711             $titletype = 'b';
 712     } elsif ( $genre eq 'journal' ) {
 713             $mtx = 'journal';
 714             $titletype = 'j';
 715     } elsif ( $genre eq 'journalArticle' ) {
 716             $mtx   = 'journal';
 717             $genre = 'article';
 718             $titletype = 'a';
 719     } else {
 720             $mtx = 'dc';
 721     }
 722
 723     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
 724
 725         # Setting datas
 726         $aulast  = $record->subfield( '700', 'a' ) || '';
 727         $aufirst = $record->subfield( '700', 'b' ) || '';
 728         push @authors, "$aufirst $aulast" if ($aufirst or $aulast);
 729
 730         # others authors
 731         if ( $record->field('200') ) {
 732             for my $au ( $record->field('200')->subfield('g') ) {
 733                 push @authors, $au;
 734             }
 735         }
 736
 737         $title     = $record->subfield( '200', 'a' );
 738         my $subfield_210d = $record->subfield('210', 'd');
 739         if ($subfield_210d and $subfield_210d =~ /(\d{4})/) {
 740             $pubyear = $1;
 741         }
 742         $publisher = $record->subfield( '210', 'c' ) || '';
 743         $isbn      = $record->subfield( '010', 'a' ) || '';
 744         $issn      = $record->subfield( '011', 'a' ) || '';
 745     } else {
 746
 747         # MARC21 need some improve
 748
 749         # Setting datas
 750         if ( $record->field('100') ) {
 751             push @authors, $record->subfield( '100', 'a' );
 752         }
 753
 754         # others authors
 755         if ( $record->field('700') ) {
 756             for my $au ( $record->field('700')->subfield('a') ) {
 757                 push @authors, $au;
 758             }
 759         }
 760         $title = $record->field('245');
 761         $title &&= $title->as_string('ab');
 762         if ($titletype eq 'a') {
 763             $pubyear   = $record->field('008') || '';
 764             $pubyear   = substr($pubyear->data(), 7, 4) if $pubyear;
 765             $isbn      = $record->subfield( '773', 'z' ) || '';
 766             $issn      = $record->subfield( '773', 'x' ) || '';
 767             $hosttitle = $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{};
 768             my @rels = $record->subfield( '773', 'g' );
 769             $pages = join(', ', @rels);
 770         } else {
 771             $pubyear   = $record->subfield( '260', 'c' ) || '';
 772             $publisher = $record->subfield( '260', 'b' ) || '';
 773             $isbn      = $record->subfield( '020', 'a' ) || '';
 774             $issn      = $record->subfield( '022', 'a' ) || '';
 775         }
 776
 777     }
 778
 779     my @params = (
 780         [ 'ctx_ver', 'Z39.88-2004' ],
 781         [ 'rft_val_fmt', "info:ofi/fmt:kev:mtx:$mtx" ],
 782         [ ($mtx eq 'dc' ? 'rft.type' : 'rft.genre'), $genre ],
 783         [ "rft.${titletype}title", $title ],
 784     );
 785
 786     # rft.title is authorized only once, so by checking $titletype
 787     # we ensure that rft.title is not already in the list.
 788     if ($hosttitle and $titletype) {
 789         push @params, [ 'rft.title', $hosttitle ];
 790     }
 791
 792     push @params, (
 793         [ 'rft.isbn', $isbn ],
 794         [ 'rft.issn', $issn ],
 795     );
 796
 797     # If it's a subscription, these informations have no meaning.
 798     if ($genre ne 'journal') {
 799         push @params, (
 800             [ 'rft.aulast', $aulast ],
 801             [ 'rft.aufirst', $aufirst ],
 802             (map { [ 'rft.au', $_ ] } @authors),
 803             [ 'rft.pub', $publisher ],
 804             [ 'rft.date', $pubyear ],
 805             [ 'rft.pages', $pages ],
 806         );
 807     }
 808
 809     my $coins_value = join( '&amp;',
 810         map { $$_[1] ? $$_[0] . '=' . uri_escape_utf8( $$_[1] ) : () } @params );
 811
 812     return $coins_value;
 813 }
 814
 815 =head2 get_openurl
 816
 817 my $url = $biblio->get_openurl;
 818
 819 Returns url for OpenURL resolver set in OpenURLResolverURL system preference
 820
 821 =cut
 822
 823 sub get_openurl {
 824     my ( $self ) = @_;
 825
 826     my $OpenURLResolverURL = C4::Context->preference('OpenURLResolverURL');
 827
 828     if ($OpenURLResolverURL) {
 829         my $uri = URI->new($OpenURLResolverURL);
 830
 831         if (not defined $uri->query) {
 832             $OpenURLResolverURL .= '?';
 833         } else {
 834             $OpenURLResolverURL .= '&amp;';
 835         }
 836         $OpenURLResolverURL .= $self->get_coins;
 837     }
 838
 839     return $OpenURLResolverURL;
 840 }
 841
 842 =head3 is_serial
 843
 844 my $serial = $biblio->is_serial
 845
 846 Return boolean true if this bibbliographic record is continuing resource
 847
 848 =cut
 849
 850 sub is_serial {
 851     my ( $self ) = @_;
 852
 853     return 1 if $self->serial;
 854
 855     my $record = $self->metadata->record;
 856     return 1 if substr($record->leader, 7, 1) eq 's';
 857
 858     return 0;
 859 }
 860
 861 =head3 custom_cover_image_url
 862
 863 my $image_url = $biblio->custom_cover_image_url
 864
 865 Return the specific url of the cover image for this bibliographic record.
 866 It is built regaring the value of the system preference CustomCoverImagesURL
 867
 868 =cut
 869
 870 sub custom_cover_image_url {
 871     my ( $self ) = @_;
 872     my $url = C4::Context->preference('CustomCoverImagesURL');
 873     if ( $url =~ m|{isbn}| ) {
 874         my $isbn = $self->biblioitem->isbn;
 875         return unless $isbn;
 876         $url =~ s|{isbn}|$isbn|g;
 877     }
 878     if ( $url =~ m|{normalized_isbn}| ) {
 879         my $normalized_isbn = C4::Koha::GetNormalizedISBN($self->biblioitem->isbn);
 880         return unless $normalized_isbn;
 881         $url =~ s|{normalized_isbn}|$normalized_isbn|g;
 882     }
 883     if ( $url =~ m|{issn}| ) {
 884         my $issn = $self->biblioitem->issn;
 885         return unless $issn;
 886         $url =~ s|{issn}|$issn|g;
 887     }
 888
 889     my $re = qr|{(?<field>\d{3})(\$(?<subfield>.))?}|;
 890     if ( $url =~ $re ) {
 891         my $field = $+{field};
 892         my $subfield = $+{subfield};
 893         my $marc_record = $self->metadata->record;
 894         my $value;
 895         if ( $subfield ) {
 896             $value = $marc_record->subfield( $field, $subfield );
 897         } else {
 898             my $controlfield = $marc_record->field($field);
 899             $value = $controlfield->data() if $controlfield;
 900         }
 901         return unless $value;
 902         $url =~ s|$re|$value|;
 903     }
 904
 905     return $url;
 906 }
 907
 908 =head3 cover_images
 909
 910 Return the cover images associated with this biblio.
 911
 912 =cut
 913
 914 sub cover_images {
 915     my ( $self ) = @_;
 916
 917     my $cover_images_rs = $self->_result->cover_images;
 918     return unless $cover_images_rs;
 919     return Koha::CoverImages->_new_from_dbic($cover_images_rs);
 920 }
 921
 922 =head3 get_marc_notes
 923
 924     $marcnotesarray = $biblio->get_marc_notes({ opac => 1 });
 925
 926 Get all notes from the MARC record and returns them in an array.
 927 The notes are stored in different fields depending on MARC flavour.
 928 MARC21 5XX $u subfields receive special attention as they are URIs.
 929
 930 =cut
 931
 932 sub get_marc_notes {
 933     my ( $self, $params ) = @_;
 934
 935     my $marcflavour = C4::Context->preference('marcflavour');
 936     my $opac = $params->{opac} // '0';
 937     my $interface = $params->{opac} ? 'opac' : 'intranet';
 938
 939     my $record = $params->{record} // $self->metadata->record;
 940     my $record_processor = Koha::RecordProcessor->new(
 941         {
 942             filters => [ 'ViewPolicy', 'ExpandCodedFields' ],
 943             options => {
 944                 interface     => $interface,
 945                 frameworkcode => $self->frameworkcode
 946             }
 947         }
 948     );
 949     $record_processor->process($record);
 950
 951     my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
 952     #MARC21 specs indicate some notes should be private if first indicator 0
 953     my %maybe_private = (
 954         541 => 1,
 955         542 => 1,
 956         561 => 1,
 957         583 => 1,
 958         590 => 1
 959     );
 960
 961     my %hiddenlist = map { $_ => 1 }
 962         split( /,/, C4::Context->preference('NotesToHide'));
 963
 964     my @marcnotes;
 965     foreach my $field ( $record->field($scope) ) {
 966         my $tag = $field->tag();
 967         next if $hiddenlist{ $tag };
 968         next if $opac && $maybe_private{$tag} && !$field->indicator(1);
 969         if( $marcflavour ne 'UNIMARC' && $field->subfield('u') ) {
 970             # Field 5XX$u always contains URI
 971             # Examples: 505u, 506u, 510u, 514u, 520u, 530u, 538u, 540u, 542u, 552u, 555u, 561u, 563u, 583u
 972             # We first push the other subfields, then all $u's separately
 973             # Leave further actions to the template (see e.g. opac-detail)
 974             my $othersub =
 975                 join '', ( 'a' .. 't', 'v' .. 'z', '0' .. '9' ); # excl 'u'
 976             push @marcnotes, { marcnote => $field->as_string($othersub) };
 977             foreach my $sub ( $field->subfield('u') ) {
 978                 $sub =~ s/^\s+|\s+$//g; # trim
 979                 push @marcnotes, { marcnote => $sub };
 980             }
 981         } else {
 982             push @marcnotes, { marcnote => $field->as_string() };
 983         }
 984     }
 985     return \@marcnotes;
 986 }
 987
 988 =head3 get_marc_authors
 989
 990     my $authors = $biblio->get_marc_authors;
 991
 992 Get all authors from the MARC record and returns them in an array.
 993 The authors are stored in different fields depending on MARC flavour
 994
 995 =cut
 996
 997 sub get_marc_authors {
 998     my ( $self, $params ) = @_;
 999
1000     my ( $mintag, $maxtag, $fields_filter );
1001     my $marcflavour = C4::Context->preference('marcflavour');
1002
1003     # tagslib useful only for UNIMARC author responsibilities
1004     my $tagslib;
1005     if ( $marcflavour eq "UNIMARC" ) {
1006         $tagslib = C4::Biblio::GetMarcStructure( 1, $self->frameworkcode, { unsafe => 1 });
1007         $mintag = "700";
1008         $maxtag = "712";
1009         $fields_filter = '7..';
1010     } else { # marc21/normarc
1011         $mintag = "700";
1012         $maxtag = "720";
1013         $fields_filter = '7..';
1014     }
1015
1016     my @marcauthors;
1017     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1018
1019     foreach my $field ( $self->metadata->record->field($fields_filter) ) {
1020         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1021         my @subfields_loop;
1022         my @link_loop;
1023         my @subfields  = $field->subfields();
1024         my $count_auth = 0;
1025
1026         # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1027         my $subfield9 = $field->subfield('9');
1028         if ($subfield9) {
1029             my $linkvalue = $subfield9;
1030             $linkvalue =~ s/(\(|\))//g;
1031             @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1032         }
1033
1034         # other subfields
1035         my $unimarc3;
1036         for my $authors_subfield (@subfields) {
1037             next if ( $authors_subfield->[0] eq '9' );
1038
1039             # unimarc3 contains the $3 of the author for UNIMARC.
1040             # For french academic libraries, it's the "ppn", and it's required for idref webservice
1041             $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1042
1043             # don't load unimarc subfields 3, 5
1044             next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1045
1046             my $code = $authors_subfield->[0];
1047             my $value        = $authors_subfield->[1];
1048             my $linkvalue    = $value;
1049             $linkvalue =~ s/(\(|\))//g;
1050             # UNIMARC author responsibility
1051             if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1052                 $value = C4::Biblio::GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1053                 $linkvalue = "($value)";
1054             }
1055             # if no authority link, build a search query
1056             unless ($subfield9) {
1057                 push @link_loop, {
1058                     limit    => 'au',
1059                     'link'   => $linkvalue,
1060                     operator => (scalar @link_loop) ? ' AND ' : undef
1061                 };
1062             }
1063             my @this_link_loop = @link_loop;
1064             # do not display $0
1065             unless ( $code eq '0') {
1066                 push @subfields_loop, {
1067                     tag       => $field->tag(),
1068                     code      => $code,
1069                     value     => $value,
1070                     link_loop => \@this_link_loop,
1071                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1072                 };
1073             }
1074         }
1075         push @marcauthors, {
1076             MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1077             authoritylink => $subfield9,
1078             unimarc3 => $unimarc3
1079         };
1080     }
1081     return \@marcauthors;
1082 }
1083
1084 =head3 to_api
1085
1086     my $json = $biblio->to_api;
1087
1088 Overloaded method that returns a JSON representation of the Koha::Biblio object,
1089 suitable for API output. The related Koha::Biblioitem object is merged as expected
1090 on the API.
1091
1092 =cut
1093
1094 sub to_api {
1095     my ($self, $args) = @_;
1096
1097     my $response = $self->SUPER::to_api( $args );
1098     my $biblioitem = $self->biblioitem->to_api;
1099
1100     return { %$response, %$biblioitem };
1101 }
1102
1103 =head3 to_api_mapping
1104
1105 This method returns the mapping for representing a Koha::Biblio object
1106 on the API.
1107
1108 =cut
1109
1110 sub to_api_mapping {
1111     return {
1112         biblionumber     => 'biblio_id',
1113         frameworkcode    => 'framework_id',
1114         unititle         => 'uniform_title',
1115         seriestitle      => 'series_title',
1116         copyrightdate    => 'copyright_date',
1117         datecreated      => 'creation_date'
1118     };
1119 }
1120
1121 =head3 get_marc_host
1122
1123     $host = $biblio->get_marc_host;
1124     # OR:
1125     ( $host, $relatedparts ) = $biblio->get_marc_host;
1126
1127     Returns host biblio record from MARC21 773 (undef if no 773 present).
1128     It looks at the first 773 field with MARCorgCode or only a control
1129     number. Complete $w or numeric part is used to search host record.
1130     The optional parameter no_items triggers a check if $biblio has items.
1131     If there are, the sub returns undef.
1132     Called in list context, it also returns 773$g (related parts).
1133
1134 =cut
1135
1136 sub get_marc_host {
1137     my ($self, $params) = @_;
1138     my $no_items = $params->{no_items};
1139     return if C4::Context->preference('marcflavour') eq 'UNIMARC'; # TODO
1140     return if $params->{no_items} && $self->items->count > 0;
1141
1142     my $record;
1143     eval { $record = $self->metadata->record };
1144     return if !$record;
1145
1146     # We pick the first $w with your MARCOrgCode or the first $w that has no
1147     # code (between parentheses) at all.
1148     my $orgcode = C4::Context->preference('MARCOrgCode') // q{};
1149     my $hostfld;
1150     foreach my $f ( $record->field('773') ) {
1151         my $w = $f->subfield('w') or next;
1152         if( $w =~ /^\($orgcode\)\s*(\d+)/i or $w =~ /^\d+/ ) {
1153             $hostfld = $f;
1154             last;
1155         }
1156     }
1157     return if !$hostfld;
1158     my $rcn = $hostfld->subfield('w');
1159
1160     # Look for control number with/without orgcode
1161     my $engine = Koha::SearchEngine::Search->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
1162     my $bibno;
1163     for my $try (1..2) {
1164         my ( $error, $results, $total_hits ) = $engine->simple_search_compat( 'Control-number='.$rcn, 0,1 );
1165         if( !$error and $total_hits == 1 ) {
1166             $bibno = $engine->extract_biblionumber( $results->[0] );
1167             last;
1168         }
1169         # Add or remove orgcode for second try
1170         if( $try == 1 && $rcn =~ /\)\s*(\d+)/ ) {
1171             $rcn = $1; # number only
1172         } elsif( $try == 1 && $rcn =~ /^\d+/ ) {
1173             $rcn = "($orgcode)$rcn";
1174         } else {
1175             last;
1176         }
1177     }
1178     if( $bibno ) {
1179         my $host = Koha::Biblios->find($bibno) or return;
1180         return wantarray ? ( $host, $hostfld->subfield('g') ) : $host;
1181     }
1182 }
1183
1184 =head3 recalls
1185
1186     my $recalls = $biblio->recalls;
1187
1188 Return recalls linked to this biblio
1189
1190 =cut
1191
1192 sub recalls {
1193     my ( $self ) = @_;
1194     return Koha::Recalls->_new_from_dbic( scalar $self->_result->recalls );
1195 }
1196
1197 =head3 can_be_recalled
1198
1199     my @items_for_recall = $biblio->can_be_recalled({ patron => $patron_object });
1200
1201 Does biblio-level checks and returns the items attached to this biblio that are available for recall
1202
1203 =cut
1204
1205 sub can_be_recalled {
1206     my ( $self, $params ) = @_;
1207
1208     return 0 if !( C4::Context->preference('UseRecalls') );
1209
1210     my $patron = $params->{patron};
1211
1212     my $branchcode = C4::Context->userenv->{'branch'};
1213     if ( C4::Context->preference('CircControl') eq 'PatronLibrary' and $patron ) {
1214         $branchcode = $patron->branchcode;
1215     }
1216
1217     my @all_items = Koha::Items->search({ biblionumber => $self->biblionumber })->as_list;
1218
1219     # if there are no available items at all, no recall can be placed
1220     return 0 if ( scalar @all_items == 0 );
1221
1222     my @itemtypes;
1223     my @itemnumbers;
1224     my @items;
1225     my @all_itemnumbers;
1226     foreach my $item ( @all_items ) {
1227         push( @all_itemnumbers, $item->itemnumber );
1228         if ( $item->can_be_recalled({ patron => $patron }) ) {
1229             push( @itemtypes, $item->effective_itemtype );
1230             push( @itemnumbers, $item->itemnumber );
1231             push( @items, $item );
1232         }
1233     }
1234
1235     # if there are no recallable items, no recall can be placed
1236     return 0 if ( scalar @items == 0 );
1237
1238     # Check the circulation rule for each relevant itemtype for this biblio
1239     my ( @recalls_allowed, @recalls_per_record, @on_shelf_recalls );
1240     foreach my $itemtype ( @itemtypes ) {
1241         my $rule = Koha::CirculationRules->get_effective_rules({
1242             branchcode => $branchcode,
1243             categorycode => $patron ? $patron->categorycode : undef,
1244             itemtype => $itemtype,
1245             rules => [
1246                 'recalls_allowed',
1247                 'recalls_per_record',
1248                 'on_shelf_recalls',
1249             ],
1250         });
1251         push( @recalls_allowed, $rule->{recalls_allowed} ) if $rule;
1252         push( @recalls_per_record, $rule->{recalls_per_record} ) if $rule;
1253         push( @on_shelf_recalls, $rule->{on_shelf_recalls} ) if $rule;
1254     }
1255     my $recalls_allowed = (sort {$b <=> $a} @recalls_allowed)[0]; # take highest
1256     my $recalls_per_record = (sort {$b <=> $a} @recalls_per_record)[0]; # take highest
1257     my %on_shelf_recalls_count = ();
1258     foreach my $count ( @on_shelf_recalls ) {
1259         $on_shelf_recalls_count{$count}++;
1260     }
1261     my $on_shelf_recalls = (sort {$on_shelf_recalls_count{$b} <=> $on_shelf_recalls_count{$a}} @on_shelf_recalls)[0]; # take most common
1262
1263     # check recalls allowed has been set and is not zero
1264     return 0 if ( !defined($recalls_allowed) || $recalls_allowed == 0 );
1265
1266     if ( $patron ) {
1267         # check borrower has not reached open recalls allowed limit
1268         return 0 if ( $patron->recalls->filter_by_current->count >= $recalls_allowed );
1269
1270         # check borrower has not reached open recalls allowed per record limit
1271         return 0 if ( $patron->recalls->filter_by_current->search({ biblio_id => $self->biblionumber })->count >= $recalls_per_record );
1272
1273         # check if any of the items under this biblio are already checked out by this borrower
1274         return 0 if ( Koha::Checkouts->search({ itemnumber => [ @all_itemnumbers ], borrowernumber => $patron->borrowernumber })->count > 0 );
1275     }
1276
1277     # check item availability
1278     my $checked_out_count = 0;
1279     foreach (@items) {
1280         if ( Koha::Checkouts->search({ itemnumber => $_->itemnumber })->count > 0 ){ $checked_out_count++; }
1281     }
1282
1283     # can't recall if on shelf recalls only allowed when all unavailable, but items are still available for checkout
1284     return 0 if ( $on_shelf_recalls eq 'all' && $checked_out_count < scalar @items );
1285
1286     # can't recall if no items have been checked out
1287     return 0 if ( $checked_out_count == 0 );
1288
1289     # can recall
1290     return @items;
1291 }
1292
1293 =head2 Internal methods
1294
1295 =head3 type
1296
1297 =cut
1298
1299 sub _type {
1300     return 'Biblio';
1301 }
1302
1303 =head1 AUTHOR
1304
1305 Kyle M Hall <kyle@bywatersolutions.com>
1306
1307 =cut
1308
1309 1;