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