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