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 use C4::XSLT qw( transformMARCXML4XSLT );
  28
  29 use Koha::Database;
  30 use Koha::DateUtils qw( dt_from_string );
  31
  32 use base qw(Koha::Object);
  33
  34 use Koha::Acquisition::Orders;
  35 use Koha::ArticleRequests;
  36 use Koha::Biblio::Metadatas;
  37 use Koha::Biblioitems;
  38 use Koha::Checkouts;
  39 use Koha::CirculationRules;
  40 use Koha::Item::Transfer::Limits;
  41 use Koha::Items;
  42 use Koha::Libraries;
  43 use Koha::Old::Checkouts;
  44 use Koha::Recalls;
  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 MARCXML data, which are component parts of
 520 this object (MARC21 773$w 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 = $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, $total_hits );
 535         eval {
 536             ( $error, $results, $total_hits ) = $searcher->simple_search_compat( $searchstr, 0, $max_results );
 537         };
 538         if( $error || $@ ) {
 539             $error //= q{};
 540             $error .= $@ if $@;
 541             warn "Warning from simple_search_compat: '$error'";
 542             $self->add_message(
 543                 {
 544                     type    => 'error',
 545                     message => 'component_search',
 546                     payload => $error,
 547                 }
 548             );
 549         }
 550         $components = $results if defined($results) && @$results;
 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
 569     my $searchstr;
 570     if ( C4::Context->preference('UseControlNumber') ) {
 571         my $pf001 = $marc->field('001') || undef;
 572
 573         if ( defined($pf001) ) {
 574             $searchstr = "(";
 575             my $pf003 = $marc->field('003') || undef;
 576
 577             if ( !defined($pf003) ) {
 578                 # search for 773$w='Host001'
 579                 $searchstr .= "rcn:" . $pf001->data();
 580             }
 581             else {
 582                 $searchstr .= "(";
 583                 # search for (773$w='Host001' and 003='Host003') or 773$w='(Host003)Host001'
 584                 $searchstr .= "(rcn:" . $pf001->data() . " AND cni:" . $pf003->data() . ")";
 585                 $searchstr .= " OR rcn:\"" . $pf003->data() . " " . $pf001->data() . "\"";
 586                 $searchstr .= ")";
 587             }
 588
 589             # limit to monograph and serial component part records
 590             $searchstr .= " AND (bib-level:a OR bib-level:b)";
 591             $searchstr .= ")";
 592         }
 593     }
 594     else {
 595         my $cleaned_title = $marc->subfield('245', "a");
 596         $cleaned_title =~ tr|/||;
 597         $cleaned_title = $builder->clean_search_term($cleaned_title);
 598         $searchstr = "Host-item:($cleaned_title)";
 599     }
 600
 601     return $searchstr;
 602 }
 603
 604 =head3 subscriptions
 605
 606 my $subscriptions = $self->subscriptions
 607
 608 Returns the related Koha::Subscriptions object for this Biblio object
 609
 610 =cut
 611
 612 sub subscriptions {
 613     my ($self) = @_;
 614
 615     $self->{_subscriptions} ||= Koha::Subscriptions->search( { biblionumber => $self->biblionumber } );
 616
 617     return $self->{_subscriptions};
 618 }
 619
 620 =head3 has_items_waiting_or_intransit
 621
 622 my $itemsWaitingOrInTransit = $biblio->has_items_waiting_or_intransit
 623
 624 Tells if this bibliographic record has items waiting or in transit.
 625
 626 =cut
 627
 628 sub has_items_waiting_or_intransit {
 629     my ( $self ) = @_;
 630
 631     if ( Koha::Holds->search({ biblionumber => $self->id,
 632                                found => ['W', 'T'] })->count ) {
 633         return 1;
 634     }
 635
 636     foreach my $item ( $self->items->as_list ) {
 637         return 1 if $item->get_transfer;
 638     }
 639
 640     return 0;
 641 }
 642
 643 =head2 get_coins
 644
 645 my $coins = $biblio->get_coins;
 646
 647 Returns the COinS (a span) which can be included in a biblio record
 648
 649 =cut
 650
 651 sub get_coins {
 652     my ( $self ) = @_;
 653
 654     my $record = $self->metadata->record;
 655
 656     my $pos7 = substr $record->leader(), 7, 1;
 657     my $pos6 = substr $record->leader(), 6, 1;
 658     my $mtx;
 659     my $genre;
 660     my ( $aulast, $aufirst ) = ( '', '' );
 661     my @authors;
 662     my $title;
 663     my $hosttitle;
 664     my $pubyear   = '';
 665     my $isbn      = '';
 666     my $issn      = '';
 667     my $publisher = '';
 668     my $pages     = '';
 669     my $titletype = '';
 670
 671     # For the purposes of generating COinS metadata, LDR/06-07 can be
 672     # considered the same for UNIMARC and MARC21
 673     my $fmts6 = {
 674         'a' => 'book',
 675         'b' => 'manuscript',
 676         'c' => 'book',
 677         'd' => 'manuscript',
 678         'e' => 'map',
 679         'f' => 'map',
 680         'g' => 'film',
 681         'i' => 'audioRecording',
 682         'j' => 'audioRecording',
 683         'k' => 'artwork',
 684         'l' => 'document',
 685         'm' => 'computerProgram',
 686         'o' => 'document',
 687         'r' => 'document',
 688     };
 689     my $fmts7 = {
 690         'a' => 'journalArticle',
 691         's' => 'journal',
 692     };
 693
 694     $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
 695
 696     if ( $genre eq 'book' ) {
 697             $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
 698     }
 699
 700     ##### We must transform mtx to a valable mtx and document type ####
 701     if ( $genre eq 'book' ) {
 702             $mtx = 'book';
 703             $titletype = 'b';
 704     } elsif ( $genre eq 'journal' ) {
 705             $mtx = 'journal';
 706             $titletype = 'j';
 707     } elsif ( $genre eq 'journalArticle' ) {
 708             $mtx   = 'journal';
 709             $genre = 'article';
 710             $titletype = 'a';
 711     } else {
 712             $mtx = 'dc';
 713     }
 714
 715     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
 716
 717         # Setting datas
 718         $aulast  = $record->subfield( '700', 'a' ) || '';
 719         $aufirst = $record->subfield( '700', 'b' ) || '';
 720         push @authors, "$aufirst $aulast" if ($aufirst or $aulast);
 721
 722         # others authors
 723         if ( $record->field('200') ) {
 724             for my $au ( $record->field('200')->subfield('g') ) {
 725                 push @authors, $au;
 726             }
 727         }
 728
 729         $title     = $record->subfield( '200', 'a' );
 730         my $subfield_210d = $record->subfield('210', 'd');
 731         if ($subfield_210d and $subfield_210d =~ /(\d{4})/) {
 732             $pubyear = $1;
 733         }
 734         $publisher = $record->subfield( '210', 'c' ) || '';
 735         $isbn      = $record->subfield( '010', 'a' ) || '';
 736         $issn      = $record->subfield( '011', 'a' ) || '';
 737     } else {
 738
 739         # MARC21 need some improve
 740
 741         # Setting datas
 742         if ( $record->field('100') ) {
 743             push @authors, $record->subfield( '100', 'a' );
 744         }
 745
 746         # others authors
 747         if ( $record->field('700') ) {
 748             for my $au ( $record->field('700')->subfield('a') ) {
 749                 push @authors, $au;
 750             }
 751         }
 752         $title = $record->field('245');
 753         $title &&= $title->as_string('ab');
 754         if ($titletype eq 'a') {
 755             $pubyear   = $record->field('008') || '';
 756             $pubyear   = substr($pubyear->data(), 7, 4) if $pubyear;
 757             $isbn      = $record->subfield( '773', 'z' ) || '';
 758             $issn      = $record->subfield( '773', 'x' ) || '';
 759             $hosttitle = $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{};
 760             my @rels = $record->subfield( '773', 'g' );
 761             $pages = join(', ', @rels);
 762         } else {
 763             $pubyear   = $record->subfield( '260', 'c' ) || '';
 764             $publisher = $record->subfield( '260', 'b' ) || '';
 765             $isbn      = $record->subfield( '020', 'a' ) || '';
 766             $issn      = $record->subfield( '022', 'a' ) || '';
 767         }
 768
 769     }
 770
 771     my @params = (
 772         [ 'ctx_ver', 'Z39.88-2004' ],
 773         [ 'rft_val_fmt', "info:ofi/fmt:kev:mtx:$mtx" ],
 774         [ ($mtx eq 'dc' ? 'rft.type' : 'rft.genre'), $genre ],
 775         [ "rft.${titletype}title", $title ],
 776     );
 777
 778     # rft.title is authorized only once, so by checking $titletype
 779     # we ensure that rft.title is not already in the list.
 780     if ($hosttitle and $titletype) {
 781         push @params, [ 'rft.title', $hosttitle ];
 782     }
 783
 784     push @params, (
 785         [ 'rft.isbn', $isbn ],
 786         [ 'rft.issn', $issn ],
 787     );
 788
 789     # If it's a subscription, these informations have no meaning.
 790     if ($genre ne 'journal') {
 791         push @params, (
 792             [ 'rft.aulast', $aulast ],
 793             [ 'rft.aufirst', $aufirst ],
 794             (map { [ 'rft.au', $_ ] } @authors),
 795             [ 'rft.pub', $publisher ],
 796             [ 'rft.date', $pubyear ],
 797             [ 'rft.pages', $pages ],
 798         );
 799     }
 800
 801     my $coins_value = join( '&amp;',
 802         map { $$_[1] ? $$_[0] . '=' . uri_escape_utf8( $$_[1] ) : () } @params );
 803
 804     return $coins_value;
 805 }
 806
 807 =head2 get_openurl
 808
 809 my $url = $biblio->get_openurl;
 810
 811 Returns url for OpenURL resolver set in OpenURLResolverURL system preference
 812
 813 =cut
 814
 815 sub get_openurl {
 816     my ( $self ) = @_;
 817
 818     my $OpenURLResolverURL = C4::Context->preference('OpenURLResolverURL');
 819
 820     if ($OpenURLResolverURL) {
 821         my $uri = URI->new($OpenURLResolverURL);
 822
 823         if (not defined $uri->query) {
 824             $OpenURLResolverURL .= '?';
 825         } else {
 826             $OpenURLResolverURL .= '&amp;';
 827         }
 828         $OpenURLResolverURL .= $self->get_coins;
 829     }
 830
 831     return $OpenURLResolverURL;
 832 }
 833
 834 =head3 is_serial
 835
 836 my $serial = $biblio->is_serial
 837
 838 Return boolean true if this bibbliographic record is continuing resource
 839
 840 =cut
 841
 842 sub is_serial {
 843     my ( $self ) = @_;
 844
 845     return 1 if $self->serial;
 846
 847     my $record = $self->metadata->record;
 848     return 1 if substr($record->leader, 7, 1) eq 's';
 849
 850     return 0;
 851 }
 852
 853 =head3 custom_cover_image_url
 854
 855 my $image_url = $biblio->custom_cover_image_url
 856
 857 Return the specific url of the cover image for this bibliographic record.
 858 It is built regaring the value of the system preference CustomCoverImagesURL
 859
 860 =cut
 861
 862 sub custom_cover_image_url {
 863     my ( $self ) = @_;
 864     my $url = C4::Context->preference('CustomCoverImagesURL');
 865     if ( $url =~ m|{isbn}| ) {
 866         my $isbn = $self->biblioitem->isbn;
 867         return unless $isbn;
 868         $url =~ s|{isbn}|$isbn|g;
 869     }
 870     if ( $url =~ m|{normalized_isbn}| ) {
 871         my $normalized_isbn = C4::Koha::GetNormalizedISBN($self->biblioitem->isbn);
 872         return unless $normalized_isbn;
 873         $url =~ s|{normalized_isbn}|$normalized_isbn|g;
 874     }
 875     if ( $url =~ m|{issn}| ) {
 876         my $issn = $self->biblioitem->issn;
 877         return unless $issn;
 878         $url =~ s|{issn}|$issn|g;
 879     }
 880
 881     my $re = qr|{(?<field>\d{3})(\$(?<subfield>.))?}|;
 882     if ( $url =~ $re ) {
 883         my $field = $+{field};
 884         my $subfield = $+{subfield};
 885         my $marc_record = $self->metadata->record;
 886         my $value;
 887         if ( $subfield ) {
 888             $value = $marc_record->subfield( $field, $subfield );
 889         } else {
 890             my $controlfield = $marc_record->field($field);
 891             $value = $controlfield->data() if $controlfield;
 892         }
 893         return unless $value;
 894         $url =~ s|$re|$value|;
 895     }
 896
 897     return $url;
 898 }
 899
 900 =head3 cover_images
 901
 902 Return the cover images associated with this biblio.
 903
 904 =cut
 905
 906 sub cover_images {
 907     my ( $self ) = @_;
 908
 909     my $cover_images_rs = $self->_result->cover_images;
 910     return unless $cover_images_rs;
 911     return Koha::CoverImages->_new_from_dbic($cover_images_rs);
 912 }
 913
 914 =head3 get_marc_notes
 915
 916     $marcnotesarray = $biblio->get_marc_notes({ marcflavour => $marcflavour });
 917
 918 Get all notes from the MARC record and returns them in an array.
 919 The notes are stored in different fields depending on MARC flavour.
 920 MARC21 5XX $u subfields receive special attention as they are URIs.
 921
 922 =cut
 923
 924 sub get_marc_notes {
 925     my ( $self, $params ) = @_;
 926
 927     my $marcflavour = $params->{marcflavour};
 928     my $opac = $params->{opac};
 929
 930     my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
 931     my @marcnotes;
 932
 933     #MARC21 specs indicate some notes should be private if first indicator 0
 934     my %maybe_private = (
 935         541 => 1,
 936         542 => 1,
 937         561 => 1,
 938         583 => 1,
 939         590 => 1
 940     );
 941
 942     my %hiddenlist = map { $_ => 1 }
 943         split( /,/, C4::Context->preference('NotesToHide'));
 944     my $record = $self->metadata->record;
 945     $record = transformMARCXML4XSLT( $self->biblionumber, $record, $opac );
 946
 947     foreach my $field ( $record->field($scope) ) {
 948         my $tag = $field->tag();
 949         next if $hiddenlist{ $tag };
 950         next if $opac && $maybe_private{$tag} && !$field->indicator(1);
 951         if( $marcflavour ne 'UNIMARC' && $field->subfield('u') ) {
 952             # Field 5XX$u always contains URI
 953             # Examples: 505u, 506u, 510u, 514u, 520u, 530u, 538u, 540u, 542u, 552u, 555u, 561u, 563u, 583u
 954             # We first push the other subfields, then all $u's separately
 955             # Leave further actions to the template (see e.g. opac-detail)
 956             my $othersub =
 957                 join '', ( 'a' .. 't', 'v' .. 'z', '0' .. '9' ); # excl 'u'
 958             push @marcnotes, { marcnote => $field->as_string($othersub) };
 959             foreach my $sub ( $field->subfield('u') ) {
 960                 $sub =~ s/^\s+|\s+$//g; # trim
 961                 push @marcnotes, { marcnote => $sub };
 962             }
 963         } else {
 964             push @marcnotes, { marcnote => $field->as_string() };
 965         }
 966     }
 967     return \@marcnotes;
 968 }
 969
 970 =head3 get_marc_authors
 971
 972     my $authors = $biblio->get_marc_authors;
 973
 974 Get all authors from the MARC record and returns them in an array.
 975 The authors are stored in different fields depending on MARC flavour
 976
 977 =cut
 978
 979 sub get_marc_authors {
 980     my ( $self, $params ) = @_;
 981
 982     my ( $mintag, $maxtag, $fields_filter );
 983     my $marcflavour = C4::Context->preference('marcflavour');
 984
 985     # tagslib useful only for UNIMARC author responsibilities
 986     my $tagslib;
 987     if ( $marcflavour eq "UNIMARC" ) {
 988         $tagslib = C4::Biblio::GetMarcStructure( 1, $self->frameworkcode, { unsafe => 1 });
 989         $mintag = "700";
 990         $maxtag = "712";
 991         $fields_filter = '7..';
 992     } else { # marc21/normarc
 993         $mintag = "700";
 994         $maxtag = "720";
 995         $fields_filter = '7..';
 996     }
 997
 998     my @marcauthors;
 999     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1000
1001     foreach my $field ( $self->metadata->record->field($fields_filter) ) {
1002         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1003         my @subfields_loop;
1004         my @link_loop;
1005         my @subfields  = $field->subfields();
1006         my $count_auth = 0;
1007
1008         # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1009         my $subfield9 = $field->subfield('9');
1010         if ($subfield9) {
1011             my $linkvalue = $subfield9;
1012             $linkvalue =~ s/(\(|\))//g;
1013             @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1014         }
1015
1016         # other subfields
1017         my $unimarc3;
1018         for my $authors_subfield (@subfields) {
1019             next if ( $authors_subfield->[0] eq '9' );
1020
1021             # unimarc3 contains the $3 of the author for UNIMARC.
1022             # For french academic libraries, it's the "ppn", and it's required for idref webservice
1023             $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1024
1025             # don't load unimarc subfields 3, 5
1026             next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1027
1028             my $code = $authors_subfield->[0];
1029             my $value        = $authors_subfield->[1];
1030             my $linkvalue    = $value;
1031             $linkvalue =~ s/(\(|\))//g;
1032             # UNIMARC author responsibility
1033             if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1034                 $value = C4::Biblio::GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1035                 $linkvalue = "($value)";
1036             }
1037             # if no authority link, build a search query
1038             unless ($subfield9) {
1039                 push @link_loop, {
1040                     limit    => 'au',
1041                     'link'   => $linkvalue,
1042                     operator => (scalar @link_loop) ? ' AND ' : undef
1043                 };
1044             }
1045             my @this_link_loop = @link_loop;
1046             # do not display $0
1047             unless ( $code eq '0') {
1048                 push @subfields_loop, {
1049                     tag       => $field->tag(),
1050                     code      => $code,
1051                     value     => $value,
1052                     link_loop => \@this_link_loop,
1053                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1054                 };
1055             }
1056         }
1057         push @marcauthors, {
1058             MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1059             authoritylink => $subfield9,
1060             unimarc3 => $unimarc3
1061         };
1062     }
1063     return \@marcauthors;
1064 }
1065
1066 =head3 to_api
1067
1068     my $json = $biblio->to_api;
1069
1070 Overloaded method that returns a JSON representation of the Koha::Biblio object,
1071 suitable for API output. The related Koha::Biblioitem object is merged as expected
1072 on the API.
1073
1074 =cut
1075
1076 sub to_api {
1077     my ($self, $args) = @_;
1078
1079     my $response = $self->SUPER::to_api( $args );
1080     my $biblioitem = $self->biblioitem->to_api;
1081
1082     return { %$response, %$biblioitem };
1083 }
1084
1085 =head3 to_api_mapping
1086
1087 This method returns the mapping for representing a Koha::Biblio object
1088 on the API.
1089
1090 =cut
1091
1092 sub to_api_mapping {
1093     return {
1094         biblionumber     => 'biblio_id',
1095         frameworkcode    => 'framework_id',
1096         unititle         => 'uniform_title',
1097         seriestitle      => 'series_title',
1098         copyrightdate    => 'copyright_date',
1099         datecreated      => 'creation_date'
1100     };
1101 }
1102
1103 =head3 get_marc_host
1104
1105     $host = $biblio->get_marc_host;
1106     # OR:
1107     ( $host, $relatedparts ) = $biblio->get_marc_host;
1108
1109     Returns host biblio record from MARC21 773 (undef if no 773 present).
1110     It looks at the first 773 field with MARCorgCode or only a control
1111     number. Complete $w or numeric part is used to search host record.
1112     The optional parameter no_items triggers a check if $biblio has items.
1113     If there are, the sub returns undef.
1114     Called in list context, it also returns 773$g (related parts).
1115
1116 =cut
1117
1118 sub get_marc_host {
1119     my ($self, $params) = @_;
1120     my $no_items = $params->{no_items};
1121     return if C4::Context->preference('marcflavour') eq 'UNIMARC'; # TODO
1122     return if $params->{no_items} && $self->items->count > 0;
1123
1124     my $record;
1125     eval { $record = $self->metadata->record };
1126     return if !$record;
1127
1128     # We pick the first $w with your MARCOrgCode or the first $w that has no
1129     # code (between parentheses) at all.
1130     my $orgcode = C4::Context->preference('MARCOrgCode') // q{};
1131     my $hostfld;
1132     foreach my $f ( $record->field('773') ) {
1133         my $w = $f->subfield('w') or next;
1134         if( $w =~ /^\($orgcode\)\s*(\d+)/i or $w =~ /^\d+/ ) {
1135             $hostfld = $f;
1136             last;
1137         }
1138     }
1139     return if !$hostfld;
1140     my $rcn = $hostfld->subfield('w');
1141
1142     # Look for control number with/without orgcode
1143     my $engine = Koha::SearchEngine::Search->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
1144     my $bibno;
1145     for my $try (1..2) {
1146         my ( $error, $results, $total_hits ) = $engine->simple_search_compat( 'Control-number='.$rcn, 0,1 );
1147         if( !$error and $total_hits == 1 ) {
1148             $bibno = $engine->extract_biblionumber( $results->[0] );
1149             last;
1150         }
1151         # Add or remove orgcode for second try
1152         if( $try == 1 && $rcn =~ /\)\s*(\d+)/ ) {
1153             $rcn = $1; # number only
1154         } elsif( $try == 1 && $rcn =~ /^\d+/ ) {
1155             $rcn = "($orgcode)$rcn";
1156         } else {
1157             last;
1158         }
1159     }
1160     if( $bibno ) {
1161         my $host = Koha::Biblios->find($bibno) or return;
1162         return wantarray ? ( $host, $hostfld->subfield('g') ) : $host;
1163     }
1164 }
1165
1166 =head3 recalls
1167
1168     my $recalls = $biblio->recalls;
1169
1170 Return recalls linked to this biblio
1171
1172 =cut
1173
1174 sub recalls {
1175     my ( $self ) = @_;
1176     return Koha::Recalls->_new_from_dbic( scalar $self->_result->recalls );
1177 }
1178
1179 =head3 can_be_recalled
1180
1181     my @items_for_recall = $biblio->can_be_recalled({ patron => $patron_object });
1182
1183 Does biblio-level checks and returns the items attached to this biblio that are available for recall
1184
1185 =cut
1186
1187 sub can_be_recalled {
1188     my ( $self, $params ) = @_;
1189
1190     return 0 if !( C4::Context->preference('UseRecalls') );
1191
1192     my $patron = $params->{patron};
1193
1194     my $branchcode = C4::Context->userenv->{'branch'};
1195     if ( C4::Context->preference('CircControl') eq 'PatronLibrary' and $patron ) {
1196         $branchcode = $patron->branchcode;
1197     }
1198
1199     my @all_items = Koha::Items->search({ biblionumber => $self->biblionumber })->as_list;
1200
1201     # if there are no available items at all, no recall can be placed
1202     return 0 if ( scalar @all_items == 0 );
1203
1204     my @itemtypes;
1205     my @itemnumbers;
1206     my @items;
1207     my @all_itemnumbers;
1208     foreach my $item ( @all_items ) {
1209         push( @all_itemnumbers, $item->itemnumber );
1210         if ( $item->can_be_recalled({ patron => $patron }) ) {
1211             push( @itemtypes, $item->effective_itemtype );
1212             push( @itemnumbers, $item->itemnumber );
1213             push( @items, $item );
1214         }
1215     }
1216
1217     # if there are no recallable items, no recall can be placed
1218     return 0 if ( scalar @items == 0 );
1219
1220     # Check the circulation rule for each relevant itemtype for this biblio
1221     my ( @recalls_allowed, @recalls_per_record, @on_shelf_recalls );
1222     foreach my $itemtype ( @itemtypes ) {
1223         my $rule = Koha::CirculationRules->get_effective_rules({
1224             branchcode => $branchcode,
1225             categorycode => $patron ? $patron->categorycode : undef,
1226             itemtype => $itemtype,
1227             rules => [
1228                 'recalls_allowed',
1229                 'recalls_per_record',
1230                 'on_shelf_recalls',
1231             ],
1232         });
1233         push( @recalls_allowed, $rule->{recalls_allowed} ) if $rule;
1234         push( @recalls_per_record, $rule->{recalls_per_record} ) if $rule;
1235         push( @on_shelf_recalls, $rule->{on_shelf_recalls} ) if $rule;
1236     }
1237     my $recalls_allowed = (sort {$b <=> $a} @recalls_allowed)[0]; # take highest
1238     my $recalls_per_record = (sort {$b <=> $a} @recalls_per_record)[0]; # take highest
1239     my %on_shelf_recalls_count = ();
1240     foreach my $count ( @on_shelf_recalls ) {
1241         $on_shelf_recalls_count{$count}++;
1242     }
1243     my $on_shelf_recalls = (sort {$on_shelf_recalls_count{$b} <=> $on_shelf_recalls_count{$a}} @on_shelf_recalls)[0]; # take most common
1244
1245     # check recalls allowed has been set and is not zero
1246     return 0 if ( !defined($recalls_allowed) || $recalls_allowed == 0 );
1247
1248     if ( $patron ) {
1249         # check borrower has not reached open recalls allowed limit
1250         return 0 if ( $patron->recalls->filter_by_current->count >= $recalls_allowed );
1251
1252         # check borrower has not reached open recalls allowed per record limit
1253         return 0 if ( $patron->recalls->filter_by_current->search({ biblionumber => $self->biblionumber })->count >= $recalls_per_record );
1254
1255         # check if any of the items under this biblio are already checked out by this borrower
1256         return 0 if ( Koha::Checkouts->search({ itemnumber => [ @all_itemnumbers ], borrowernumber => $patron->borrowernumber })->count > 0 );
1257     }
1258
1259     # check item availability
1260     my $checked_out_count = 0;
1261     foreach (@items) {
1262         if ( Koha::Checkouts->search({ itemnumber => $_->itemnumber })->count > 0 ){ $checked_out_count++; }
1263     }
1264
1265     # can't recall if on shelf recalls only allowed when all unavailable, but items are still available for checkout
1266     return 0 if ( $on_shelf_recalls eq 'all' && $checked_out_count < scalar @items );
1267
1268     # can't recall if no items have been checked out
1269     return 0 if ( $checked_out_count == 0 );
1270
1271     # can recall
1272     return @items;
1273 }
1274
1275 =head2 Internal methods
1276
1277 =head3 type
1278
1279 =cut
1280
1281 sub _type {
1282     return 'Biblio';
1283 }
1284
1285 =head1 AUTHOR
1286
1287 Kyle M Hall <kyle@bywatersolutions.com>
1288
1289 =cut
1290
1291 1;