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