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