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