Koha/Biblio.pm

   1 package Koha::Biblio;
   2
   3 # Copyright ByWater Solutions 2014
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use Modern::Perl;
  21
  22 use List::MoreUtils qw( any );
  23 use URI;
  24 use URI::Escape qw( uri_escape_utf8 );
  25
  26 use C4::Koha qw( GetNormalizedISBN );
  27 use C4::XSLT qw( transformMARCXML4XSLT );
  28
  29 use Koha::Database;
  30 use Koha::DateUtils qw( dt_from_string );
  31
  32 use base qw(Koha::Object);
  33
  34 use Koha::Acquisition::Orders;
  35 use Koha::ArticleRequests;
  36 use Koha::Biblio::Metadatas;
  37 use Koha::Biblioitems;
  38 use Koha::Checkouts;
  39 use Koha::CirculationRules;
  40 use Koha::Item::Transfer::Limits;
  41 use Koha::Items;
  42 use Koha::Libraries;
  43 use Koha::Old::Checkouts;
  44 use Koha::Suggestions;
  45 use Koha::Subscriptions;
  46 use Koha::SearchEngine;
  47 use Koha::SearchEngine::Search;
  48 use Koha::SearchEngine::QueryBuilder;
  49
  50 =head1 NAME
  51
  52 Koha::Biblio - Koha Biblio Object class
  53
  54 =head1 API
  55
  56 =head2 Class Methods
  57
  58 =cut
  59
  60 =head3 store
  61
  62 Overloaded I<store> method to set default values
  63
  64 =cut
  65
  66 sub store {
  67     my ( $self ) = @_;
  68
  69     $self->datecreated( dt_from_string ) unless $self->datecreated;
  70
  71     return $self->SUPER::store;
  72 }
  73
  74 =head3 metadata
  75
  76 my $metadata = $biblio->metadata();
  77
  78 Returns a Koha::Biblio::Metadata object
  79
  80 =cut
  81
  82 sub metadata {
  83     my ( $self ) = @_;
  84
  85     my $metadata = $self->_result->metadata;
  86     return Koha::Biblio::Metadata->_new_from_dbic($metadata);
  87 }
  88
  89 =head3 orders
  90
  91 my $orders = $biblio->orders();
  92
  93 Returns a Koha::Acquisition::Orders object
  94
  95 =cut
  96
  97 sub orders {
  98     my ( $self ) = @_;
  99
 100     my $orders = $self->_result->orders;
 101     return Koha::Acquisition::Orders->_new_from_dbic($orders);
 102 }
 103
 104 =head3 active_orders
 105
 106 my $active_orders = $biblio->active_orders();
 107
 108 Returns the active acquisition orders related to this biblio.
 109 An order is considered active when it is not cancelled (i.e. when datecancellation
 110 is not undef).
 111
 112 =cut
 113
 114 sub active_orders {
 115     my ( $self ) = @_;
 116
 117     return $self->orders->search({ datecancellationprinted => undef });
 118 }
 119
 120 =head3 can_article_request
 121
 122 my $bool = $biblio->can_article_request( $borrower );
 123
 124 Returns true if article requests can be made for this record
 125
 126 $borrower must be a Koha::Patron object
 127
 128 =cut
 129
 130 sub can_article_request {
 131     my ( $self, $borrower ) = @_;
 132
 133     my $rule = $self->article_request_type($borrower);
 134     return q{} if $rule eq 'item_only' && !$self->items()->count();
 135     return 1 if $rule && $rule ne 'no';
 136
 137     return q{};
 138 }
 139
 140 =head3 can_be_transferred
 141
 142 $biblio->can_be_transferred({ to => $to_library, from => $from_library })
 143
 144 Checks if at least one item of a biblio can be transferred to given library.
 145
 146 This feature is controlled by two system preferences:
 147 UseBranchTransferLimits to enable / disable the feature
 148 BranchTransferLimitsType to use either an itemnumber or ccode as an identifier
 149                          for setting the limitations
 150
 151 Performance-wise, it is recommended to use this method for a biblio instead of
 152 iterating each item of a biblio with Koha::Item->can_be_transferred().
 153
 154 Takes HASHref that can have the following parameters:
 155     MANDATORY PARAMETERS:
 156     $to   : Koha::Library
 157     OPTIONAL PARAMETERS:
 158     $from : Koha::Library # if given, only items from that
 159                           # holdingbranch are considered
 160
 161 Returns 1 if at least one of the item of a biblio can be transferred
 162 to $to_library, otherwise 0.
 163
 164 =cut
 165
 166 sub can_be_transferred {
 167     my ($self, $params) = @_;
 168
 169     my $to   = $params->{to};
 170     my $from = $params->{from};
 171
 172     return 1 unless C4::Context->preference('UseBranchTransferLimits');
 173     my $limittype = C4::Context->preference('BranchTransferLimitsType');
 174
 175     my $items;
 176     foreach my $item_of_bib ($self->items->as_list) {
 177         next unless $item_of_bib->holdingbranch;
 178         next if $from && $from->branchcode ne $item_of_bib->holdingbranch;
 179         return 1 if $item_of_bib->holdingbranch eq $to->branchcode;
 180         my $code = $limittype eq 'itemtype'
 181             ? $item_of_bib->effective_itemtype
 182             : $item_of_bib->ccode;
 183         return 1 unless $code;
 184         $items->{$code}->{$item_of_bib->holdingbranch} = 1;
 185     }
 186
 187     # At this point we will have a HASHref containing each itemtype/ccode that
 188     # this biblio has, inside which are all of the holdingbranches where those
 189     # items are located at. Then, we will query Koha::Item::Transfer::Limits to
 190     # find out whether a transfer limits for such $limittype from any of the
 191     # listed holdingbranches to the given $to library exist. If at least one
 192     # holdingbranch for that $limittype does not have a transfer limit to given
 193     # $to library, then we know that the transfer is possible.
 194     foreach my $code (keys %{$items}) {
 195         my @holdingbranches = keys %{$items->{$code}};
 196         return 1 if Koha::Item::Transfer::Limits->search({
 197             toBranch => $to->branchcode,
 198             fromBranch => { 'in' => \@holdingbranches },
 199             $limittype => $code
 200         }, {
 201             group_by => [qw/fromBranch/]
 202         })->count == scalar(@holdingbranches) ? 0 : 1;
 203     }
 204
 205     return 0;
 206 }
 207
 208
 209 =head3 pickup_locations
 210
 211     my $pickup_locations = $biblio->pickup_locations( {patron => $patron } );
 212
 213 Returns a Koha::Libraries set of possible pickup locations for this biblio's items,
 214 according to patron's home library (if patron is defined and holds are allowed
 215 only from hold groups) and if item can be transferred to each pickup location.
 216
 217 =cut
 218
 219 sub pickup_locations {
 220     my ( $self, $params ) = @_;
 221
 222     my $patron = $params->{patron};
 223
 224     my @pickup_locations;
 225     foreach my $item_of_bib ( $self->items->as_list ) {
 226         push @pickup_locations,
 227           $item_of_bib->pickup_locations( { patron => $patron } )
 228           ->_resultset->get_column('branchcode')->all;
 229     }
 230
 231     return Koha::Libraries->search(
 232         { branchcode => { '-in' => \@pickup_locations } }, { order_by => ['branchname'] } );
 233 }
 234
 235 =head3 hidden_in_opac
 236
 237     my $bool = $biblio->hidden_in_opac({ [ rules => $rules ] })
 238
 239 Returns true if the biblio matches the hidding criteria defined in $rules.
 240 Returns false otherwise. It involves the I<OpacHiddenItems> and
 241 I<OpacHiddenItemsHidesRecord> system preferences.
 242
 243 Takes HASHref that can have the following parameters:
 244     OPTIONAL PARAMETERS:
 245     $rules : { <field> => [ value_1, ... ], ... }
 246
 247 Note: $rules inherits its structure from the parsed YAML from reading
 248 the I<OpacHiddenItems> system preference.
 249
 250 =cut
 251
 252 sub hidden_in_opac {
 253     my ( $self, $params ) = @_;
 254
 255     my $rules = $params->{rules} // {};
 256
 257     my @items = $self->items->as_list;
 258
 259     return 0 unless @items; # Do not hide if there is no item
 260
 261     # Ok, there are items, don't even try the rules unless OpacHiddenItemsHidesRecord
 262     return 0 unless C4::Context->preference('OpacHiddenItemsHidesRecord');
 263
 264     return !(any { !$_->hidden_in_opac({ rules => $rules }) } @items);
 265 }
 266
 267 =head3 article_request_type
 268
 269 my $type = $biblio->article_request_type( $borrower );
 270
 271 Returns the article request type based on items, or on the record
 272 itself if there are no items.
 273
 274 $borrower must be a Koha::Patron object
 275
 276 =cut
 277
 278 sub article_request_type {
 279     my ( $self, $borrower ) = @_;
 280
 281     return q{} unless $borrower;
 282
 283     my $rule = $self->article_request_type_for_items( $borrower );
 284     return $rule if $rule;
 285
 286     # If the record has no items that are requestable, go by the record itemtype
 287     $rule = $self->article_request_type_for_bib($borrower);
 288     return $rule if $rule;
 289
 290     return q{};
 291 }
 292
 293 =head3 article_request_type_for_bib
 294
 295 my $type = $biblio->article_request_type_for_bib
 296
 297 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record
 298
 299 =cut
 300
 301 sub article_request_type_for_bib {
 302     my ( $self, $borrower ) = @_;
 303
 304     return q{} unless $borrower;
 305
 306     my $borrowertype = $borrower->categorycode;
 307     my $itemtype     = $self->itemtype();
 308
 309     my $rule = Koha::CirculationRules->get_effective_rule(
 310         {
 311             rule_name    => 'article_requests',
 312             categorycode => $borrowertype,
 313             itemtype     => $itemtype,
 314         }
 315     );
 316
 317     return q{} unless $rule;
 318     return $rule->rule_value || q{}
 319 }
 320
 321 =head3 article_request_type_for_items
 322
 323 my $type = $biblio->article_request_type_for_items
 324
 325 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record's items
 326
 327 If there is a conflict where some items are 'bib_only' and some are 'item_only', 'bib_only' will be returned.
 328
 329 =cut
 330
 331 sub article_request_type_for_items {
 332     my ( $self, $borrower ) = @_;
 333
 334     my $counts;
 335     foreach my $item ( $self->items()->as_list() ) {
 336         my $rule = $item->article_request_type($borrower);
 337         return $rule if $rule eq 'bib_only';    # we don't need to go any further
 338         $counts->{$rule}++;
 339     }
 340
 341     return 'item_only' if $counts->{item_only};
 342     return 'yes'       if $counts->{yes};
 343     return 'no'        if $counts->{no};
 344     return q{};
 345 }
 346
 347 =head3 article_requests
 348
 349     my $article_requests = $biblio->article_requests
 350
 351 Returns the article requests associated with this biblio
 352
 353 =cut
 354
 355 sub article_requests {
 356     my ( $self ) = @_;
 357
 358     return Koha::ArticleRequests->_new_from_dbic( scalar $self->_result->article_requests );
 359 }
 360
 361 =head3 current_checkouts
 362
 363     my $current_checkouts = $biblio->current_checkouts
 364
 365 Returns the current checkouts associated with this biblio
 366
 367 =cut
 368
 369 sub current_checkouts {
 370     my ($self) = @_;
 371
 372     return Koha::Checkouts->search( { "item.biblionumber" => $self->id },
 373         { join => 'item' } );
 374 }
 375
 376 =head3 old_checkouts
 377
 378     my $old_checkouts = $biblio->old_checkouts
 379
 380 Returns the past checkouts associated with this biblio
 381
 382 =cut
 383
 384 sub old_checkouts {
 385     my ( $self ) = @_;
 386
 387     return Koha::Old::Checkouts->search( { "item.biblionumber" => $self->id },
 388         { join => 'item' } );
 389 }
 390
 391 =head3 items
 392
 393 my $items = $biblio->items();
 394
 395 Returns the related Koha::Items object for this biblio
 396
 397 =cut
 398
 399 sub items {
 400     my ($self) = @_;
 401
 402     my $items_rs = $self->_result->items;
 403
 404     return Koha::Items->_new_from_dbic( $items_rs );
 405 }
 406
 407 =head3 host_items
 408
 409 my $host_items = $biblio->host_items();
 410
 411 Return the host items (easy analytical record)
 412
 413 =cut
 414
 415 sub host_items {
 416     my ($self) = @_;
 417
 418     return Koha::Items->new->empty
 419       unless C4::Context->preference('EasyAnalyticalRecords');
 420
 421     my $marcflavour = C4::Context->preference("marcflavour");
 422     my $analyticfield = '773';
 423     if ( $marcflavour eq 'MARC21' ) {
 424         $analyticfield = '773';
 425     }
 426     elsif ( $marcflavour eq 'UNIMARC' ) {
 427         $analyticfield = '461';
 428     }
 429     my $marc_record = $self->metadata->record;
 430     my @itemnumbers;
 431     foreach my $field ( $marc_record->field($analyticfield) ) {
 432         push @itemnumbers, $field->subfield('9');
 433     }
 434
 435     return Koha::Items->search( { itemnumber => { -in => \@itemnumbers } } );
 436 }
 437
 438 =head3 itemtype
 439
 440 my $itemtype = $biblio->itemtype();
 441
 442 Returns the itemtype for this record.
 443
 444 =cut
 445
 446 sub itemtype {
 447     my ( $self ) = @_;
 448
 449     return $self->biblioitem()->itemtype();
 450 }
 451
 452 =head3 holds
 453
 454 my $holds = $biblio->holds();
 455
 456 return the current holds placed on this record
 457
 458 =cut
 459
 460 sub holds {
 461     my ( $self, $params, $attributes ) = @_;
 462     $attributes->{order_by} = 'priority' unless exists $attributes->{order_by};
 463     my $hold_rs = $self->_result->reserves->search( $params, $attributes );
 464     return Koha::Holds->_new_from_dbic($hold_rs);
 465 }
 466
 467 =head3 current_holds
 468
 469 my $holds = $biblio->current_holds
 470
 471 Return the holds placed on this bibliographic record.
 472 It does not include future holds.
 473
 474 =cut
 475
 476 sub current_holds {
 477     my ($self) = @_;
 478     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 479     return $self->holds(
 480         { reservedate => { '<=' => $dtf->format_date(dt_from_string) } } );
 481 }
 482
 483 =head3 biblioitem
 484
 485 my $field = $self->biblioitem()->itemtype
 486
 487 Returns the related Koha::Biblioitem object for this Biblio object
 488
 489 =cut
 490
 491 sub biblioitem {
 492     my ($self) = @_;
 493
 494     $self->{_biblioitem} ||= Koha::Biblioitems->find( { biblionumber => $self->biblionumber() } );
 495
 496     return $self->{_biblioitem};
 497 }
 498
 499 =head3 suggestions
 500
 501 my $suggestions = $self->suggestions
 502
 503 Returns the related Koha::Suggestions object for this Biblio object
 504
 505 =cut
 506
 507 sub suggestions {
 508     my ($self) = @_;
 509
 510     my $suggestions_rs = $self->_result->suggestions;
 511     return Koha::Suggestions->_new_from_dbic( $suggestions_rs );
 512 }
 513
 514 =head3 get_marc_components
 515
 516   my $components = $self->get_marc_components();
 517
 518 Returns an array of MARCXML data, which are component parts of
 519 this object (MARC21 773$w points to this)
 520
 521 =cut
 522
 523 sub get_marc_components {
 524     my ($self, $max_results) = @_;
 525
 526     return [] if (C4::Context->preference('marcflavour') ne 'MARC21');
 527
 528     my $searchstr = $self->get_components_query;
 529
 530     my $components;
 531     if (defined($searchstr)) {
 532         my $searcher = Koha::SearchEngine::Search->new({index => $Koha::SearchEngine::BIBLIOS_INDEX});
 533         my ( $error, $results, $total_hits );
 534         eval {
 535             ( $error, $results, $total_hits ) = $searcher->simple_search_compat( $searchstr, 0, $max_results );
 536         };
 537         if( $error || $@ ) {
 538             $error //= q{};
 539             $error .= $@ if $@;
 540             warn "Warning from simple_search_compat: '$error'";
 541             $self->add_message(
 542                 {
 543                     type    => 'error',
 544                     message => 'component_search',
 545                     payload => $error,
 546                 }
 547             );
 548         }
 549         $components = $results if defined($results) && @$results;
 550     }
 551
 552     return $components // [];
 553 }
 554
 555 =head2 get_components_query
 556
 557 Returns a query which can be used to search for all component parts of MARC21 biblios
 558
 559 =cut
 560
 561 sub get_components_query {
 562     my ($self) = @_;
 563
 564     my $builder = Koha::SearchEngine::QueryBuilder->new(
 565         { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
 566     my $marc = $self->metadata->record;
 567
 568     my $searchstr;
 569     if ( C4::Context->preference('UseControlNumber') ) {
 570         my $pf001 = $marc->field('001') || undef;
 571
 572         if ( defined($pf001) ) {
 573             $searchstr = "(";
 574             my $pf003 = $marc->field('003') || undef;
 575
 576             if ( !defined($pf003) ) {
 577                 # search for 773$w='Host001'
 578                 $searchstr .= "rcn:" . $pf001->data();
 579             }
 580             else {
 581                 $searchstr .= "(";
 582                 # search for (773$w='Host001' and 003='Host003') or 773$w='(Host003)Host001'
 583                 $searchstr .= "(rcn:" . $pf001->data() . " AND cni:" . $pf003->data() . ")";
 584                 $searchstr .= " OR rcn:\"" . $pf003->data() . " " . $pf001->data() . "\"";
 585                 $searchstr .= ")";
 586             }
 587
 588             # limit to monograph and serial component part records
 589             $searchstr .= " AND (bib-level:a OR bib-level:b)";
 590             $searchstr .= ")";
 591         }
 592     }
 593     else {
 594         my $cleaned_title = $marc->subfield('245', "a");
 595         $cleaned_title =~ tr|/||;
 596         $cleaned_title = $builder->clean_search_term($cleaned_title);
 597         $searchstr = "Host-item:($cleaned_title)";
 598     }
 599
 600     return $searchstr;
 601 }
 602
 603 =head3 subscriptions
 604
 605 my $subscriptions = $self->subscriptions
 606
 607 Returns the related Koha::Subscriptions object for this Biblio object
 608
 609 =cut
 610
 611 sub subscriptions {
 612     my ($self) = @_;
 613
 614     $self->{_subscriptions} ||= Koha::Subscriptions->search( { biblionumber => $self->biblionumber } );
 615
 616     return $self->{_subscriptions};
 617 }
 618
 619 =head3 has_items_waiting_or_intransit
 620
 621 my $itemsWaitingOrInTransit = $biblio->has_items_waiting_or_intransit
 622
 623 Tells if this bibliographic record has items waiting or in transit.
 624
 625 =cut
 626
 627 sub has_items_waiting_or_intransit {
 628     my ( $self ) = @_;
 629
 630     if ( Koha::Holds->search({ biblionumber => $self->id,
 631                                found => ['W', 'T'] })->count ) {
 632         return 1;
 633     }
 634
 635     foreach my $item ( $self->items->as_list ) {
 636         return 1 if $item->get_transfer;
 637     }
 638
 639     return 0;
 640 }
 641
 642 =head2 get_coins
 643
 644 my $coins = $biblio->get_coins;
 645
 646 Returns the COinS (a span) which can be included in a biblio record
 647
 648 =cut
 649
 650 sub get_coins {
 651     my ( $self ) = @_;
 652
 653     my $record = $self->metadata->record;
 654
 655     my $pos7 = substr $record->leader(), 7, 1;
 656     my $pos6 = substr $record->leader(), 6, 1;
 657     my $mtx;
 658     my $genre;
 659     my ( $aulast, $aufirst ) = ( '', '' );
 660     my @authors;
 661     my $title;
 662     my $hosttitle;
 663     my $pubyear   = '';
 664     my $isbn      = '';
 665     my $issn      = '';
 666     my $publisher = '';
 667     my $pages     = '';
 668     my $titletype = '';
 669
 670     # For the purposes of generating COinS metadata, LDR/06-07 can be
 671     # considered the same for UNIMARC and MARC21
 672     my $fmts6 = {
 673         'a' => 'book',
 674         'b' => 'manuscript',
 675         'c' => 'book',
 676         'd' => 'manuscript',
 677         'e' => 'map',
 678         'f' => 'map',
 679         'g' => 'film',
 680         'i' => 'audioRecording',
 681         'j' => 'audioRecording',
 682         'k' => 'artwork',
 683         'l' => 'document',
 684         'm' => 'computerProgram',
 685         'o' => 'document',
 686         'r' => 'document',
 687     };
 688     my $fmts7 = {
 689         'a' => 'journalArticle',
 690         's' => 'journal',
 691     };
 692
 693     $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
 694
 695     if ( $genre eq 'book' ) {
 696             $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
 697     }
 698
 699     ##### We must transform mtx to a valable mtx and document type ####
 700     if ( $genre eq 'book' ) {
 701             $mtx = 'book';
 702             $titletype = 'b';
 703     } elsif ( $genre eq 'journal' ) {
 704             $mtx = 'journal';
 705             $titletype = 'j';
 706     } elsif ( $genre eq 'journalArticle' ) {
 707             $mtx   = 'journal';
 708             $genre = 'article';
 709             $titletype = 'a';
 710     } else {
 711             $mtx = 'dc';
 712     }
 713
 714     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
 715
 716         # Setting datas
 717         $aulast  = $record->subfield( '700', 'a' ) || '';
 718         $aufirst = $record->subfield( '700', 'b' ) || '';
 719         push @authors, "$aufirst $aulast" if ($aufirst or $aulast);
 720
 721         # others authors
 722         if ( $record->field('200') ) {
 723             for my $au ( $record->field('200')->subfield('g') ) {
 724                 push @authors, $au;
 725             }
 726         }
 727
 728         $title     = $record->subfield( '200', 'a' );
 729         my $subfield_210d = $record->subfield('210', 'd');
 730         if ($subfield_210d and $subfield_210d =~ /(\d{4})/) {
 731             $pubyear = $1;
 732         }
 733         $publisher = $record->subfield( '210', 'c' ) || '';
 734         $isbn      = $record->subfield( '010', 'a' ) || '';
 735         $issn      = $record->subfield( '011', 'a' ) || '';
 736     } else {
 737
 738         # MARC21 need some improve
 739
 740         # Setting datas
 741         if ( $record->field('100') ) {
 742             push @authors, $record->subfield( '100', 'a' );
 743         }
 744
 745         # others authors
 746         if ( $record->field('700') ) {
 747             for my $au ( $record->field('700')->subfield('a') ) {
 748                 push @authors, $au;
 749             }
 750         }
 751         $title = $record->field('245');
 752         $title &&= $title->as_string('ab');
 753         if ($titletype eq 'a') {
 754             $pubyear   = $record->field('008') || '';
 755             $pubyear   = substr($pubyear->data(), 7, 4) if $pubyear;
 756             $isbn      = $record->subfield( '773', 'z' ) || '';
 757             $issn      = $record->subfield( '773', 'x' ) || '';
 758             $hosttitle = $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{};
 759             my @rels = $record->subfield( '773', 'g' );
 760             $pages = join(', ', @rels);
 761         } else {
 762             $pubyear   = $record->subfield( '260', 'c' ) || '';
 763             $publisher = $record->subfield( '260', 'b' ) || '';
 764             $isbn      = $record->subfield( '020', 'a' ) || '';
 765             $issn      = $record->subfield( '022', 'a' ) || '';
 766         }
 767
 768     }
 769
 770     my @params = (
 771         [ 'ctx_ver', 'Z39.88-2004' ],
 772         [ 'rft_val_fmt', "info:ofi/fmt:kev:mtx:$mtx" ],
 773         [ ($mtx eq 'dc' ? 'rft.type' : 'rft.genre'), $genre ],
 774         [ "rft.${titletype}title", $title ],
 775     );
 776
 777     # rft.title is authorized only once, so by checking $titletype
 778     # we ensure that rft.title is not already in the list.
 779     if ($hosttitle and $titletype) {
 780         push @params, [ 'rft.title', $hosttitle ];
 781     }
 782
 783     push @params, (
 784         [ 'rft.isbn', $isbn ],
 785         [ 'rft.issn', $issn ],
 786     );
 787
 788     # If it's a subscription, these informations have no meaning.
 789     if ($genre ne 'journal') {
 790         push @params, (
 791             [ 'rft.aulast', $aulast ],
 792             [ 'rft.aufirst', $aufirst ],
 793             (map { [ 'rft.au', $_ ] } @authors),
 794             [ 'rft.pub', $publisher ],
 795             [ 'rft.date', $pubyear ],
 796             [ 'rft.pages', $pages ],
 797         );
 798     }
 799
 800     my $coins_value = join( '&amp;',
 801         map { $$_[1] ? $$_[0] . '=' . uri_escape_utf8( $$_[1] ) : () } @params );
 802
 803     return $coins_value;
 804 }
 805
 806 =head2 get_openurl
 807
 808 my $url = $biblio->get_openurl;
 809
 810 Returns url for OpenURL resolver set in OpenURLResolverURL system preference
 811
 812 =cut
 813
 814 sub get_openurl {
 815     my ( $self ) = @_;
 816
 817     my $OpenURLResolverURL = C4::Context->preference('OpenURLResolverURL');
 818
 819     if ($OpenURLResolverURL) {
 820         my $uri = URI->new($OpenURLResolverURL);
 821
 822         if (not defined $uri->query) {
 823             $OpenURLResolverURL .= '?';
 824         } else {
 825             $OpenURLResolverURL .= '&amp;';
 826         }
 827         $OpenURLResolverURL .= $self->get_coins;
 828     }
 829
 830     return $OpenURLResolverURL;
 831 }
 832
 833 =head3 is_serial
 834
 835 my $serial = $biblio->is_serial
 836
 837 Return boolean true if this bibbliographic record is continuing resource
 838
 839 =cut
 840
 841 sub is_serial {
 842     my ( $self ) = @_;
 843
 844     return 1 if $self->serial;
 845
 846     my $record = $self->metadata->record;
 847     return 1 if substr($record->leader, 7, 1) eq 's';
 848
 849     return 0;
 850 }
 851
 852 =head3 custom_cover_image_url
 853
 854 my $image_url = $biblio->custom_cover_image_url
 855
 856 Return the specific url of the cover image for this bibliographic record.
 857 It is built regaring the value of the system preference CustomCoverImagesURL
 858
 859 =cut
 860
 861 sub custom_cover_image_url {
 862     my ( $self ) = @_;
 863     my $url = C4::Context->preference('CustomCoverImagesURL');
 864     if ( $url =~ m|{isbn}| ) {
 865         my $isbn = $self->biblioitem->isbn;
 866         return unless $isbn;
 867         $url =~ s|{isbn}|$isbn|g;
 868     }
 869     if ( $url =~ m|{normalized_isbn}| ) {
 870         my $normalized_isbn = C4::Koha::GetNormalizedISBN($self->biblioitem->isbn);
 871         return unless $normalized_isbn;
 872         $url =~ s|{normalized_isbn}|$normalized_isbn|g;
 873     }
 874     if ( $url =~ m|{issn}| ) {
 875         my $issn = $self->biblioitem->issn;
 876         return unless $issn;
 877         $url =~ s|{issn}|$issn|g;
 878     }
 879
 880     my $re = qr|{(?<field>\d{3})(\$(?<subfield>.))?}|;
 881     if ( $url =~ $re ) {
 882         my $field = $+{field};
 883         my $subfield = $+{subfield};
 884         my $marc_record = $self->metadata->record;
 885         my $value;
 886         if ( $subfield ) {
 887             $value = $marc_record->subfield( $field, $subfield );
 888         } else {
 889             my $controlfield = $marc_record->field($field);
 890             $value = $controlfield->data() if $controlfield;
 891         }
 892         return unless $value;
 893         $url =~ s|$re|$value|;
 894     }
 895
 896     return $url;
 897 }
 898
 899 =head3 cover_images
 900
 901 Return the cover images associated with this biblio.
 902
 903 =cut
 904
 905 sub cover_images {
 906     my ( $self ) = @_;
 907
 908     my $cover_images_rs = $self->_result->cover_images;
 909     return unless $cover_images_rs;
 910     return Koha::CoverImages->_new_from_dbic($cover_images_rs);
 911 }
 912
 913 =head3 get_marc_notes
 914
 915     $marcnotesarray = $biblio->get_marc_notes({ marcflavour => $marcflavour });
 916
 917 Get all notes from the MARC record and returns them in an array.
 918 The notes are stored in different fields depending on MARC flavour.
 919 MARC21 5XX $u subfields receive special attention as they are URIs.
 920
 921 =cut
 922
 923 sub get_marc_notes {
 924     my ( $self, $params ) = @_;
 925
 926     my $marcflavour = $params->{marcflavour};
 927     my $opac = $params->{opac};
 928
 929     my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
 930     my @marcnotes;
 931
 932     #MARC21 specs indicate some notes should be private if first indicator 0
 933     my %maybe_private = (
 934         541 => 1,
 935         542 => 1,
 936         561 => 1,
 937         583 => 1,
 938         590 => 1
 939     );
 940
 941     my %hiddenlist = map { $_ => 1 }
 942         split( /,/, C4::Context->preference('NotesToHide'));
 943     my $record = $self->metadata->record;
 944     $record = transformMARCXML4XSLT( $self->biblionumber, $record, $opac );
 945
 946     foreach my $field ( $record->field($scope) ) {
 947         my $tag = $field->tag();
 948         next if $hiddenlist{ $tag };
 949         next if $opac && $maybe_private{$tag} && !$field->indicator(1);
 950         if( $marcflavour ne 'UNIMARC' && $field->subfield('u') ) {
 951             # Field 5XX$u always contains URI
 952             # Examples: 505u, 506u, 510u, 514u, 520u, 530u, 538u, 540u, 542u, 552u, 555u, 561u, 563u, 583u
 953             # We first push the other subfields, then all $u's separately
 954             # Leave further actions to the template (see e.g. opac-detail)
 955             my $othersub =
 956                 join '', ( 'a' .. 't', 'v' .. 'z', '0' .. '9' ); # excl 'u'
 957             push @marcnotes, { marcnote => $field->as_string($othersub) };
 958             foreach my $sub ( $field->subfield('u') ) {
 959                 $sub =~ s/^\s+|\s+$//g; # trim
 960                 push @marcnotes, { marcnote => $sub };
 961             }
 962         } else {
 963             push @marcnotes, { marcnote => $field->as_string() };
 964         }
 965     }
 966     return \@marcnotes;
 967 }
 968
 969 =head3 get_authors_from_MARC
 970
 971     my $authors = $biblio->get_authors_from_MARC;
 972
 973 Get all authors from the MARC record and returns them in an array.
 974 The authors are stored in different fields depending on MARC flavour
 975
 976 =cut
 977
 978 sub get_authors_from_MARC {
 979     my ( $self, $params ) = @_;
 980
 981     my ( $mintag, $maxtag, $fields_filter );
 982     my $marcflavour = C4::Context->preference('marcflavour');
 983
 984     # tagslib useful only for UNIMARC author responsibilities
 985     my $tagslib;
 986     if ( $marcflavour eq "UNIMARC" ) {
 987         # FIXME : we don't have the framework available, we take the default framework. May be buggy on some setups, will be usually correct.
 988         $tagslib = C4::Biblio::GetMarcStructure( 1, '', { unsafe => 1 });
 989         $mintag = "700";
 990         $maxtag = "712";
 991         $fields_filter = '7..';
 992     } else { # marc21/normarc
 993         $mintag = "700";
 994         $maxtag = "720";
 995         $fields_filter = '7..';
 996     }
 997
 998     my @marcauthors;
 999     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1000
1001     foreach my $field ( $self->metadata->record->field($fields_filter) ) {
1002         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1003         my @subfields_loop;
1004         my @link_loop;
1005         my @subfields  = $field->subfields();
1006         my $count_auth = 0;
1007
1008         # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1009         my $subfield9 = $field->subfield('9');
1010         if ($subfield9) {
1011             my $linkvalue = $subfield9;
1012             $linkvalue =~ s/(\(|\))//g;
1013             @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1014         }
1015
1016         # other subfields
1017         my $unimarc3;
1018         for my $authors_subfield (@subfields) {
1019             next if ( $authors_subfield->[0] eq '9' );
1020
1021             # unimarc3 contains the $3 of the author for UNIMARC.
1022             # For french academic libraries, it's the "ppn", and it's required for idref webservice
1023             $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1024
1025             # don't load unimarc subfields 3, 5
1026             next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1027
1028             my $code = $authors_subfield->[0];
1029             my $value        = $authors_subfield->[1];
1030             my $linkvalue    = $value;
1031             $linkvalue =~ s/(\(|\))//g;
1032             # UNIMARC author responsibility
1033             if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1034                 $value = C4::Biblio::GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1035                 $linkvalue = "($value)";
1036             }
1037             # if no authority link, build a search query
1038             unless ($subfield9) {
1039                 push @link_loop, {
1040                     limit    => 'au',
1041                     'link'   => $linkvalue,
1042                     operator => (scalar @link_loop) ? ' and ' : undef
1043                 };
1044             }
1045             my @this_link_loop = @link_loop;
1046             # do not display $0
1047             unless ( $code eq '0') {
1048                 push @subfields_loop, {
1049                     tag       => $field->tag(),
1050                     code      => $code,
1051                     value     => $value,
1052                     link_loop => \@this_link_loop,
1053                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1054                 };
1055             }
1056         }
1057         push @marcauthors, {
1058             MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1059             authoritylink => $subfield9,
1060             unimarc3 => $unimarc3
1061         };
1062     }
1063     return \@marcauthors;
1064 }
1065
1066 =head3 to_api
1067
1068     my $json = $biblio->to_api;
1069
1070 Overloaded method that returns a JSON representation of the Koha::Biblio object,
1071 suitable for API output. The related Koha::Biblioitem object is merged as expected
1072 on the API.
1073
1074 =cut
1075
1076 sub to_api {
1077     my ($self, $args) = @_;
1078
1079     my $response = $self->SUPER::to_api( $args );
1080     my $biblioitem = $self->biblioitem->to_api;
1081
1082     return { %$response, %$biblioitem };
1083 }
1084
1085 =head3 to_api_mapping
1086
1087 This method returns the mapping for representing a Koha::Biblio object
1088 on the API.
1089
1090 =cut
1091
1092 sub to_api_mapping {
1093     return {
1094         biblionumber     => 'biblio_id',
1095         frameworkcode    => 'framework_id',
1096         unititle         => 'uniform_title',
1097         seriestitle      => 'series_title',
1098         copyrightdate    => 'copyright_date',
1099         datecreated      => 'creation_date'
1100     };
1101 }
1102
1103 =head3 get_marc_host
1104
1105     $host = $biblio->get_marc_host;
1106     # OR:
1107     ( $host, $relatedparts ) = $biblio->get_marc_host;
1108
1109     Returns host biblio record from MARC21 773 (undef if no 773 present).
1110     It looks at the first 773 field with MARCorgCode or only a control
1111     number. Complete $w or numeric part is used to search host record.
1112     The optional parameter no_items triggers a check if $biblio has items.
1113     If there are, the sub returns undef.
1114     Called in list context, it also returns 773$g (related parts).
1115
1116 =cut
1117
1118 sub get_marc_host {
1119     my ($self, $params) = @_;
1120     my $no_items = $params->{no_items};
1121     return if C4::Context->preference('marcflavour') eq 'UNIMARC'; # TODO
1122     return if $params->{no_items} && $self->items->count > 0;
1123
1124     my $record;
1125     eval { $record = $self->metadata->record };
1126     return if !$record;
1127
1128     # We pick the first $w with your MARCOrgCode or the first $w that has no
1129     # code (between parentheses) at all.
1130     my $orgcode = C4::Context->preference('MARCOrgCode') // q{};
1131     my $hostfld;
1132     foreach my $f ( $record->field('773') ) {
1133         my $w = $f->subfield('w') or next;
1134         if( $w =~ /^\($orgcode\)\s*(\d+)/i or $w =~ /^\d+/ ) {
1135             $hostfld = $f;
1136             last;
1137         }
1138     }
1139     return if !$hostfld;
1140     my $rcn = $hostfld->subfield('w');
1141
1142     # Look for control number with/without orgcode
1143     my $engine = Koha::SearchEngine::Search->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
1144     my $bibno;
1145     for my $try (1..2) {
1146         my ( $error, $results, $total_hits ) = $engine->simple_search_compat( 'Control-number='.$rcn, 0,1 );
1147         if( !$error and $total_hits == 1 ) {
1148             $bibno = $engine->extract_biblionumber( $results->[0] );
1149             last;
1150         }
1151         # Add or remove orgcode for second try
1152         if( $try == 1 && $rcn =~ /\)\s*(\d+)/ ) {
1153             $rcn = $1; # number only
1154         } elsif( $try == 1 && $rcn =~ /^\d+/ ) {
1155             $rcn = "($orgcode)$rcn";
1156         } else {
1157             last;
1158         }
1159     }
1160     if( $bibno ) {
1161         my $host = Koha::Biblios->find($bibno) or return;
1162         return wantarray ? ( $host, $hostfld->subfield('g') ) : $host;
1163     }
1164 }
1165
1166 =head2 Internal methods
1167
1168 =head3 type
1169
1170 =cut
1171
1172 sub _type {
1173     return 'Biblio';
1174 }
1175
1176 =head1 AUTHOR
1177
1178 Kyle M Hall <kyle@bywatersolutions.com>
1179
1180 =cut
1181
1182 1;