koha-dev.rot13.org Git - srvgit/blob - Koha/Biblio.pm

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