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                     payload => $error,
 514                 }
 515             );
 516         }
 517         $components = $results if defined($results) && @$results;
 518     }
 519
 520     return $components // [];
 521 }
 522
 523 =head2 get_components_query
 524
 525 Returns a query which can be used to search for all component parts of MARC21 biblios
 526
 527 =cut
 528
 529 sub get_components_query {
 530     my ($self) = @_;
 531
 532     my $builder = Koha::SearchEngine::QueryBuilder->new(
 533         { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
 534     my $marc = $self->metadata->record;
 535
 536     my $searchstr;
 537     if ( C4::Context->preference('UseControlNumber') ) {
 538         my $pf001 = $marc->field('001') || undef;
 539
 540         if ( defined($pf001) ) {
 541             $searchstr = "(";
 542             my $pf003 = $marc->field('003') || undef;
 543
 544             if ( !defined($pf003) ) {
 545                 # search for 773$w='Host001'
 546                 $searchstr .= "rcn:" . $pf001->data();
 547             }
 548             else {
 549                 $searchstr .= "(";
 550                 # search for (773$w='Host001' and 003='Host003') or 773$w='(Host003)Host001'
 551                 $searchstr .= "(rcn:" . $pf001->data() . " AND cni:" . $pf003->data() . ")";
 552                 $searchstr .= " OR rcn:\"" . $pf003->data() . " " . $pf001->data() . "\"";
 553                 $searchstr .= ")";
 554             }
 555
 556             # limit to monograph and serial component part records
 557             $searchstr .= " AND (bib-level:a OR bib-level:b)";
 558             $searchstr .= ")";
 559         }
 560     }
 561     else {
 562         my $cleaned_title = $marc->subfield('245', "a");
 563         $cleaned_title =~ tr|/||;
 564         $cleaned_title = $builder->clean_search_term($cleaned_title);
 565         $searchstr = "Host-item:($cleaned_title)";
 566     }
 567
 568     return $searchstr;
 569 }
 570
 571 =head3 subscriptions
 572
 573 my $subscriptions = $self->subscriptions
 574
 575 Returns the related Koha::Subscriptions object for this Biblio object
 576
 577 =cut
 578
 579 sub subscriptions {
 580     my ($self) = @_;
 581
 582     $self->{_subscriptions} ||= Koha::Subscriptions->search( { biblionumber => $self->biblionumber } );
 583
 584     return $self->{_subscriptions};
 585 }
 586
 587 =head3 has_items_waiting_or_intransit
 588
 589 my $itemsWaitingOrInTransit = $biblio->has_items_waiting_or_intransit
 590
 591 Tells if this bibliographic record has items waiting or in transit.
 592
 593 =cut
 594
 595 sub has_items_waiting_or_intransit {
 596     my ( $self ) = @_;
 597
 598     if ( Koha::Holds->search({ biblionumber => $self->id,
 599                                found => ['W', 'T'] })->count ) {
 600         return 1;
 601     }
 602
 603     foreach my $item ( $self->items->as_list ) {
 604         return 1 if $item->get_transfer;
 605     }
 606
 607     return 0;
 608 }
 609
 610 =head2 get_coins
 611
 612 my $coins = $biblio->get_coins;
 613
 614 Returns the COinS (a span) which can be included in a biblio record
 615
 616 =cut
 617
 618 sub get_coins {
 619     my ( $self ) = @_;
 620
 621     my $record = $self->metadata->record;
 622
 623     my $pos7 = substr $record->leader(), 7, 1;
 624     my $pos6 = substr $record->leader(), 6, 1;
 625     my $mtx;
 626     my $genre;
 627     my ( $aulast, $aufirst ) = ( '', '' );
 628     my @authors;
 629     my $title;
 630     my $hosttitle;
 631     my $pubyear   = '';
 632     my $isbn      = '';
 633     my $issn      = '';
 634     my $publisher = '';
 635     my $pages     = '';
 636     my $titletype = '';
 637
 638     # For the purposes of generating COinS metadata, LDR/06-07 can be
 639     # considered the same for UNIMARC and MARC21
 640     my $fmts6 = {
 641         'a' => 'book',
 642         'b' => 'manuscript',
 643         'c' => 'book',
 644         'd' => 'manuscript',
 645         'e' => 'map',
 646         'f' => 'map',
 647         'g' => 'film',
 648         'i' => 'audioRecording',
 649         'j' => 'audioRecording',
 650         'k' => 'artwork',
 651         'l' => 'document',
 652         'm' => 'computerProgram',
 653         'o' => 'document',
 654         'r' => 'document',
 655     };
 656     my $fmts7 = {
 657         'a' => 'journalArticle',
 658         's' => 'journal',
 659     };
 660
 661     $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
 662
 663     if ( $genre eq 'book' ) {
 664             $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
 665     }
 666
 667     ##### We must transform mtx to a valable mtx and document type ####
 668     if ( $genre eq 'book' ) {
 669             $mtx = 'book';
 670             $titletype = 'b';
 671     } elsif ( $genre eq 'journal' ) {
 672             $mtx = 'journal';
 673             $titletype = 'j';
 674     } elsif ( $genre eq 'journalArticle' ) {
 675             $mtx   = 'journal';
 676             $genre = 'article';
 677             $titletype = 'a';
 678     } else {
 679             $mtx = 'dc';
 680     }
 681
 682     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
 683
 684         # Setting datas
 685         $aulast  = $record->subfield( '700', 'a' ) || '';
 686         $aufirst = $record->subfield( '700', 'b' ) || '';
 687         push @authors, "$aufirst $aulast" if ($aufirst or $aulast);
 688
 689         # others authors
 690         if ( $record->field('200') ) {
 691             for my $au ( $record->field('200')->subfield('g') ) {
 692                 push @authors, $au;
 693             }
 694         }
 695
 696         $title     = $record->subfield( '200', 'a' );
 697         my $subfield_210d = $record->subfield('210', 'd');
 698         if ($subfield_210d and $subfield_210d =~ /(\d{4})/) {
 699             $pubyear = $1;
 700         }
 701         $publisher = $record->subfield( '210', 'c' ) || '';
 702         $isbn      = $record->subfield( '010', 'a' ) || '';
 703         $issn      = $record->subfield( '011', 'a' ) || '';
 704     } else {
 705
 706         # MARC21 need some improve
 707
 708         # Setting datas
 709         if ( $record->field('100') ) {
 710             push @authors, $record->subfield( '100', 'a' );
 711         }
 712
 713         # others authors
 714         if ( $record->field('700') ) {
 715             for my $au ( $record->field('700')->subfield('a') ) {
 716                 push @authors, $au;
 717             }
 718         }
 719         $title = $record->field('245');
 720         $title &&= $title->as_string('ab');
 721         if ($titletype eq 'a') {
 722             $pubyear   = $record->field('008') || '';
 723             $pubyear   = substr($pubyear->data(), 7, 4) if $pubyear;
 724             $isbn      = $record->subfield( '773', 'z' ) || '';
 725             $issn      = $record->subfield( '773', 'x' ) || '';
 726             $hosttitle = $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{};
 727             my @rels = $record->subfield( '773', 'g' );
 728             $pages = join(', ', @rels);
 729         } else {
 730             $pubyear   = $record->subfield( '260', 'c' ) || '';
 731             $publisher = $record->subfield( '260', 'b' ) || '';
 732             $isbn      = $record->subfield( '020', 'a' ) || '';
 733             $issn      = $record->subfield( '022', 'a' ) || '';
 734         }
 735
 736     }
 737
 738     my @params = (
 739         [ 'ctx_ver', 'Z39.88-2004' ],
 740         [ 'rft_val_fmt', "info:ofi/fmt:kev:mtx:$mtx" ],
 741         [ ($mtx eq 'dc' ? 'rft.type' : 'rft.genre'), $genre ],
 742         [ "rft.${titletype}title", $title ],
 743     );
 744
 745     # rft.title is authorized only once, so by checking $titletype
 746     # we ensure that rft.title is not already in the list.
 747     if ($hosttitle and $titletype) {
 748         push @params, [ 'rft.title', $hosttitle ];
 749     }
 750
 751     push @params, (
 752         [ 'rft.isbn', $isbn ],
 753         [ 'rft.issn', $issn ],
 754     );
 755
 756     # If it's a subscription, these informations have no meaning.
 757     if ($genre ne 'journal') {
 758         push @params, (
 759             [ 'rft.aulast', $aulast ],
 760             [ 'rft.aufirst', $aufirst ],
 761             (map { [ 'rft.au', $_ ] } @authors),
 762             [ 'rft.pub', $publisher ],
 763             [ 'rft.date', $pubyear ],
 764             [ 'rft.pages', $pages ],
 765         );
 766     }
 767
 768     my $coins_value = join( '&amp;',
 769         map { $$_[1] ? $$_[0] . '=' . uri_escape_utf8( $$_[1] ) : () } @params );
 770
 771     return $coins_value;
 772 }
 773
 774 =head2 get_openurl
 775
 776 my $url = $biblio->get_openurl;
 777
 778 Returns url for OpenURL resolver set in OpenURLResolverURL system preference
 779
 780 =cut
 781
 782 sub get_openurl {
 783     my ( $self ) = @_;
 784
 785     my $OpenURLResolverURL = C4::Context->preference('OpenURLResolverURL');
 786
 787     if ($OpenURLResolverURL) {
 788         my $uri = URI->new($OpenURLResolverURL);
 789
 790         if (not defined $uri->query) {
 791             $OpenURLResolverURL .= '?';
 792         } else {
 793             $OpenURLResolverURL .= '&amp;';
 794         }
 795         $OpenURLResolverURL .= $self->get_coins;
 796     }
 797
 798     return $OpenURLResolverURL;
 799 }
 800
 801 =head3 is_serial
 802
 803 my $serial = $biblio->is_serial
 804
 805 Return boolean true if this bibbliographic record is continuing resource
 806
 807 =cut
 808
 809 sub is_serial {
 810     my ( $self ) = @_;
 811
 812     return 1 if $self->serial;
 813
 814     my $record = $self->metadata->record;
 815     return 1 if substr($record->leader, 7, 1) eq 's';
 816
 817     return 0;
 818 }
 819
 820 =head3 custom_cover_image_url
 821
 822 my $image_url = $biblio->custom_cover_image_url
 823
 824 Return the specific url of the cover image for this bibliographic record.
 825 It is built regaring the value of the system preference CustomCoverImagesURL
 826
 827 =cut
 828
 829 sub custom_cover_image_url {
 830     my ( $self ) = @_;
 831     my $url = C4::Context->preference('CustomCoverImagesURL');
 832     if ( $url =~ m|{isbn}| ) {
 833         my $isbn = $self->biblioitem->isbn;
 834         return unless $isbn;
 835         $url =~ s|{isbn}|$isbn|g;
 836     }
 837     if ( $url =~ m|{normalized_isbn}| ) {
 838         my $normalized_isbn = C4::Koha::GetNormalizedISBN($self->biblioitem->isbn);
 839         return unless $normalized_isbn;
 840         $url =~ s|{normalized_isbn}|$normalized_isbn|g;
 841     }
 842     if ( $url =~ m|{issn}| ) {
 843         my $issn = $self->biblioitem->issn;
 844         return unless $issn;
 845         $url =~ s|{issn}|$issn|g;
 846     }
 847
 848     my $re = qr|{(?<field>\d{3})(\$(?<subfield>.))?}|;
 849     if ( $url =~ $re ) {
 850         my $field = $+{field};
 851         my $subfield = $+{subfield};
 852         my $marc_record = $self->metadata->record;
 853         my $value;
 854         if ( $subfield ) {
 855             $value = $marc_record->subfield( $field, $subfield );
 856         } else {
 857             my $controlfield = $marc_record->field($field);
 858             $value = $controlfield->data() if $controlfield;
 859         }
 860         return unless $value;
 861         $url =~ s|$re|$value|;
 862     }
 863
 864     return $url;
 865 }
 866
 867 =head3 cover_images
 868
 869 Return the cover images associated with this biblio.
 870
 871 =cut
 872
 873 sub cover_images {
 874     my ( $self ) = @_;
 875
 876     my $cover_images_rs = $self->_result->cover_images;
 877     return unless $cover_images_rs;
 878     return Koha::CoverImages->_new_from_dbic($cover_images_rs);
 879 }
 880
 881 =head3 get_marc_notes
 882
 883     $marcnotesarray = $biblio->get_marc_notes({ marcflavour => $marcflavour });
 884
 885 Get all notes from the MARC record and returns them in an array.
 886 The notes are stored in different fields depending on MARC flavour.
 887 MARC21 5XX $u subfields receive special attention as they are URIs.
 888
 889 =cut
 890
 891 sub get_marc_notes {
 892     my ( $self, $params ) = @_;
 893
 894     my $marcflavour = $params->{marcflavour};
 895     my $opac = $params->{opac};
 896
 897     my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
 898     my @marcnotes;
 899
 900     #MARC21 specs indicate some notes should be private if first indicator 0
 901     my %maybe_private = (
 902         541 => 1,
 903         542 => 1,
 904         561 => 1,
 905         583 => 1,
 906         590 => 1
 907     );
 908
 909     my %hiddenlist = map { $_ => 1 }
 910         split( /,/, C4::Context->preference('NotesToHide'));
 911     my $record = $self->metadata->record;
 912     $record = transformMARCXML4XSLT( $self->biblionumber, $record, $opac );
 913
 914     foreach my $field ( $record->field($scope) ) {
 915         my $tag = $field->tag();
 916         next if $hiddenlist{ $tag };
 917         next if $opac && $maybe_private{$tag} && !$field->indicator(1);
 918         if( $marcflavour ne 'UNIMARC' && $field->subfield('u') ) {
 919             # Field 5XX$u always contains URI
 920             # Examples: 505u, 506u, 510u, 514u, 520u, 530u, 538u, 540u, 542u, 552u, 555u, 561u, 563u, 583u
 921             # We first push the other subfields, then all $u's separately
 922             # Leave further actions to the template (see e.g. opac-detail)
 923             my $othersub =
 924                 join '', ( 'a' .. 't', 'v' .. 'z', '0' .. '9' ); # excl 'u'
 925             push @marcnotes, { marcnote => $field->as_string($othersub) };
 926             foreach my $sub ( $field->subfield('u') ) {
 927                 $sub =~ s/^\s+|\s+$//g; # trim
 928                 push @marcnotes, { marcnote => $sub };
 929             }
 930         } else {
 931             push @marcnotes, { marcnote => $field->as_string() };
 932         }
 933     }
 934     return \@marcnotes;
 935 }
 936
 937 =head3 to_api
 938
 939     my $json = $biblio->to_api;
 940
 941 Overloaded method that returns a JSON representation of the Koha::Biblio object,
 942 suitable for API output. The related Koha::Biblioitem object is merged as expected
 943 on the API.
 944
 945 =cut
 946
 947 sub to_api {
 948     my ($self, $args) = @_;
 949
 950     my $response = $self->SUPER::to_api( $args );
 951     my $biblioitem = $self->biblioitem->to_api;
 952
 953     return { %$response, %$biblioitem };
 954 }
 955
 956 =head3 to_api_mapping
 957
 958 This method returns the mapping for representing a Koha::Biblio object
 959 on the API.
 960
 961 =cut
 962
 963 sub to_api_mapping {
 964     return {
 965         biblionumber     => 'biblio_id',
 966         frameworkcode    => 'framework_id',
 967         unititle         => 'uniform_title',
 968         seriestitle      => 'series_title',
 969         copyrightdate    => 'copyright_date',
 970         datecreated      => 'creation_date'
 971     };
 972 }
 973
 974 =head3 get_marc_host
 975
 976     $host = $biblio->get_marc_host;
 977     # OR:
 978     ( $host, $relatedparts ) = $biblio->get_marc_host;
 979
 980     Returns host biblio record from MARC21 773 (undef if no 773 present).
 981     It looks at the first 773 field with MARCorgCode or only a control
 982     number. Complete $w or numeric part is used to search host record.
 983     The optional parameter no_items triggers a check if $biblio has items.
 984     If there are, the sub returns undef.
 985     Called in list context, it also returns 773$g (related parts).
 986
 987 =cut
 988
 989 sub get_marc_host {
 990     my ($self, $params) = @_;
 991     my $no_items = $params->{no_items};
 992     return if C4::Context->preference('marcflavour') eq 'UNIMARC'; # TODO
 993     return if $params->{no_items} && $self->items->count > 0;
 994
 995     my $record;
 996     eval { $record = $self->metadata->record };
 997     return if !$record;
 998
 999     # We pick the first $w with your MARCOrgCode or the first $w that has no
1000     # code (between parentheses) at all.
1001     my $orgcode = C4::Context->preference('MARCOrgCode') // q{};
1002     my $hostfld;
1003     foreach my $f ( $record->field('773') ) {
1004         my $w = $f->subfield('w') or next;
1005         if( $w =~ /^\($orgcode\)\s*(\d+)/i or $w =~ /^\d+/ ) {
1006             $hostfld = $f;
1007             last;
1008         }
1009     }
1010     return if !$hostfld;
1011     my $rcn = $hostfld->subfield('w');
1012
1013     # Look for control number with/without orgcode
1014     my $engine = Koha::SearchEngine::Search->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
1015     my $bibno;
1016     for my $try (1..2) {
1017         my ( $error, $results, $total_hits ) = $engine->simple_search_compat( 'Control-number='.$rcn, 0,1 );
1018         if( !$error and $total_hits == 1 ) {
1019             $bibno = $engine->extract_biblionumber( $results->[0] );
1020             last;
1021         }
1022         # Add or remove orgcode for second try
1023         if( $try == 1 && $rcn =~ /\)\s*(\d+)/ ) {
1024             $rcn = $1; # number only
1025         } elsif( $try == 1 && $rcn =~ /^\d+/ ) {
1026             $rcn = "($orgcode)$rcn";
1027         } else {
1028             last;
1029         }
1030     }
1031     if( $bibno ) {
1032         my $host = Koha::Biblios->find($bibno) or return;
1033         return wantarray ? ( $host, $hostfld->subfield('g') ) : $host;
1034     }
1035 }
1036
1037 =head2 Internal methods
1038
1039 =head3 type
1040
1041 =cut
1042
1043 sub _type {
1044     return 'Biblio';
1045 }
1046
1047 =head1 AUTHOR
1048
1049 Kyle M Hall <kyle@bywatersolutions.com>
1050
1051 =cut
1052
1053 1;