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 GetNormalizedUPC GetNormalizedOCLCNumber );
  27
  28 use Koha::Database;
  29 use Koha::DateUtils qw( dt_from_string );
  30
  31 use base qw(Koha::Object);
  32
  33 use Koha::Acquisition::Orders;
  34 use Koha::ArticleRequests;
  35 use Koha::Biblio::Metadatas;
  36 use Koha::Biblio::Metadata::Extractor;
  37 use Koha::Biblio::ItemGroups;
  38 use Koha::Biblioitems;
  39 use Koha::Cache::Memory::Lite;
  40 use Koha::Checkouts;
  41 use Koha::CirculationRules;
  42 use Koha::Exceptions;
  43 use Koha::Illrequests;
  44 use Koha::Item::Transfer::Limits;
  45 use Koha::Items;
  46 use Koha::Libraries;
  47 use Koha::Old::Checkouts;
  48 use Koha::Ratings;
  49 use Koha::Recalls;
  50 use Koha::RecordProcessor;
  51 use Koha::Suggestions;
  52 use Koha::Subscriptions;
  53 use Koha::SearchEngine;
  54 use Koha::SearchEngine::Search;
  55 use Koha::SearchEngine::QueryBuilder;
  56 use Koha::Tickets;
  57
  58 =head1 NAME
  59
  60 Koha::Biblio - Koha Biblio Object class
  61
  62 =head1 API
  63
  64 =head2 Class Methods
  65
  66 =cut
  67
  68 =head3 store
  69
  70 Overloaded I<store> method to set default values
  71
  72 =cut
  73
  74 sub store {
  75     my ( $self ) = @_;
  76
  77     $self->datecreated( dt_from_string ) unless $self->datecreated;
  78
  79     return $self->SUPER::store;
  80 }
  81
  82 =head3 metadata
  83
  84 my $metadata = $biblio->metadata();
  85
  86 Returns a Koha::Biblio::Metadata object
  87
  88 =cut
  89
  90 sub metadata {
  91     my ( $self ) = @_;
  92
  93     my $metadata = $self->_result->metadata;
  94     return Koha::Biblio::Metadata->_new_from_dbic($metadata);
  95 }
  96
  97 =head3 record
  98
  99 my $record = $biblio->record();
 100
 101 Returns a Marc::Record object
 102
 103 =cut
 104
 105 sub record {
 106     my ( $self ) = @_;
 107
 108     return $self->metadata->record;
 109 }
 110
 111 =head3 record_schema
 112
 113 my $schema = $biblio->record_schema();
 114
 115 Returns the record schema (MARC21, USMARC or UNIMARC).
 116
 117 =cut
 118
 119 sub record_schema {
 120     my ( $self ) = @_;
 121
 122     return $self->metadata->schema // C4::Context->preference("marcflavour");
 123 }
 124
 125 =head3 orders
 126
 127 my $orders = $biblio->orders();
 128
 129 Returns a Koha::Acquisition::Orders object
 130
 131 =cut
 132
 133 sub orders {
 134     my ( $self ) = @_;
 135
 136     my $orders = $self->_result->orders;
 137     return Koha::Acquisition::Orders->_new_from_dbic($orders);
 138 }
 139
 140 =head3 active_orders
 141
 142 my $active_orders = $biblio->active_orders();
 143
 144 Returns the active acquisition orders related to this biblio.
 145 An order is considered active when it is not cancelled (i.e. when datecancellation
 146 is not undef).
 147
 148 =cut
 149
 150 sub active_orders {
 151     my ( $self ) = @_;
 152
 153     return $self->orders->search({ datecancellationprinted => undef });
 154 }
 155
 156 =head3 tickets
 157
 158   my $tickets = $biblio->tickets();
 159
 160 Returns all tickets linked to the biblio
 161
 162 =cut
 163
 164 sub tickets {
 165     my ( $self ) = @_;
 166     my $rs = $self->_result->tickets;
 167     return Koha::Tickets->_new_from_dbic( $rs );
 168 }
 169
 170 =head3 ill_requests
 171
 172     my $ill_requests = $biblio->ill_requests();
 173
 174 Returns a Koha::Illrequests object
 175
 176 =cut
 177
 178 sub ill_requests {
 179     my ( $self ) = @_;
 180
 181     my $ill_requests = $self->_result->ill_requests;
 182     return Koha::Illrequests->_new_from_dbic($ill_requests);
 183 }
 184
 185 =head3 item_groups
 186
 187 my $item_groups = $biblio->item_groups();
 188
 189 Returns a Koha::Biblio::ItemGroups object
 190
 191 =cut
 192
 193 sub item_groups {
 194     my ( $self ) = @_;
 195
 196     my $item_groups = $self->_result->item_groups;
 197     return Koha::Biblio::ItemGroups->_new_from_dbic($item_groups);
 198 }
 199
 200 =head3 can_article_request
 201
 202 my $bool = $biblio->can_article_request( $borrower );
 203
 204 Returns true if article requests can be made for this record
 205
 206 $borrower must be a Koha::Patron object
 207
 208 =cut
 209
 210 sub can_article_request {
 211     my ( $self, $borrower ) = @_;
 212
 213     my $rule = $self->article_request_type($borrower);
 214     return q{} if $rule eq 'item_only' && !$self->items()->count();
 215     return 1 if $rule && $rule ne 'no';
 216
 217     return q{};
 218 }
 219
 220 =head3 can_be_transferred
 221
 222 $biblio->can_be_transferred({ to => $to_library, from => $from_library })
 223
 224 Checks if at least one item of a biblio can be transferred to given library.
 225
 226 This feature is controlled by two system preferences:
 227 UseBranchTransferLimits to enable / disable the feature
 228 BranchTransferLimitsType to use either an itemnumber or ccode as an identifier
 229                          for setting the limitations
 230
 231 Performance-wise, it is recommended to use this method for a biblio instead of
 232 iterating each item of a biblio with Koha::Item->can_be_transferred().
 233
 234 Takes HASHref that can have the following parameters:
 235     MANDATORY PARAMETERS:
 236     $to   : Koha::Library
 237     OPTIONAL PARAMETERS:
 238     $from : Koha::Library # if given, only items from that
 239                           # holdingbranch are considered
 240
 241 Returns 1 if at least one of the item of a biblio can be transferred
 242 to $to_library, otherwise 0.
 243
 244 =cut
 245
 246 sub can_be_transferred {
 247     my ($self, $params) = @_;
 248
 249     my $to   = $params->{to};
 250     my $from = $params->{from};
 251
 252     return 1 unless C4::Context->preference('UseBranchTransferLimits');
 253     my $limittype = C4::Context->preference('BranchTransferLimitsType');
 254
 255     my $items;
 256     foreach my $item_of_bib ($self->items->as_list) {
 257         next unless $item_of_bib->holdingbranch;
 258         next if $from && $from->branchcode ne $item_of_bib->holdingbranch;
 259         return 1 if $item_of_bib->holdingbranch eq $to->branchcode;
 260         my $code = $limittype eq 'itemtype'
 261             ? $item_of_bib->effective_itemtype
 262             : $item_of_bib->ccode;
 263         return 1 unless $code;
 264         $items->{$code}->{$item_of_bib->holdingbranch} = 1;
 265     }
 266
 267     # At this point we will have a HASHref containing each itemtype/ccode that
 268     # this biblio has, inside which are all of the holdingbranches where those
 269     # items are located at. Then, we will query Koha::Item::Transfer::Limits to
 270     # find out whether a transfer limits for such $limittype from any of the
 271     # listed holdingbranches to the given $to library exist. If at least one
 272     # holdingbranch for that $limittype does not have a transfer limit to given
 273     # $to library, then we know that the transfer is possible.
 274     foreach my $code (keys %{$items}) {
 275         my @holdingbranches = keys %{$items->{$code}};
 276         return 1 if Koha::Item::Transfer::Limits->search({
 277             toBranch => $to->branchcode,
 278             fromBranch => { 'in' => \@holdingbranches },
 279             $limittype => $code
 280         }, {
 281             group_by => [qw/fromBranch/]
 282         })->count == scalar(@holdingbranches) ? 0 : 1;
 283     }
 284
 285     return 0;
 286 }
 287
 288
 289 =head3 pickup_locations
 290
 291     my $pickup_locations = $biblio->pickup_locations({ patron => $patron });
 292
 293 Returns a Koha::Libraries set of possible pickup locations for this biblio's items,
 294 according to patron's home library and if item can be transferred to each pickup location.
 295
 296 Throws a I<Koha::Exceptions::MissingParameter> exception if the B<mandatory> parameter I<patron>
 297 is not passed.
 298
 299 =cut
 300
 301 sub pickup_locations {
 302     my ( $self, $params ) = @_;
 303
 304     Koha::Exceptions::MissingParameter->throw( parameter => 'patron' )
 305       unless exists $params->{patron};
 306
 307     my $patron = $params->{patron};
 308
 309     my $memory_cache = Koha::Cache::Memory::Lite->get_instance();
 310     my @pickup_locations;
 311     foreach my $item ( $self->items->as_list ) {
 312         my $cache_key = sprintf "Pickup_locations:%s:%s:%s:%s:%s",
 313            $item->itype,$item->homebranch,$item->holdingbranch,$item->ccode || "",$patron->branchcode||"" ;
 314         my $item_pickup_locations = $memory_cache->get_from_cache( $cache_key );
 315         unless( $item_pickup_locations ){
 316           @{ $item_pickup_locations } = $item->pickup_locations( { patron => $patron } )->_resultset->get_column('branchcode')->all;
 317           $memory_cache->set_in_cache( $cache_key, $item_pickup_locations );
 318         }
 319         push @pickup_locations, @{ $item_pickup_locations }
 320     }
 321
 322     return Koha::Libraries->search(
 323         { branchcode => { '-in' => \@pickup_locations } }, { order_by => ['branchname'] } );
 324 }
 325
 326 =head3 hidden_in_opac
 327
 328     my $bool = $biblio->hidden_in_opac({ [ rules => $rules ] })
 329
 330 Returns true if the biblio matches the hidding criteria defined in $rules.
 331 Returns false otherwise. It involves the I<OpacHiddenItems> and
 332 I<OpacHiddenItemsHidesRecord> system preferences.
 333
 334 Takes HASHref that can have the following parameters:
 335     OPTIONAL PARAMETERS:
 336     $rules : { <field> => [ value_1, ... ], ... }
 337
 338 Note: $rules inherits its structure from the parsed YAML from reading
 339 the I<OpacHiddenItems> system preference.
 340
 341 =cut
 342
 343 sub hidden_in_opac {
 344     my ( $self, $params ) = @_;
 345
 346     my $rules = $params->{rules} // {};
 347
 348     my @items = $self->items->as_list;
 349
 350     return 0 unless @items; # Do not hide if there is no item
 351
 352     # Ok, there are items, don't even try the rules unless OpacHiddenItemsHidesRecord
 353     return 0 unless C4::Context->preference('OpacHiddenItemsHidesRecord');
 354
 355     return !(any { !$_->hidden_in_opac({ rules => $rules }) } @items);
 356 }
 357
 358 =head3 article_request_type
 359
 360 my $type = $biblio->article_request_type( $borrower );
 361
 362 Returns the article request type based on items, or on the record
 363 itself if there are no items.
 364
 365 $borrower must be a Koha::Patron object
 366
 367 =cut
 368
 369 sub article_request_type {
 370     my ( $self, $borrower ) = @_;
 371
 372     return q{} unless $borrower;
 373
 374     my $rule = $self->article_request_type_for_items( $borrower );
 375     return $rule if $rule;
 376
 377     # If the record has no items that are requestable, go by the record itemtype
 378     $rule = $self->article_request_type_for_bib($borrower);
 379     return $rule if $rule;
 380
 381     return q{};
 382 }
 383
 384 =head3 article_request_type_for_bib
 385
 386 my $type = $biblio->article_request_type_for_bib
 387
 388 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record
 389
 390 =cut
 391
 392 sub article_request_type_for_bib {
 393     my ( $self, $borrower ) = @_;
 394
 395     return q{} unless $borrower;
 396
 397     my $borrowertype = $borrower->categorycode;
 398     my $itemtype     = $self->itemtype();
 399
 400     my $rule = Koha::CirculationRules->get_effective_rule(
 401         {
 402             rule_name    => 'article_requests',
 403             categorycode => $borrowertype,
 404             itemtype     => $itemtype,
 405         }
 406     );
 407
 408     return q{} unless $rule;
 409     return $rule->rule_value || q{}
 410 }
 411
 412 =head3 article_request_type_for_items
 413
 414 my $type = $biblio->article_request_type_for_items
 415
 416 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record's items
 417
 418 If there is a conflict where some items are 'bib_only' and some are 'item_only', 'bib_only' will be returned.
 419
 420 =cut
 421
 422 sub article_request_type_for_items {
 423     my ( $self, $borrower ) = @_;
 424
 425     my $counts;
 426     foreach my $item ( $self->items()->as_list() ) {
 427         my $rule = $item->article_request_type($borrower);
 428         return $rule if $rule eq 'bib_only';    # we don't need to go any further
 429         $counts->{$rule}++;
 430     }
 431
 432     return 'item_only' if $counts->{item_only};
 433     return 'yes'       if $counts->{yes};
 434     return 'no'        if $counts->{no};
 435     return q{};
 436 }
 437
 438 =head3 article_requests
 439
 440     my $article_requests = $biblio->article_requests
 441
 442 Returns the article requests associated with this biblio
 443
 444 =cut
 445
 446 sub article_requests {
 447     my ( $self ) = @_;
 448
 449     return Koha::ArticleRequests->_new_from_dbic( scalar $self->_result->article_requests );
 450 }
 451
 452 =head3 current_checkouts
 453
 454     my $current_checkouts = $biblio->current_checkouts
 455
 456 Returns the current checkouts associated with this biblio
 457
 458 =cut
 459
 460 sub current_checkouts {
 461     my ($self) = @_;
 462
 463     return Koha::Checkouts->search( { "item.biblionumber" => $self->id },
 464         { join => 'item' } );
 465 }
 466
 467 =head3 old_checkouts
 468
 469     my $old_checkouts = $biblio->old_checkouts
 470
 471 Returns the past checkouts associated with this biblio
 472
 473 =cut
 474
 475 sub old_checkouts {
 476     my ( $self ) = @_;
 477
 478     return Koha::Old::Checkouts->search( { "item.biblionumber" => $self->id },
 479         { join => 'item' } );
 480 }
 481
 482 =head3 items
 483
 484 my $items = $biblio->items({ [ host_items => 1 ] });
 485
 486 The optional param host_items allows you to include 'analytical' items.
 487
 488 Returns the related Koha::Items object for this biblio
 489
 490 =cut
 491
 492 sub items {
 493     my ($self,$params) = @_;
 494
 495     my $items_rs = $self->_result->items;
 496
 497     return Koha::Items->_new_from_dbic( $items_rs ) unless $params->{host_items};
 498
 499     my @itemnumbers = $items_rs->get_column('itemnumber')->all;
 500     my $host_itemnumbers = $self->_host_itemnumbers();
 501     push @itemnumbers, @{ $host_itemnumbers };
 502     return Koha::Items->search({ "me.itemnumber" => { -in => \@itemnumbers } });
 503 }
 504
 505 =head3 host_items
 506
 507 my $host_items = $biblio->host_items();
 508
 509 Return the host items (easy analytical record)
 510
 511 =cut
 512
 513 sub host_items {
 514     my ($self) = @_;
 515
 516     return Koha::Items->new->empty
 517       unless C4::Context->preference('EasyAnalyticalRecords');
 518
 519     my $host_itemnumbers = $self->_host_itemnumbers;
 520
 521     return Koha::Items->search( { itemnumber => { -in => $host_itemnumbers } } );
 522 }
 523
 524 =head3 _host_itemnumbers
 525
 526 my $host_itemnumber = $biblio->_host_itemnumbers();
 527
 528 Return the itemnumbers for analytical items on this record
 529
 530 =cut
 531
 532 sub _host_itemnumbers {
 533     my ($self) = @_;
 534
 535     my $marcflavour = C4::Context->preference("marcflavour");
 536     my $analyticfield = '773';
 537     if ( $marcflavour eq 'UNIMARC' ) {
 538         $analyticfield = '461';
 539     }
 540     my $marc_record = $self->metadata->record;
 541     my @itemnumbers;
 542     foreach my $field ( $marc_record->field($analyticfield) ) {
 543         push @itemnumbers, $field->subfield('9');
 544     }
 545     return \@itemnumbers;
 546 }
 547
 548
 549 =head3 itemtype
 550
 551 my $itemtype = $biblio->itemtype();
 552
 553 Returns the itemtype for this record.
 554
 555 =cut
 556
 557 sub itemtype {
 558     my ( $self ) = @_;
 559
 560     return $self->biblioitem()->itemtype();
 561 }
 562
 563 =head3 holds
 564
 565 my $holds = $biblio->holds();
 566
 567 return the current holds placed on this record
 568
 569 =cut
 570
 571 sub holds {
 572     my ( $self, $params, $attributes ) = @_;
 573     $attributes->{order_by} = 'priority' unless exists $attributes->{order_by};
 574     my $hold_rs = $self->_result->reserves->search( $params, $attributes );
 575     return Koha::Holds->_new_from_dbic($hold_rs);
 576 }
 577
 578 =head3 current_holds
 579
 580 my $holds = $biblio->current_holds
 581
 582 Return the holds placed on this bibliographic record.
 583 It does not include future holds.
 584
 585 =cut
 586
 587 sub current_holds {
 588     my ($self) = @_;
 589     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 590     return $self->holds(
 591         { reservedate => { '<=' => $dtf->format_date(dt_from_string) } } );
 592 }
 593
 594 =head3 biblioitem
 595
 596 my $field = $self->biblioitem
 597
 598 Returns the related Koha::Biblioitem object for this Biblio object
 599
 600 =cut
 601
 602 sub biblioitem {
 603     my ($self) = @_;
 604     return Koha::Biblioitems->find( { biblionumber => $self->biblionumber } );
 605 }
 606
 607 =head3 suggestions
 608
 609 my $suggestions = $self->suggestions
 610
 611 Returns the related Koha::Suggestions object for this Biblio object
 612
 613 =cut
 614
 615 sub suggestions {
 616     my ($self) = @_;
 617
 618     my $suggestions_rs = $self->_result->suggestions;
 619     return Koha::Suggestions->_new_from_dbic( $suggestions_rs );
 620 }
 621
 622 =head3 get_marc_components
 623
 624   my $components = $self->get_marc_components();
 625
 626 Returns an array of search results data, which are component parts of
 627 this object (MARC21 773 points to this)
 628
 629 =cut
 630
 631 sub get_marc_components {
 632     my ($self, $max_results) = @_;
 633
 634     return [] if (C4::Context->preference('marcflavour') ne 'MARC21');
 635
 636     my ( $searchstr, $sort ) = $self->get_components_query;
 637
 638     my $components;
 639     if (defined($searchstr)) {
 640         my $searcher = Koha::SearchEngine::Search->new({index => $Koha::SearchEngine::BIBLIOS_INDEX});
 641         my ( $error, $results, $facets );
 642         eval {
 643             ( $error, $results, $facets ) = $searcher->search_compat( $searchstr, undef, [$sort], ['biblioserver'], $max_results, 0, undef, undef, 'ccl', 0 );
 644         };
 645         if( $error || $@ ) {
 646             $error //= q{};
 647             $error .= $@ if $@;
 648             warn "Warning from search_compat: '$error'";
 649             $self->add_message(
 650                 {
 651                     type    => 'error',
 652                     message => 'component_search',
 653                     payload => $error,
 654                 }
 655             );
 656         }
 657         $components = $results->{biblioserver}->{RECORDS} if defined($results) && $results->{biblioserver}->{hits};
 658     }
 659
 660     return $components // [];
 661 }
 662
 663 =head2 get_components_query
 664
 665 Returns a query which can be used to search for all component parts of MARC21 biblios
 666
 667 =cut
 668
 669 sub get_components_query {
 670     my ($self) = @_;
 671
 672     my $builder = Koha::SearchEngine::QueryBuilder->new(
 673         { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
 674     my $marc = $self->metadata->record;
 675     my $component_sort_field = C4::Context->preference('ComponentSortField') // "title";
 676     my $component_sort_order = C4::Context->preference('ComponentSortOrder') // "asc";
 677     my $sort = $component_sort_field . "_" . $component_sort_order;
 678
 679     my $searchstr;
 680     if ( C4::Context->preference('UseControlNumber') ) {
 681         my $pf001 = $marc->field('001') || undef;
 682
 683         if ( defined($pf001) ) {
 684             $searchstr = "(";
 685             my $pf003 = $marc->field('003') || undef;
 686
 687             if ( !defined($pf003) ) {
 688                 # search for 773$w='Host001'
 689                 $searchstr .= "rcn:\"" . $pf001->data()."\"";
 690             }
 691             else {
 692                 $searchstr .= "(";
 693                 # search for (773$w='Host001' and 003='Host003') or 773$w='(Host003)Host001'
 694                 $searchstr .= "(rcn:\"" . $pf001->data() . "\" AND cni:\"" . $pf003->data() . "\")";
 695                 $searchstr .= " OR rcn:\"" . $pf003->data() . " " . $pf001->data() . "\"";
 696                 $searchstr .= ")";
 697             }
 698
 699             # limit to monograph and serial component part records
 700             $searchstr .= " AND (bib-level:a OR bib-level:b)";
 701             $searchstr .= ")";
 702         }
 703     }
 704     else {
 705         my $cleaned_title = $marc->subfield('245', "a");
 706         $cleaned_title =~ tr|/||;
 707         $cleaned_title = $builder->clean_search_term($cleaned_title);
 708         $searchstr = qq#Host-item:("$cleaned_title")#;
 709     }
 710     my ($error, $query ,$query_str) = $builder->build_query_compat( undef, [$searchstr], undef, undef, [$sort], 0 );
 711     if( $error ){
 712         warn $error;
 713         return;
 714     }
 715
 716     return ($query, $query_str, $sort);
 717 }
 718
 719 =head3 get_marc_volumes
 720
 721   my $volumes = $self->get_marc_volumes();
 722
 723 Returns an array of MARCXML data, which are volumes parts of
 724 this object (MARC21 773$w or 8xx$w point to this)
 725
 726 =cut
 727
 728 sub get_marc_volumes {
 729     my ( $self, $max_results ) = @_;
 730
 731     return $self->{_volumes} if defined( $self->{_volumes} );
 732
 733     my $searchstr = $self->get_volumes_query;
 734
 735     if ( defined($searchstr) ) {
 736         my $searcher = Koha::SearchEngine::Search->new( { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
 737         my ( $errors, $results, $total_hits ) = $searcher->simple_search_compat( $searchstr, 0, $max_results );
 738         $self->{_volumes} =
 739             ( defined($results) && scalar(@$results) ) ? $results : [];
 740     } else {
 741         $self->{_volumes} = [];
 742     }
 743
 744     return $self->{_volumes};
 745 }
 746
 747 =head2 get_volumes_query
 748
 749 Returns a query which can be used to search for all component parts of MARC21 biblios
 750
 751 =cut
 752
 753 sub get_volumes_query {
 754     my ($self) = @_;
 755
 756     # MARC21 Only for now
 757     return if ( C4::Context->preference('marcflavour') ne 'MARC21' );
 758
 759     my $marc = $self->metadata->record;
 760
 761     # Only build volumes query if we're in a 'Set' record
 762     # or we have a monographic series.
 763     # For monographic series the check on LDR 7 in (b or i or s) is omitted
 764     my $leader19 = substr( $marc->leader, 19, 1 );
 765     my $pf008    = $marc->field('008') || '';
 766     my $mseries  = ( $pf008 && substr( $pf008->data(), 21, 1 ) eq 'm' ) ? 1 : 0;
 767     return unless ( $leader19 eq 'a' || $mseries );
 768
 769     my $builder = Koha::SearchEngine::QueryBuilder->new( { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
 770
 771     my $searchstr;
 772     if ( C4::Context->preference('UseControlNumber') ) {
 773         my $pf001 = $marc->field('001') || undef;
 774
 775         if ( defined($pf001) ) {
 776             $searchstr = "(";
 777             my $pf003 = $marc->field('003') || undef;
 778
 779             if ( !defined($pf003) ) {
 780
 781                 # search for linking_field$w='Host001'
 782                 $searchstr .= "rcn:" . $pf001->data();
 783             } else {
 784                 $searchstr .= "(";
 785
 786                 # search for (linking_field$w='Host001' and 003='Host003') or linking_field$w='(Host003)Host001'
 787                 $searchstr .= "(rcn:" . $pf001->data() . " AND cni:" . $pf003->data() . ")";
 788                 $searchstr .= " OR rcn:\"" . $pf003->data() . " " . $pf001->data() . "\"";
 789                 $searchstr .= ")";
 790             }
 791
 792             # exclude monograph and serial component part records
 793             $searchstr .= " NOT (bib-level:a OR bib-level:b)";
 794             $searchstr .= ")";
 795         }
 796     } else {
 797         my $cleaned_title = $marc->subfield( '245', "a" );
 798         $cleaned_title =~ tr|/||;
 799         $cleaned_title = $builder->clean_search_term($cleaned_title);
 800         $searchstr     = qq#(title-series,phr:("$cleaned_title") OR Host-item,phr:("$cleaned_title")#;
 801         $searchstr .= " NOT (bib-level:a OR bib-level:b))";
 802     }
 803
 804     return $searchstr;
 805 }
 806
 807 =head3 subscriptions
 808
 809 my $subscriptions = $self->subscriptions
 810
 811 Returns the related Koha::Subscriptions object for this Biblio object
 812
 813 =cut
 814
 815 sub subscriptions {
 816     my ($self) = @_;
 817     my $rs = $self->_result->subscriptions;
 818     return Koha::Subscriptions->_new_from_dbic($rs);
 819 }
 820
 821 =head3 has_items_waiting_or_intransit
 822
 823 my $itemsWaitingOrInTransit = $biblio->has_items_waiting_or_intransit
 824
 825 Tells if this bibliographic record has items waiting or in transit.
 826
 827 =cut
 828
 829 sub has_items_waiting_or_intransit {
 830     my ( $self ) = @_;
 831
 832     if ( Koha::Holds->search({ biblionumber => $self->id,
 833                                found => ['W', 'T'] })->count ) {
 834         return 1;
 835     }
 836
 837     foreach my $item ( $self->items->as_list ) {
 838         return 1 if $item->get_transfer;
 839     }
 840
 841     return 0;
 842 }
 843
 844 =head2 get_coins
 845
 846 my $coins = $biblio->get_coins;
 847
 848 Returns the COinS (a span) which can be included in a biblio record
 849
 850 =cut
 851
 852 sub get_coins {
 853     my ( $self ) = @_;
 854
 855     my $record = $self->metadata->record;
 856
 857     my $pos7 = substr $record->leader(), 7, 1;
 858     my $pos6 = substr $record->leader(), 6, 1;
 859     my $mtx;
 860     my $genre;
 861     my ( $aulast, $aufirst ) = ( '', '' );
 862     my @authors;
 863     my $title;
 864     my $hosttitle;
 865     my $pubyear   = '';
 866     my $isbn      = '';
 867     my $issn      = '';
 868     my $publisher = '';
 869     my $pages     = '';
 870     my $titletype = '';
 871
 872     # For the purposes of generating COinS metadata, LDR/06-07 can be
 873     # considered the same for UNIMARC and MARC21
 874     my $fmts6 = {
 875         'a' => 'book',
 876         'b' => 'manuscript',
 877         'c' => 'book',
 878         'd' => 'manuscript',
 879         'e' => 'map',
 880         'f' => 'map',
 881         'g' => 'film',
 882         'i' => 'audioRecording',
 883         'j' => 'audioRecording',
 884         'k' => 'artwork',
 885         'l' => 'document',
 886         'm' => 'computerProgram',
 887         'o' => 'document',
 888         'r' => 'document',
 889     };
 890     my $fmts7 = {
 891         'a' => 'journalArticle',
 892         's' => 'journal',
 893     };
 894
 895     $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
 896
 897     if ( $genre eq 'book' ) {
 898             $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
 899     }
 900
 901     ##### We must transform mtx to a valable mtx and document type ####
 902     if ( $genre eq 'book' ) {
 903             $mtx = 'book';
 904             $titletype = 'b';
 905     } elsif ( $genre eq 'journal' ) {
 906             $mtx = 'journal';
 907             $titletype = 'j';
 908     } elsif ( $genre eq 'journalArticle' ) {
 909             $mtx   = 'journal';
 910             $genre = 'article';
 911             $titletype = 'a';
 912     } else {
 913             $mtx = 'dc';
 914     }
 915
 916     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
 917
 918         # Setting datas
 919         $aulast  = $record->subfield( '700', 'a' ) || '';
 920         $aufirst = $record->subfield( '700', 'b' ) || '';
 921         push @authors, "$aufirst $aulast" if ($aufirst or $aulast);
 922
 923         # others authors
 924         if ( $record->field('200') ) {
 925             for my $au ( $record->field('200')->subfield('g') ) {
 926                 push @authors, $au;
 927             }
 928         }
 929
 930         $title     = $record->subfield( '200', 'a' );
 931         my $subfield_210d = $record->subfield('210', 'd');
 932         if ($subfield_210d and $subfield_210d =~ /(\d{4})/) {
 933             $pubyear = $1;
 934         }
 935         $publisher = $record->subfield( '210', 'c' ) || '';
 936         $isbn      = $record->subfield( '010', 'a' ) || '';
 937         $issn      = $record->subfield( '011', 'a' ) || '';
 938     } else {
 939
 940         # MARC21 need some improve
 941
 942         # Setting datas
 943         if ( $record->field('100') ) {
 944             push @authors, $record->subfield( '100', 'a' );
 945         }
 946
 947         # others authors
 948         if ( $record->field('700') ) {
 949             for my $au ( $record->field('700')->subfield('a') ) {
 950                 push @authors, $au;
 951             }
 952         }
 953         $title = $record->field('245');
 954         $title &&= $title->as_string('ab');
 955         if ($titletype eq 'a') {
 956             $pubyear   = $record->field('008') || '';
 957             $pubyear   = substr($pubyear->data(), 7, 4) if $pubyear;
 958             $isbn      = $record->subfield( '773', 'z' ) || '';
 959             $issn      = $record->subfield( '773', 'x' ) || '';
 960             $hosttitle = $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{};
 961             my @rels = $record->subfield( '773', 'g' );
 962             $pages = join(', ', @rels);
 963         } else {
 964             $pubyear   = $record->subfield( '260', 'c' ) || '';
 965             $publisher = $record->subfield( '260', 'b' ) || '';
 966             $isbn      = $record->subfield( '020', 'a' ) || '';
 967             $issn      = $record->subfield( '022', 'a' ) || '';
 968         }
 969
 970     }
 971
 972     my @params = (
 973         [ 'ctx_ver', 'Z39.88-2004' ],
 974         [ 'rft_val_fmt', "info:ofi/fmt:kev:mtx:$mtx" ],
 975         [ ($mtx eq 'dc' ? 'rft.type' : 'rft.genre'), $genre ],
 976         [ "rft.${titletype}title", $title ],
 977     );
 978
 979     # rft.title is authorized only once, so by checking $titletype
 980     # we ensure that rft.title is not already in the list.
 981     if ($hosttitle and $titletype) {
 982         push @params, [ 'rft.title', $hosttitle ];
 983     }
 984
 985     push @params, (
 986         [ 'rft.isbn', $isbn ],
 987         [ 'rft.issn', $issn ],
 988     );
 989
 990     # If it's a subscription, these informations have no meaning.
 991     if ($genre ne 'journal') {
 992         push @params, (
 993             [ 'rft.aulast', $aulast ],
 994             [ 'rft.aufirst', $aufirst ],
 995             (map { [ 'rft.au', $_ ] } @authors),
 996             [ 'rft.pub', $publisher ],
 997             [ 'rft.date', $pubyear ],
 998             [ 'rft.pages', $pages ],
 999         );
1000     }
1001
1002     my $coins_value = join( '&amp;',
1003         map { $$_[1] ? $$_[0] . '=' . uri_escape_utf8( $$_[1] ) : () } @params );
1004
1005     return $coins_value;
1006 }
1007
1008 =head2 get_openurl
1009
1010 my $url = $biblio->get_openurl;
1011
1012 Returns url for OpenURL resolver set in OpenURLResolverURL system preference
1013
1014 =cut
1015
1016 sub get_openurl {
1017     my ( $self ) = @_;
1018
1019     my $OpenURLResolverURL = C4::Context->preference('OpenURLResolverURL');
1020
1021     if ($OpenURLResolverURL) {
1022         my $uri = URI->new($OpenURLResolverURL);
1023
1024         if (not defined $uri->query) {
1025             $OpenURLResolverURL .= '?';
1026         } else {
1027             $OpenURLResolverURL .= '&amp;';
1028         }
1029         $OpenURLResolverURL .= $self->get_coins;
1030     }
1031
1032     return $OpenURLResolverURL;
1033 }
1034
1035 =head3 is_serial
1036
1037 my $serial = $biblio->is_serial
1038
1039 Return boolean true if this bibbliographic record is continuing resource
1040
1041 =cut
1042
1043 sub is_serial {
1044     my ( $self ) = @_;
1045
1046     return 1 if $self->serial;
1047
1048     my $record = $self->metadata->record;
1049     return 1 if substr($record->leader, 7, 1) eq 's';
1050
1051     return 0;
1052 }
1053
1054 =head3 custom_cover_image_url
1055
1056 my $image_url = $biblio->custom_cover_image_url
1057
1058 Return the specific url of the cover image for this bibliographic record.
1059 It is built regaring the value of the system preference CustomCoverImagesURL
1060
1061 =cut
1062
1063 sub custom_cover_image_url {
1064     my ( $self ) = @_;
1065     my $url = C4::Context->preference('CustomCoverImagesURL');
1066     if ( $url =~ m|{isbn}| ) {
1067         my $isbn = $self->biblioitem->isbn;
1068         return unless $isbn;
1069         $url =~ s|{isbn}|$isbn|g;
1070     }
1071     if ( $url =~ m|{normalized_isbn}| ) {
1072         my $normalized_isbn = $self->normalized_isbn;
1073         return unless $normalized_isbn;
1074         $url =~ s|{normalized_isbn}|$normalized_isbn|g;
1075     }
1076     if ( $url =~ m|{issn}| ) {
1077         my $issn = $self->biblioitem->issn;
1078         return unless $issn;
1079         $url =~ s|{issn}|$issn|g;
1080     }
1081
1082     my $re = qr|{(?<field>\d{3})(\$(?<subfield>.))?}|;
1083     if ( $url =~ $re ) {
1084         my $field = $+{field};
1085         my $subfield = $+{subfield};
1086         my $marc_record = $self->metadata->record;
1087         my $value;
1088         if ( $subfield ) {
1089             $value = $marc_record->subfield( $field, $subfield );
1090         } else {
1091             my $controlfield = $marc_record->field($field);
1092             $value = $controlfield->data() if $controlfield;
1093         }
1094         return unless $value;
1095         $url =~ s|$re|$value|;
1096     }
1097
1098     return $url;
1099 }
1100
1101 =head3 cover_images
1102
1103 Return the cover images associated with this biblio.
1104
1105 =cut
1106
1107 sub cover_images {
1108     my ( $self ) = @_;
1109
1110     my $cover_images_rs = $self->_result->cover_images;
1111     return unless $cover_images_rs;
1112     return Koha::CoverImages->_new_from_dbic($cover_images_rs);
1113 }
1114
1115 =head3 get_marc_notes
1116
1117     $marcnotesarray = $biblio->get_marc_notes({ opac => 1 });
1118
1119 Get all notes from the MARC record and returns them in an array.
1120 The notes are stored in different fields depending on MARC flavour.
1121 MARC21 5XX $u subfields receive special attention as they are URIs.
1122
1123 =cut
1124
1125 sub get_marc_notes {
1126     my ( $self, $params ) = @_;
1127
1128     my $marcflavour = C4::Context->preference('marcflavour');
1129     my $opac = $params->{opac} // '0';
1130     my $interface = $params->{opac} ? 'opac' : 'intranet';
1131
1132     my $record = $params->{record} // $self->metadata->record;
1133     my $record_processor = Koha::RecordProcessor->new(
1134         {
1135             filters => [ 'ViewPolicy', 'ExpandCodedFields' ],
1136             options => {
1137                 interface     => $interface,
1138                 frameworkcode => $self->frameworkcode
1139             }
1140         }
1141     );
1142     $record_processor->process($record);
1143
1144     my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
1145     #MARC21 specs indicate some notes should be private if first indicator 0
1146     my %maybe_private = (
1147         541 => 1,
1148         542 => 1,
1149         561 => 1,
1150         583 => 1,
1151         590 => 1
1152     );
1153
1154     my %hiddenlist = map { $_ => 1 }
1155         split( /,/, C4::Context->preference('NotesToHide'));
1156
1157     my @marcnotes;
1158     foreach my $field ( $record->field($scope) ) {
1159         my $tag = $field->tag();
1160         next if $hiddenlist{ $tag };
1161         next if $opac && $maybe_private{$tag} && !$field->indicator(1);
1162         if( $marcflavour ne 'UNIMARC' && $field->subfield('u') ) {
1163             # Field 5XX$u always contains URI
1164             # Examples: 505u, 506u, 510u, 514u, 520u, 530u, 538u, 540u, 542u, 552u, 555u, 561u, 563u, 583u
1165             # We first push the other subfields, then all $u's separately
1166             # Leave further actions to the template (see e.g. opac-detail)
1167             my $othersub =
1168                 join '', ( 'a' .. 't', 'v' .. 'z', '0' .. '9' ); # excl 'u'
1169             push @marcnotes, { marcnote => $field->as_string($othersub) };
1170             foreach my $sub ( $field->subfield('u') ) {
1171                 $sub =~ s/^\s+|\s+$//g; # trim
1172                 push @marcnotes, { marcnote => $sub, tag => $tag };
1173             }
1174         } else {
1175             push @marcnotes, { marcnote => $field->as_string(), tag => $tag };
1176         }
1177     }
1178     return \@marcnotes;
1179 }
1180
1181 =head3 _get_marc_authors
1182
1183 Private method to return the list of authors contained in the MARC record.
1184 See get get_marc_contributors and get_marc_authors for the public methods.
1185
1186 =cut
1187
1188 sub _get_marc_authors {
1189     my ( $self, $params ) = @_;
1190
1191     my $fields_filter = $params->{fields_filter};
1192     my $mintag        = $params->{mintag};
1193     my $maxtag        = $params->{maxtag};
1194
1195     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1196     my $marcflavour        = C4::Context->preference('marcflavour');
1197
1198     # tagslib useful only for UNIMARC author responsibilities
1199     my $tagslib = $marcflavour eq "UNIMARC"
1200       ? C4::Biblio::GetMarcStructure( 1, $self->frameworkcode, { unsafe => 1 } )
1201       : undef;
1202
1203     my @marcauthors;
1204     foreach my $field ( $self->metadata->record->field($fields_filter) ) {
1205
1206         next
1207           if $mintag && $field->tag() < $mintag
1208           || $maxtag && $field->tag() > $maxtag;
1209
1210         my @subfields_loop;
1211         my @link_loop;
1212         my @subfields  = $field->subfields();
1213         my $count_auth = 0;
1214
1215         # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1216         my $subfield9 = $field->subfield('9');
1217         if ($subfield9) {
1218             my $linkvalue = $subfield9;
1219             $linkvalue =~ s/(\(|\))//g;
1220             @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1221         }
1222
1223         # other subfields
1224         my $unimarc3;
1225         for my $authors_subfield (@subfields) {
1226             next if ( $authors_subfield->[0] eq '9' );
1227
1228             # unimarc3 contains the $3 of the author for UNIMARC.
1229             # For french academic libraries, it's the "ppn", and it's required for idref webservice
1230             $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1231
1232             # don't load unimarc subfields 3, 5
1233             next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1234
1235             my $code = $authors_subfield->[0];
1236             my $value        = $authors_subfield->[1];
1237             my $linkvalue    = $value;
1238             $linkvalue =~ s/(\(|\))//g;
1239             # UNIMARC author responsibility
1240             if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1241                 $value = C4::Biblio::GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1242                 $linkvalue = "($value)";
1243             }
1244             # if no authority link, build a search query
1245             unless ($subfield9) {
1246                 push @link_loop, {
1247                     limit    => 'au',
1248                     'link'   => $linkvalue,
1249                     operator => (scalar @link_loop) ? ' AND ' : undef
1250                 };
1251             }
1252             my @this_link_loop = @link_loop;
1253             # do not display $0
1254             unless ( $code eq '0') {
1255                 push @subfields_loop, {
1256                     tag       => $field->tag(),
1257                     code      => $code,
1258                     value     => $value,
1259                     link_loop => \@this_link_loop,
1260                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1261                 };
1262             }
1263         }
1264         push @marcauthors, {
1265             MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1266             authoritylink => $subfield9,
1267             unimarc3 => $unimarc3
1268         };
1269     }
1270     return \@marcauthors;
1271 }
1272
1273 =head3 get_marc_contributors
1274
1275     my $contributors = $biblio->get_marc_contributors;
1276
1277 Get all contributors (but first author) from the MARC record and returns them in an array.
1278 They are stored in different fields depending on MARC flavour (700..720 for MARC21)
1279
1280 =cut
1281
1282 sub get_marc_contributors {
1283     my ( $self, $params ) = @_;
1284
1285     my ( $mintag, $maxtag, $fields_filter );
1286     my $marcflavour = C4::Context->preference('marcflavour');
1287
1288     if ( $marcflavour eq "UNIMARC" ) {
1289         $mintag = "700";
1290         $maxtag = "712";
1291         $fields_filter = '7..';
1292     } else { # marc21/normarc
1293         $mintag = "700";
1294         $maxtag = "720";
1295         $fields_filter = '7..';
1296     }
1297
1298     return $self->_get_marc_authors(
1299         {
1300             fields_filter => $fields_filter,
1301             mintag       => $mintag,
1302             maxtag       => $maxtag
1303         }
1304     );
1305 }
1306
1307 =head3 get_marc_authors
1308
1309     my $authors = $biblio->get_marc_authors;
1310
1311 Get all authors from the MARC record and returns them in an array.
1312 They are stored in different fields depending on MARC flavour
1313 (main author from 100 then secondary authors from 700..720).
1314
1315 =cut
1316
1317 sub get_marc_authors {
1318     my ( $self, $params ) = @_;
1319
1320     my ( $mintag, $maxtag, $fields_filter );
1321     my $marcflavour = C4::Context->preference('marcflavour');
1322
1323     if ( $marcflavour eq "UNIMARC" ) {
1324         $fields_filter = '200';
1325     } else { # marc21/normarc
1326         $fields_filter = '100';
1327     }
1328
1329     my @first_authors = @{$self->_get_marc_authors(
1330         {
1331             fields_filter => $fields_filter,
1332             mintag       => $mintag,
1333             maxtag       => $maxtag
1334         }
1335     )};
1336
1337     my @other_authors = @{$self->get_marc_contributors};
1338
1339     return [@first_authors, @other_authors];
1340 }
1341
1342 =head3 normalized_isbn
1343
1344     my $normalized_isbn = $biblio->normalized_isbn
1345
1346 Normalizes and returns the first valid ISBN found in the record.
1347 ISBN13 are converted into ISBN10. This is required to get some book cover images.
1348
1349 =cut
1350
1351 sub normalized_isbn {
1352     my ( $self) = @_;
1353     return C4::Koha::GetNormalizedISBN($self->biblioitem->isbn);
1354 }
1355
1356 =head3 public_read_list
1357
1358 This method returns the list of publicly readable database fields for both API and UI output purposes
1359
1360 =cut
1361
1362 sub public_read_list {
1363     return [
1364         'biblionumber',   'frameworkcode',   'author',
1365         'title',          'medium',          'subtitle',
1366         'part_number',    'part_name',       'unititle',
1367         'notes',          'serial',          'seriestitle',
1368         'copyrightdate',  'abstract'
1369     ];
1370 }
1371
1372 =head3 metadata_extractor
1373
1374     my $extractor = $biblio->metadata_extractor
1375
1376 Return a Koha::Biblio::Metadata::Extractor object to use to extract data from the metadata (ie. MARC record for now)
1377
1378 =cut
1379
1380 sub metadata_extractor {
1381     my ($self) = @_;
1382
1383     $self->{metadata_extractor} ||= Koha::Biblio::Metadata::Extractor->new( { biblio => $self } );
1384
1385     return $self->{metadata_extractor};
1386 }
1387
1388 =head3 normalized_upc
1389
1390     my $normalized_upc = $biblio->normalized_upc
1391
1392 Normalizes and returns the UPC value found in the MARC record.
1393
1394 =cut
1395
1396 sub normalized_upc {
1397     my ($self) = @_;
1398     return $self->metadata_extractor->get_normalized_upc;
1399 }
1400
1401 =head3 normalized_oclc
1402
1403     my $normalized_oclc = $biblio->normalized_oclc
1404
1405 Normalizes and returns the OCLC number found in the MARC record.
1406
1407 =cut
1408
1409 sub normalized_oclc {
1410     my ($self) = @_;
1411     return $self->metadata_extractor->get_normalized_oclc;
1412 }
1413
1414 =head3 to_api
1415
1416     my $json = $biblio->to_api;
1417
1418 Overloaded method that returns a JSON representation of the Koha::Biblio object,
1419 suitable for API output. The related Koha::Biblioitem object is merged as expected
1420 on the API.
1421
1422 =cut
1423
1424 sub to_api {
1425     my ($self, $args) = @_;
1426
1427     my $response = $self->SUPER::to_api( $args );
1428
1429     $args = defined $args ? {%$args} : {};
1430     delete $args->{embed};
1431
1432     my $biblioitem = $self->biblioitem->to_api( $args );
1433
1434     return { %$response, %$biblioitem };
1435 }
1436
1437 =head3 to_api_mapping
1438
1439 This method returns the mapping for representing a Koha::Biblio object
1440 on the API.
1441
1442 =cut
1443
1444 sub to_api_mapping {
1445     return {
1446         biblionumber     => 'biblio_id',
1447         frameworkcode    => 'framework_id',
1448         unititle         => 'uniform_title',
1449         seriestitle      => 'series_title',
1450         copyrightdate    => 'copyright_date',
1451         datecreated      => 'creation_date',
1452         deleted_on       => undef,
1453     };
1454 }
1455
1456 =head3 get_marc_host
1457
1458     $host = $biblio->get_marc_host;
1459     # OR:
1460     ( $host, $relatedparts, $hostinfo ) = $biblio->get_marc_host;
1461
1462     Returns host biblio record from MARC21 773 (undef if no 773 present).
1463     It looks at the first 773 field with MARCorgCode or only a control
1464     number. Complete $w or numeric part is used to search host record.
1465     The optional parameter no_items triggers a check if $biblio has items.
1466     If there are, the sub returns undef.
1467     Called in list context, it also returns 773$g (related parts).
1468
1469     If there is no $w, we use $0 (host biblionumber) or $9 (host itemnumber)
1470     to search for the host record. If there is also no $0 and no $9, we search
1471     using author and title. Failing all of that, we return an undef host and
1472     form a concatenation of strings with 773$agt for host information,
1473     returned when called in list context.
1474
1475 =cut
1476
1477 sub get_marc_host {
1478     my ($self, $params) = @_;
1479     my $no_items = $params->{no_items};
1480     return if C4::Context->preference('marcflavour') eq 'UNIMARC'; # TODO
1481     return if $params->{no_items} && $self->items->count > 0;
1482
1483     my $record;
1484     eval { $record = $self->metadata->record };
1485     return if !$record;
1486
1487     # We pick the first $w with your MARCOrgCode or the first $w that has no
1488     # code (between parentheses) at all.
1489     my $orgcode = C4::Context->preference('MARCOrgCode') // q{};
1490     my $hostfld;
1491     foreach my $f ( $record->field('773') ) {
1492         my $w = $f->subfield('w') or next;
1493         if( $w =~ /^\($orgcode\)\s*(\d+)/i or $w =~ /^\d+/ ) {
1494             $hostfld = $f;
1495             last;
1496         }
1497     }
1498
1499     my $engine = Koha::SearchEngine::Search->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
1500     my $bibno;
1501     if ( !$hostfld and $record->subfield('773','t') ) {
1502         # not linked using $w
1503         my $unlinkedf = $record->field('773');
1504         my $host;
1505         if ( C4::Context->preference("EasyAnalyticalRecords") ) {
1506             if ( $unlinkedf->subfield('0') ) {
1507                 # use 773$0 host biblionumber
1508                 $bibno = $unlinkedf->subfield('0');
1509             } elsif ( $unlinkedf->subfield('9') ) {
1510                 # use 773$9 host itemnumber
1511                 my $linkeditemnumber = $unlinkedf->subfield('9');
1512                 $bibno = Koha::Items->find( $linkeditemnumber )->biblionumber;
1513             }
1514         }
1515         if ( $bibno ) {
1516             my $host = Koha::Biblios->find($bibno) or return;
1517             return wantarray ? ( $host, $unlinkedf->subfield('g') ) : $host;
1518         }
1519         # just return plaintext and no host record
1520         my $hostinfo = join( ", ", $unlinkedf->subfield('a'), $unlinkedf->subfield('t'), $unlinkedf->subfield('g') );
1521         return wantarray ? ( undef, $unlinkedf->subfield('g'), $hostinfo ) : undef;
1522     }
1523     return if !$hostfld;
1524     my $rcn = $hostfld->subfield('w');
1525
1526     # Look for control number with/without orgcode
1527     for my $try (1..2) {
1528         my ( $error, $results, $total_hits ) = $engine->simple_search_compat( 'Control-number='.$rcn, 0,1 );
1529         if( !$error and $total_hits == 1 ) {
1530             $bibno = $engine->extract_biblionumber( $results->[0] );
1531             last;
1532         }
1533         # Add or remove orgcode for second try
1534         if( $try == 1 && $rcn =~ /\)\s*(\d+)/ ) {
1535             $rcn = $1; # number only
1536         } elsif( $try == 1 && $rcn =~ /^\d+/ ) {
1537             $rcn = "($orgcode)$rcn";
1538         } else {
1539             last;
1540         }
1541     }
1542     if( $bibno ) {
1543         my $host = Koha::Biblios->find($bibno) or return;
1544         return wantarray ? ( $host, $hostfld->subfield('g') ) : $host;
1545     }
1546 }
1547
1548 =head3 get_marc_host_only
1549
1550     my $host = $biblio->get_marc_host_only;
1551
1552 Return host only
1553
1554 =cut
1555
1556 sub get_marc_host_only {
1557     my ($self) = @_;
1558
1559     my ( $host ) = $self->get_marc_host;
1560
1561     return $host;
1562 }
1563
1564 =head3 get_marc_relatedparts_only
1565
1566     my $relatedparts = $biblio->get_marc_relatedparts_only;
1567
1568 Return related parts only
1569
1570 =cut
1571
1572 sub get_marc_relatedparts_only {
1573     my ($self) = @_;
1574
1575     my ( undef, $relatedparts ) = $self->get_marc_host;
1576
1577     return $relatedparts;
1578 }
1579
1580 =head3 get_marc_hostinfo_only
1581
1582     my $hostinfo = $biblio->get_marc_hostinfo_only;
1583
1584 Return host info only
1585
1586 =cut
1587
1588 sub get_marc_hostinfo_only {
1589     my ($self) = @_;
1590
1591     my ( $host, $relatedparts, $hostinfo ) = $self->get_marc_host;
1592
1593     return $hostinfo;
1594 }
1595
1596 =head3 recalls
1597
1598     my $recalls = $biblio->recalls;
1599
1600 Return recalls linked to this biblio
1601
1602 =cut
1603
1604 sub recalls {
1605     my ( $self ) = @_;
1606     return Koha::Recalls->_new_from_dbic( scalar $self->_result->recalls );
1607 }
1608
1609 =head3 can_be_recalled
1610
1611     my @items_for_recall = $biblio->can_be_recalled({ patron => $patron_object });
1612
1613 Does biblio-level checks and returns the items attached to this biblio that are available for recall
1614
1615 =cut
1616
1617 sub can_be_recalled {
1618     my ( $self, $params ) = @_;
1619
1620     return 0 if !( C4::Context->preference('UseRecalls') );
1621
1622     my $patron = $params->{patron};
1623
1624     my $branchcode = C4::Context->userenv->{'branch'};
1625     if ( C4::Context->preference('CircControl') eq 'PatronLibrary' and $patron ) {
1626         $branchcode = $patron->branchcode;
1627     }
1628
1629     my @all_items = Koha::Items->search({ biblionumber => $self->biblionumber })->as_list;
1630
1631     # if there are no available items at all, no recall can be placed
1632     return 0 if ( scalar @all_items == 0 );
1633
1634     my @itemtypes;
1635     my @itemnumbers;
1636     my @items;
1637     my @all_itemnumbers;
1638     foreach my $item ( @all_items ) {
1639         push( @all_itemnumbers, $item->itemnumber );
1640         if ( $item->can_be_recalled({ patron => $patron }) ) {
1641             push( @itemtypes, $item->effective_itemtype );
1642             push( @itemnumbers, $item->itemnumber );
1643             push( @items, $item );
1644         }
1645     }
1646
1647     # if there are no recallable items, no recall can be placed
1648     return 0 if ( scalar @items == 0 );
1649
1650     # Check the circulation rule for each relevant itemtype for this biblio
1651     my ( @recalls_allowed, @recalls_per_record, @on_shelf_recalls );
1652     foreach my $itemtype ( @itemtypes ) {
1653         my $rule = Koha::CirculationRules->get_effective_rules({
1654             branchcode => $branchcode,
1655             categorycode => $patron ? $patron->categorycode : undef,
1656             itemtype => $itemtype,
1657             rules => [
1658                 'recalls_allowed',
1659                 'recalls_per_record',
1660                 'on_shelf_recalls',
1661             ],
1662         });
1663         push( @recalls_allowed, $rule->{recalls_allowed} ) if $rule;
1664         push( @recalls_per_record, $rule->{recalls_per_record} ) if $rule;
1665         push( @on_shelf_recalls, $rule->{on_shelf_recalls} ) if $rule;
1666     }
1667     my $recalls_allowed = (sort {$b <=> $a} @recalls_allowed)[0]; # take highest
1668     my $recalls_per_record = (sort {$b <=> $a} @recalls_per_record)[0]; # take highest
1669     my %on_shelf_recalls_count = ();
1670     foreach my $count ( @on_shelf_recalls ) {
1671         $on_shelf_recalls_count{$count}++;
1672     }
1673     my $on_shelf_recalls = (sort {$on_shelf_recalls_count{$b} <=> $on_shelf_recalls_count{$a}} @on_shelf_recalls)[0]; # take most common
1674
1675     # check recalls allowed has been set and is not zero
1676     return 0 if ( !defined($recalls_allowed) || $recalls_allowed == 0 );
1677
1678     if ( $patron ) {
1679         # check borrower has not reached open recalls allowed limit
1680         return 0 if ( $patron->recalls->filter_by_current->count >= $recalls_allowed );
1681
1682         # check borrower has not reached open recalls allowed per record limit
1683         return 0 if ( $patron->recalls->filter_by_current->search({ biblio_id => $self->biblionumber })->count >= $recalls_per_record );
1684
1685         # check if any of the items under this biblio are already checked out by this borrower
1686         return 0 if ( Koha::Checkouts->search({ itemnumber => [ @all_itemnumbers ], borrowernumber => $patron->borrowernumber })->count > 0 );
1687     }
1688
1689     # check item availability
1690     my $checked_out_count = 0;
1691     foreach (@items) {
1692         if ( Koha::Checkouts->search({ itemnumber => $_->itemnumber })->count > 0 ){ $checked_out_count++; }
1693     }
1694
1695     # can't recall if on shelf recalls only allowed when all unavailable, but items are still available for checkout
1696     return 0 if ( $on_shelf_recalls eq 'all' && $checked_out_count < scalar @items );
1697
1698     # can't recall if no items have been checked out
1699     return 0 if ( $checked_out_count == 0 );
1700
1701     # can recall
1702     return @items;
1703 }
1704
1705 =head3 ratings
1706
1707     my $ratings = $biblio->ratings
1708
1709 Return a Koha::Ratings object representing the ratings of this bibliographic record
1710
1711 =cut
1712
1713 sub ratings {
1714     my ( $self ) = @_;
1715     my $rs = $self->_result->ratings;
1716     return Koha::Ratings->_new_from_dbic($rs);
1717 }
1718
1719 =head3 opac_summary_html
1720
1721     my $summary_html = $biblio->opac_summary_html
1722
1723 Based on the syspref OPACMySummaryHTML, returns a string representing the
1724 summary of this bibliographic record.
1725 {AUTHOR}, {TITLE}, {ISBN} and {BIBLIONUMBER} will be replaced.
1726
1727 =cut
1728
1729 sub opac_summary_html {
1730     my ($self) = @_;
1731
1732     my $summary_html = C4::Context->preference('OPACMySummaryHTML');
1733     return q{} unless $summary_html;
1734     my $author = $self->author || q{};
1735     my $title  = $self->title  || q{};
1736     $title =~ s/\/+$//;    # remove trailing slash
1737     $title =~ s/\s+$//;    # remove trailing space
1738     my $normalized_isbn = $self->normalized_isbn || q{};
1739     my $biblionumber    = $self->biblionumber;
1740
1741     $summary_html =~ s/{AUTHOR}/$author/g;
1742     $summary_html =~ s/{TITLE}/$title/g;
1743     $summary_html =~ s/{ISBN}/$normalized_isbn/g;
1744     $summary_html =~ s/{BIBLIONUMBER}/$biblionumber/g;
1745
1746     return $summary_html;
1747 }
1748
1749 =head2 Internal methods
1750
1751 =head3 type
1752
1753 =cut
1754
1755 sub _type {
1756     return 'Biblio';
1757 }
1758
1759 =head1 AUTHOR
1760
1761 Kyle M Hall <kyle@bywatersolutions.com>
1762
1763 =cut
1764
1765 1;