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