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