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