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