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