koha-dev.rot13.org Git - srvgit/blob - 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::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 @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, $borrower ) = @_;
 352
 353     $self->{_article_requests} ||= Koha::ArticleRequests->search( { biblionumber => $self->biblionumber() } );
 354
 355     return wantarray ? $self->{_article_requests}->as_list : $self->{_article_requests};
 356 }
 357
 358 =head3 article_requests_current
 359
 360 my @requests = $biblio->article_requests_current
 361
 362 Returns the article requests associated with this Biblio that are incomplete
 363
 364 =cut
 365
 366 sub article_requests_current {
 367     my ( $self, $borrower ) = @_;
 368
 369     $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
 370         {
 371             biblionumber => $self->biblionumber(),
 372             -or          => [
 373                 { status => Koha::ArticleRequest::Status::Pending },
 374                 { status => Koha::ArticleRequest::Status::Processing }
 375             ]
 376         }
 377     );
 378
 379     return wantarray ? $self->{_article_requests_current}->as_list : $self->{_article_requests_current};
 380 }
 381
 382 =head3 article_requests_finished
 383
 384 my @requests = $biblio->article_requests_finished
 385
 386 Returns the article requests associated with this Biblio that are completed
 387
 388 =cut
 389
 390 sub article_requests_finished {
 391     my ( $self, $borrower ) = @_;
 392
 393     $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
 394         {
 395             biblionumber => $self->biblionumber(),
 396             -or          => [
 397                 { status => Koha::ArticleRequest::Status::Completed },
 398                 { status => Koha::ArticleRequest::Status::Canceled }
 399             ]
 400         }
 401     );
 402
 403     return wantarray ? $self->{_article_requests_finished}->as_list : $self->{_article_requests_finished};
 404 }
 405
 406 =head3 items
 407
 408 my $items = $biblio->items();
 409
 410 Returns the related Koha::Items object for this biblio
 411
 412 =cut
 413
 414 sub items {
 415     my ($self) = @_;
 416
 417     my $items_rs = $self->_result->items;
 418
 419     return Koha::Items->_new_from_dbic( $items_rs );
 420 }
 421
 422 =head3 itemtype
 423
 424 my $itemtype = $biblio->itemtype();
 425
 426 Returns the itemtype for this record.
 427
 428 =cut
 429
 430 sub itemtype {
 431     my ( $self ) = @_;
 432
 433     return $self->biblioitem()->itemtype();
 434 }
 435
 436 =head3 holds
 437
 438 my $holds = $biblio->holds();
 439
 440 return the current holds placed on this record
 441
 442 =cut
 443
 444 sub holds {
 445     my ( $self, $params, $attributes ) = @_;
 446     $attributes->{order_by} = 'priority' unless exists $attributes->{order_by};
 447     my $hold_rs = $self->_result->reserves->search( $params, $attributes );
 448     return Koha::Holds->_new_from_dbic($hold_rs);
 449 }
 450
 451 =head3 current_holds
 452
 453 my $holds = $biblio->current_holds
 454
 455 Return the holds placed on this bibliographic record.
 456 It does not include future holds.
 457
 458 =cut
 459
 460 sub current_holds {
 461     my ($self) = @_;
 462     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 463     return $self->holds(
 464         { reservedate => { '<=' => $dtf->format_date(dt_from_string) } } );
 465 }
 466
 467 =head3 biblioitem
 468
 469 my $field = $self->biblioitem()->itemtype
 470
 471 Returns the related Koha::Biblioitem object for this Biblio object
 472
 473 =cut
 474
 475 sub biblioitem {
 476     my ($self) = @_;
 477
 478     $self->{_biblioitem} ||= Koha::Biblioitems->find( { biblionumber => $self->biblionumber() } );
 479
 480     return $self->{_biblioitem};
 481 }
 482
 483 =head3 suggestions
 484
 485 my $suggestions = $self->suggestions
 486
 487 Returns the related Koha::Suggestions object for this Biblio object
 488
 489 =cut
 490
 491 sub suggestions {
 492     my ($self) = @_;
 493
 494     my $suggestions_rs = $self->_result->suggestions;
 495     return Koha::Suggestions->_new_from_dbic( $suggestions_rs );
 496 }
 497
 498 =head3 subscriptions
 499
 500 my $subscriptions = $self->subscriptions
 501
 502 Returns the related Koha::Subscriptions object for this Biblio object
 503
 504 =cut
 505
 506 sub subscriptions {
 507     my ($self) = @_;
 508
 509     $self->{_subscriptions} ||= Koha::Subscriptions->search( { biblionumber => $self->biblionumber } );
 510
 511     return $self->{_subscriptions};
 512 }
 513
 514 =head3 has_items_waiting_or_intransit
 515
 516 my $itemsWaitingOrInTransit = $biblio->has_items_waiting_or_intransit
 517
 518 Tells if this bibliographic record has items waiting or in transit.
 519
 520 =cut
 521
 522 sub has_items_waiting_or_intransit {
 523     my ( $self ) = @_;
 524
 525     if ( Koha::Holds->search({ biblionumber => $self->id,
 526                                found => ['W', 'T'] })->count ) {
 527         return 1;
 528     }
 529
 530     foreach my $item ( $self->items->as_list ) {
 531         return 1 if $item->get_transfer;
 532     }
 533
 534     return 0;
 535 }
 536
 537 =head2 get_coins
 538
 539 my $coins = $biblio->get_coins;
 540
 541 Returns the COinS (a span) which can be included in a biblio record
 542
 543 =cut
 544
 545 sub get_coins {
 546     my ( $self ) = @_;
 547
 548     my $record = $self->metadata->record;
 549
 550     my $pos7 = substr $record->leader(), 7, 1;
 551     my $pos6 = substr $record->leader(), 6, 1;
 552     my $mtx;
 553     my $genre;
 554     my ( $aulast, $aufirst ) = ( '', '' );
 555     my @authors;
 556     my $title;
 557     my $hosttitle;
 558     my $pubyear   = '';
 559     my $isbn      = '';
 560     my $issn      = '';
 561     my $publisher = '';
 562     my $pages     = '';
 563     my $titletype = '';
 564
 565     # For the purposes of generating COinS metadata, LDR/06-07 can be
 566     # considered the same for UNIMARC and MARC21
 567     my $fmts6 = {
 568         'a' => 'book',
 569         'b' => 'manuscript',
 570         'c' => 'book',
 571         'd' => 'manuscript',
 572         'e' => 'map',
 573         'f' => 'map',
 574         'g' => 'film',
 575         'i' => 'audioRecording',
 576         'j' => 'audioRecording',
 577         'k' => 'artwork',
 578         'l' => 'document',
 579         'm' => 'computerProgram',
 580         'o' => 'document',
 581         'r' => 'document',
 582     };
 583     my $fmts7 = {
 584         'a' => 'journalArticle',
 585         's' => 'journal',
 586     };
 587
 588     $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
 589
 590     if ( $genre eq 'book' ) {
 591             $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
 592     }
 593
 594     ##### We must transform mtx to a valable mtx and document type ####
 595     if ( $genre eq 'book' ) {
 596             $mtx = 'book';
 597             $titletype = 'b';
 598     } elsif ( $genre eq 'journal' ) {
 599             $mtx = 'journal';
 600             $titletype = 'j';
 601     } elsif ( $genre eq 'journalArticle' ) {
 602             $mtx   = 'journal';
 603             $genre = 'article';
 604             $titletype = 'a';
 605     } else {
 606             $mtx = 'dc';
 607     }
 608
 609     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
 610
 611         # Setting datas
 612         $aulast  = $record->subfield( '700', 'a' ) || '';
 613         $aufirst = $record->subfield( '700', 'b' ) || '';
 614         push @authors, "$aufirst $aulast" if ($aufirst or $aulast);
 615
 616         # others authors
 617         if ( $record->field('200') ) {
 618             for my $au ( $record->field('200')->subfield('g') ) {
 619                 push @authors, $au;
 620             }
 621         }
 622
 623         $title     = $record->subfield( '200', 'a' );
 624         my $subfield_210d = $record->subfield('210', 'd');
 625         if ($subfield_210d and $subfield_210d =~ /(\d{4})/) {
 626             $pubyear = $1;
 627         }
 628         $publisher = $record->subfield( '210', 'c' ) || '';
 629         $isbn      = $record->subfield( '010', 'a' ) || '';
 630         $issn      = $record->subfield( '011', 'a' ) || '';
 631     } else {
 632
 633         # MARC21 need some improve
 634
 635         # Setting datas
 636         if ( $record->field('100') ) {
 637             push @authors, $record->subfield( '100', 'a' );
 638         }
 639
 640         # others authors
 641         if ( $record->field('700') ) {
 642             for my $au ( $record->field('700')->subfield('a') ) {
 643                 push @authors, $au;
 644             }
 645         }
 646         $title = $record->field('245');
 647         $title &&= $title->as_string('ab');
 648         if ($titletype eq 'a') {
 649             $pubyear   = $record->field('008') || '';
 650             $pubyear   = substr($pubyear->data(), 7, 4) if $pubyear;
 651             $isbn      = $record->subfield( '773', 'z' ) || '';
 652             $issn      = $record->subfield( '773', 'x' ) || '';
 653             $hosttitle = $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{};
 654             my @rels = $record->subfield( '773', 'g' );
 655             $pages = join(', ', @rels);
 656         } else {
 657             $pubyear   = $record->subfield( '260', 'c' ) || '';
 658             $publisher = $record->subfield( '260', 'b' ) || '';
 659             $isbn      = $record->subfield( '020', 'a' ) || '';
 660             $issn      = $record->subfield( '022', 'a' ) || '';
 661         }
 662
 663     }
 664
 665     my @params = (
 666         [ 'ctx_ver', 'Z39.88-2004' ],
 667         [ 'rft_val_fmt', "info:ofi/fmt:kev:mtx:$mtx" ],
 668         [ ($mtx eq 'dc' ? 'rft.type' : 'rft.genre'), $genre ],
 669         [ "rft.${titletype}title", $title ],
 670     );
 671
 672     # rft.title is authorized only once, so by checking $titletype
 673     # we ensure that rft.title is not already in the list.
 674     if ($hosttitle and $titletype) {
 675         push @params, [ 'rft.title', $hosttitle ];
 676     }
 677
 678     push @params, (
 679         [ 'rft.isbn', $isbn ],
 680         [ 'rft.issn', $issn ],
 681     );
 682
 683     # If it's a subscription, these informations have no meaning.
 684     if ($genre ne 'journal') {
 685         push @params, (
 686             [ 'rft.aulast', $aulast ],
 687             [ 'rft.aufirst', $aufirst ],
 688             (map { [ 'rft.au', $_ ] } @authors),
 689             [ 'rft.pub', $publisher ],
 690             [ 'rft.date', $pubyear ],
 691             [ 'rft.pages', $pages ],
 692         );
 693     }
 694
 695     my $coins_value = join( '&amp;',
 696         map { $$_[1] ? $$_[0] . '=' . uri_escape_utf8( $$_[1] ) : () } @params );
 697
 698     return $coins_value;
 699 }
 700
 701 =head2 get_openurl
 702
 703 my $url = $biblio->get_openurl;
 704
 705 Returns url for OpenURL resolver set in OpenURLResolverURL system preference
 706
 707 =cut
 708
 709 sub get_openurl {
 710     my ( $self ) = @_;
 711
 712     my $OpenURLResolverURL = C4::Context->preference('OpenURLResolverURL');
 713
 714     if ($OpenURLResolverURL) {
 715         my $uri = URI->new($OpenURLResolverURL);
 716
 717         if (not defined $uri->query) {
 718             $OpenURLResolverURL .= '?';
 719         } else {
 720             $OpenURLResolverURL .= '&amp;';
 721         }
 722         $OpenURLResolverURL .= $self->get_coins;
 723     }
 724
 725     return $OpenURLResolverURL;
 726 }
 727
 728 =head3 is_serial
 729
 730 my $serial = $biblio->is_serial
 731
 732 Return boolean true if this bibbliographic record is continuing resource
 733
 734 =cut
 735
 736 sub is_serial {
 737     my ( $self ) = @_;
 738
 739     return 1 if $self->serial;
 740
 741     my $record = $self->metadata->record;
 742     return 1 if substr($record->leader, 7, 1) eq 's';
 743
 744     return 0;
 745 }
 746
 747 =head3 custom_cover_image_url
 748
 749 my $image_url = $biblio->custom_cover_image_url
 750
 751 Return the specific url of the cover image for this bibliographic record.
 752 It is built regaring the value of the system preference CustomCoverImagesURL
 753
 754 =cut
 755
 756 sub custom_cover_image_url {
 757     my ( $self ) = @_;
 758     my $url = C4::Context->preference('CustomCoverImagesURL');
 759     if ( $url =~ m|{isbn}| ) {
 760         my $isbn = $self->biblioitem->isbn;
 761         return unless $isbn;
 762         $url =~ s|{isbn}|$isbn|g;
 763     }
 764     if ( $url =~ m|{normalized_isbn}| ) {
 765         my $normalized_isbn = C4::Koha::GetNormalizedISBN($self->biblioitem->isbn);
 766         return unless $normalized_isbn;
 767         $url =~ s|{normalized_isbn}|$normalized_isbn|g;
 768     }
 769     if ( $url =~ m|{issn}| ) {
 770         my $issn = $self->biblioitem->issn;
 771         return unless $issn;
 772         $url =~ s|{issn}|$issn|g;
 773     }
 774
 775     my $re = qr|{(?<field>\d{3})\$(?<subfield>.)}|;
 776     if ( $url =~ $re ) {
 777         my $field = $+{field};
 778         my $subfield = $+{subfield};
 779         my $marc_record = $self->metadata->record;
 780         my $value = $marc_record->subfield($field, $subfield);
 781         return unless $value;
 782         $url =~ s|$re|$value|;
 783     }
 784
 785     return $url;
 786 }
 787
 788 =head3 cover_images
 789
 790 Return the cover images associated with this biblio.
 791
 792 =cut
 793
 794 sub cover_images {
 795     my ( $self ) = @_;
 796
 797     my $cover_images_rs = $self->_result->cover_images;
 798     return unless $cover_images_rs;
 799     return Koha::CoverImages->_new_from_dbic($cover_images_rs);
 800 }
 801
 802 =head3 get_marc_notes
 803
 804     $marcnotesarray = $biblio->get_marc_notes({ marcflavour => $marcflavour });
 805
 806 Get all notes from the MARC record and returns them in an array.
 807 The notes are stored in different fields depending on MARC flavour.
 808 MARC21 5XX $u subfields receive special attention as they are URIs.
 809
 810 =cut
 811
 812 sub get_marc_notes {
 813     my ( $self, $params ) = @_;
 814
 815     my $marcflavour = $params->{marcflavour};
 816     my $opac = $params->{opac};
 817
 818     my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
 819     my @marcnotes;
 820
 821     #MARC21 specs indicate some notes should be private if first indicator 0
 822     my %maybe_private = (
 823         541 => 1,
 824         542 => 1,
 825         561 => 1,
 826         583 => 1,
 827         590 => 1
 828     );
 829
 830     my %hiddenlist = map { $_ => 1 }
 831         split( /,/, C4::Context->preference('NotesToHide'));
 832     foreach my $field ( $self->metadata->record->field($scope) ) {
 833         my $tag = $field->tag();
 834         next if $hiddenlist{ $tag };
 835         next if $opac && $maybe_private{$tag} && !$field->indicator(1);
 836         if( $marcflavour ne 'UNIMARC' && $field->subfield('u') ) {
 837             # Field 5XX$u always contains URI
 838             # Examples: 505u, 506u, 510u, 514u, 520u, 530u, 538u, 540u, 542u, 552u, 555u, 561u, 563u, 583u
 839             # We first push the other subfields, then all $u's separately
 840             # Leave further actions to the template (see e.g. opac-detail)
 841             my $othersub =
 842                 join '', ( 'a' .. 't', 'v' .. 'z', '0' .. '9' ); # excl 'u'
 843             push @marcnotes, { marcnote => $field->as_string($othersub) };
 844             foreach my $sub ( $field->subfield('u') ) {
 845                 $sub =~ s/^\s+|\s+$//g; # trim
 846                 push @marcnotes, { marcnote => $sub };
 847             }
 848         } else {
 849             push @marcnotes, { marcnote => $field->as_string() };
 850         }
 851     }
 852     return \@marcnotes;
 853 }
 854
 855 =head3 to_api
 856
 857     my $json = $biblio->to_api;
 858
 859 Overloaded method that returns a JSON representation of the Koha::Biblio object,
 860 suitable for API output. The related Koha::Biblioitem object is merged as expected
 861 on the API.
 862
 863 =cut
 864
 865 sub to_api {
 866     my ($self, $args) = @_;
 867
 868     my $response = $self->SUPER::to_api( $args );
 869     my $biblioitem = $self->biblioitem->to_api;
 870
 871     return { %$response, %$biblioitem };
 872 }
 873
 874 =head3 to_api_mapping
 875
 876 This method returns the mapping for representing a Koha::Biblio object
 877 on the API.
 878
 879 =cut
 880
 881 sub to_api_mapping {
 882     return {
 883         biblionumber     => 'biblio_id',
 884         frameworkcode    => 'framework_id',
 885         unititle         => 'uniform_title',
 886         seriestitle      => 'series_title',
 887         copyrightdate    => 'copyright_date',
 888         datecreated      => 'creation_date'
 889     };
 890 }
 891
 892 =head3 get_marc_host
 893
 894     $host = $biblio->get_marc_host;
 895     # OR:
 896     ( $host, $relatedparts ) = $biblio->get_marc_host;
 897
 898     Returns host biblio record from MARC21 773 (undef if no 773 present).
 899     It looks at the first 773 field with MARCorgCode or only a control
 900     number. Complete $w or numeric part is used to search host record.
 901     The optional parameter no_items triggers a check if $biblio has items.
 902     If there are, the sub returns undef.
 903     Called in list context, it also returns 773$g (related parts).
 904
 905 =cut
 906
 907 sub get_marc_host {
 908     my ($self, $params) = @_;
 909     my $no_items = $params->{no_items};
 910     return if C4::Context->preference('marcflavour') eq 'UNIMARC'; # TODO
 911     return if $params->{no_items} && $self->items->count > 0;
 912
 913     my $record;
 914     eval { $record = $self->metadata->record };
 915     return if !$record;
 916
 917     # We pick the first $w with your MARCOrgCode or the first $w that has no
 918     # code (between parentheses) at all.
 919     my $orgcode = C4::Context->preference('MARCOrgCode') // q{};
 920     my $hostfld;
 921     foreach my $f ( $record->field('773') ) {
 922         my $w = $f->subfield('w') or next;
 923         if( $w =~ /^\($orgcode\)\s*(\d+)/i or $w =~ /^\d+/ ) {
 924             $hostfld = $f;
 925             last;
 926         }
 927     }
 928     return if !$hostfld;
 929     my $rcn = $hostfld->subfield('w');
 930
 931     # Look for control number with/without orgcode
 932     my $engine = Koha::SearchEngine::Search->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
 933     my $bibno;
 934     for my $try (1..2) {
 935         my ( $error, $results, $total_hits ) = $engine->simple_search_compat( 'Control-number='.$rcn, 0,1 );
 936         if( !$error and $total_hits == 1 ) {
 937             $bibno = $engine->extract_biblionumber( $results->[0] );
 938             last;
 939         }
 940         # Add or remove orgcode for second try
 941         if( $try == 1 && $rcn =~ /\)\s*(\d+)/ ) {
 942             $rcn = $1; # number only
 943         } elsif( $try == 1 && $rcn =~ /^\d+/ ) {
 944             $rcn = "($orgcode)$rcn";
 945         } else {
 946             last;
 947         }
 948     }
 949     if( $bibno ) {
 950         my $host = Koha::Biblios->find($bibno) or return;
 951         return wantarray ? ( $host, $hostfld->subfield('g') ) : $host;
 952     }
 953 }
 954
 955 =head2 Internal methods
 956
 957 =head3 type
 958
 959 =cut
 960
 961 sub _type {
 962     return 'Biblio';
 963 }
 964
 965 =head1 AUTHOR
 966
 967 Kyle M Hall <kyle@bywatersolutions.com>
 968
 969 =cut
 970
 971 1;