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 under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 3 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 use Modern::Perl;
  21
  22 use Carp;
  23 use List::MoreUtils qw(any);
  24
  25 use C4::Biblio qw();
  26
  27 use Koha::Database;
  28 use Koha::DateUtils qw( dt_from_string );
  29
  30 use base qw(Koha::Object);
  31
  32 use Koha::ArticleRequest::Status;
  33 use Koha::ArticleRequests;
  34 use Koha::Biblio::Metadatas;
  35 use Koha::Biblioitems;
  36 use Koha::IssuingRules;
  37 use Koha::Item::Transfer::Limits;
  38 use Koha::Items;
  39 use Koha::Libraries;
  40 use Koha::Subscriptions;
  41
  42 =head1 NAME
  43
  44 Koha::Biblio - Koha Biblio Object class
  45
  46 =head1 API
  47
  48 =head2 Class Methods
  49
  50 =cut
  51
  52 =head3 store
  53
  54 Overloaded I<store> method to set default values
  55
  56 =cut
  57
  58 sub store {
  59     my ( $self ) = @_;
  60
  61     $self->datecreated( dt_from_string ) unless $self->datecreated;
  62
  63     return $self->SUPER::store;
  64 }
  65
  66 =head3 metadata
  67
  68 my $metadata = $biblio->metadata();
  69
  70 Returns a Koha::Biblio::Metadata object
  71
  72 =cut
  73
  74 sub metadata {
  75     my ( $self ) = @_;
  76
  77     $self->{_metadata} ||= Koha::Biblio::Metadatas->find( { biblionumber => $self->id } );
  78
  79     return $self->{_metadata};
  80 }
  81
  82 =head3 subtitles
  83
  84 my @subtitles = $biblio->subtitles();
  85
  86 Returns list of subtitles for a record.
  87
  88 Keyword to MARC mapping for subtitle must be set for this method to return any possible values.
  89
  90 =cut
  91
  92 sub subtitles {
  93     my ( $self ) = @_;
  94
  95     return map { $_->{subfield} } @{
  96         C4::Biblio::GetRecordValue(
  97             'subtitle',
  98             C4::Biblio::GetMarcBiblio({ biblionumber => $self->id }),
  99             $self->frameworkcode ) };
 100 }
 101
 102 =head3 can_article_request
 103
 104 my $bool = $biblio->can_article_request( $borrower );
 105
 106 Returns true if article requests can be made for this record
 107
 108 $borrower must be a Koha::Patron object
 109
 110 =cut
 111
 112 sub can_article_request {
 113     my ( $self, $borrower ) = @_;
 114
 115     my $rule = $self->article_request_type($borrower);
 116     return q{} if $rule eq 'item_only' && !$self->items()->count();
 117     return 1 if $rule && $rule ne 'no';
 118
 119     return q{};
 120 }
 121
 122 =head3 can_be_transferred
 123
 124 $biblio->can_be_transferred({ to => $to_library, from => $from_library })
 125
 126 Checks if at least one item of a biblio can be transferred to given library.
 127
 128 This feature is controlled by two system preferences:
 129 UseBranchTransferLimits to enable / disable the feature
 130 BranchTransferLimitsType to use either an itemnumber or ccode as an identifier
 131                          for setting the limitations
 132
 133 Performance-wise, it is recommended to use this method for a biblio instead of
 134 iterating each item of a biblio with Koha::Item->can_be_transferred().
 135
 136 Takes HASHref that can have the following parameters:
 137     MANDATORY PARAMETERS:
 138     $to   : Koha::Library
 139     OPTIONAL PARAMETERS:
 140     $from : Koha::Library # if given, only items from that
 141                           # holdingbranch are considered
 142
 143 Returns 1 if at least one of the item of a biblio can be transferred
 144 to $to_library, otherwise 0.
 145
 146 =cut
 147
 148 sub can_be_transferred {
 149     my ($self, $params) = @_;
 150
 151     my $to   = $params->{to};
 152     my $from = $params->{from};
 153
 154     return 1 unless C4::Context->preference('UseBranchTransferLimits');
 155     my $limittype = C4::Context->preference('BranchTransferLimitsType');
 156
 157     my $items;
 158     foreach my $item_of_bib ($self->items) {
 159         next unless $item_of_bib->holdingbranch;
 160         next if $from && $from->branchcode ne $item_of_bib->holdingbranch;
 161         return 1 if $item_of_bib->holdingbranch eq $to->branchcode;
 162         my $code = $limittype eq 'itemtype'
 163             ? $item_of_bib->effective_itemtype
 164             : $item_of_bib->ccode;
 165         return 1 unless $code;
 166         $items->{$code}->{$item_of_bib->holdingbranch} = 1;
 167     }
 168
 169     # At this point we will have a HASHref containing each itemtype/ccode that
 170     # this biblio has, inside which are all of the holdingbranches where those
 171     # items are located at. Then, we will query Koha::Item::Transfer::Limits to
 172     # find out whether a transfer limits for such $limittype from any of the
 173     # listed holdingbranches to the given $to library exist. If at least one
 174     # holdingbranch for that $limittype does not have a transfer limit to given
 175     # $to library, then we know that the transfer is possible.
 176     foreach my $code (keys %{$items}) {
 177         my @holdingbranches = keys %{$items->{$code}};
 178         return 1 if Koha::Item::Transfer::Limits->search({
 179             toBranch => $to->branchcode,
 180             fromBranch => { 'in' => \@holdingbranches },
 181             $limittype => $code
 182         }, {
 183             group_by => [qw/fromBranch/]
 184         })->count == scalar(@holdingbranches) ? 0 : 1;
 185     }
 186
 187     return 0;
 188 }
 189
 190 =head3 hidden_in_opac
 191
 192 my $bool = $biblio->hidden_in_opac({ [ rules => $rules ] })
 193
 194 Returns true if the biblio matches the hidding criteria defined in $rules.
 195 Returns false otherwise.
 196
 197 Takes HASHref that can have the following parameters:
 198     OPTIONAL PARAMETERS:
 199     $rules : { <field> => [ value_1, ... ], ... }
 200
 201 Note: $rules inherits its structure from the parsed YAML from reading
 202 the I<OpacHiddenItems> system preference.
 203
 204 =cut
 205
 206 sub hidden_in_opac {
 207     my ( $self, $params ) = @_;
 208
 209     my $rules = $params->{rules} // {};
 210
 211     return !(any { !$_->hidden_in_opac({ rules => $rules }) } $self->items);
 212 }
 213
 214 =head3 article_request_type
 215
 216 my $type = $biblio->article_request_type( $borrower );
 217
 218 Returns the article request type based on items, or on the record
 219 itself if there are no items.
 220
 221 $borrower must be a Koha::Patron object
 222
 223 =cut
 224
 225 sub article_request_type {
 226     my ( $self, $borrower ) = @_;
 227
 228     return q{} unless $borrower;
 229
 230     my $rule = $self->article_request_type_for_items( $borrower );
 231     return $rule if $rule;
 232
 233     # If the record has no items that are requestable, go by the record itemtype
 234     $rule = $self->article_request_type_for_bib($borrower);
 235     return $rule if $rule;
 236
 237     return q{};
 238 }
 239
 240 =head3 article_request_type_for_bib
 241
 242 my $type = $biblio->article_request_type_for_bib
 243
 244 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record
 245
 246 =cut
 247
 248 sub article_request_type_for_bib {
 249     my ( $self, $borrower ) = @_;
 250
 251     return q{} unless $borrower;
 252
 253     my $borrowertype = $borrower->categorycode;
 254     my $itemtype     = $self->itemtype();
 255
 256     my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule({ categorycode => $borrowertype, itemtype => $itemtype });
 257
 258     return q{} unless $issuing_rule;
 259     return $issuing_rule->article_requests || q{}
 260 }
 261
 262 =head3 article_request_type_for_items
 263
 264 my $type = $biblio->article_request_type_for_items
 265
 266 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record's items
 267
 268 If there is a conflict where some items are 'bib_only' and some are 'item_only', 'bib_only' will be returned.
 269
 270 =cut
 271
 272 sub article_request_type_for_items {
 273     my ( $self, $borrower ) = @_;
 274
 275     my $counts;
 276     foreach my $item ( $self->items()->as_list() ) {
 277         my $rule = $item->article_request_type($borrower);
 278         return $rule if $rule eq 'bib_only';    # we don't need to go any further
 279         $counts->{$rule}++;
 280     }
 281
 282     return 'item_only' if $counts->{item_only};
 283     return 'yes'       if $counts->{yes};
 284     return 'no'        if $counts->{no};
 285     return q{};
 286 }
 287
 288 =head3 article_requests
 289
 290 my @requests = $biblio->article_requests
 291
 292 Returns the article requests associated with this Biblio
 293
 294 =cut
 295
 296 sub article_requests {
 297     my ( $self, $borrower ) = @_;
 298
 299     $self->{_article_requests} ||= Koha::ArticleRequests->search( { biblionumber => $self->biblionumber() } );
 300
 301     return wantarray ? $self->{_article_requests}->as_list : $self->{_article_requests};
 302 }
 303
 304 =head3 article_requests_current
 305
 306 my @requests = $biblio->article_requests_current
 307
 308 Returns the article requests associated with this Biblio that are incomplete
 309
 310 =cut
 311
 312 sub article_requests_current {
 313     my ( $self, $borrower ) = @_;
 314
 315     $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
 316         {
 317             biblionumber => $self->biblionumber(),
 318             -or          => [
 319                 { status => Koha::ArticleRequest::Status::Pending },
 320                 { status => Koha::ArticleRequest::Status::Processing }
 321             ]
 322         }
 323     );
 324
 325     return wantarray ? $self->{_article_requests_current}->as_list : $self->{_article_requests_current};
 326 }
 327
 328 =head3 article_requests_finished
 329
 330 my @requests = $biblio->article_requests_finished
 331
 332 Returns the article requests associated with this Biblio that are completed
 333
 334 =cut
 335
 336 sub article_requests_finished {
 337     my ( $self, $borrower ) = @_;
 338
 339     $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
 340         {
 341             biblionumber => $self->biblionumber(),
 342             -or          => [
 343                 { status => Koha::ArticleRequest::Status::Completed },
 344                 { status => Koha::ArticleRequest::Status::Canceled }
 345             ]
 346         }
 347     );
 348
 349     return wantarray ? $self->{_article_requests_finished}->as_list : $self->{_article_requests_finished};
 350 }
 351
 352 =head3 items
 353
 354 my @items = $biblio->items();
 355 my $items = $biblio->items();
 356
 357 Returns the related Koha::Items object for this biblio in scalar context,
 358 or list of Koha::Item objects in list context.
 359
 360 =cut
 361
 362 sub items {
 363     my ($self) = @_;
 364
 365     $self->{_items} ||= Koha::Items->search( { biblionumber => $self->biblionumber() } );
 366
 367     return wantarray ? $self->{_items}->as_list : $self->{_items};
 368 }
 369
 370 =head3 itemtype
 371
 372 my $itemtype = $biblio->itemtype();
 373
 374 Returns the itemtype for this record.
 375
 376 =cut
 377
 378 sub itemtype {
 379     my ( $self ) = @_;
 380
 381     return $self->biblioitem()->itemtype();
 382 }
 383
 384 =head3 holds
 385
 386 my $holds = $biblio->holds();
 387
 388 return the current holds placed on this record
 389
 390 =cut
 391
 392 sub holds {
 393     my ( $self, $params, $attributes ) = @_;
 394     $attributes->{order_by} = 'priority' unless exists $attributes->{order_by};
 395     my $hold_rs = $self->_result->reserves->search( $params, $attributes );
 396     return Koha::Holds->_new_from_dbic($hold_rs);
 397 }
 398
 399 =head3 current_holds
 400
 401 my $holds = $biblio->current_holds
 402
 403 Return the holds placed on this bibliographic record.
 404 It does not include future holds.
 405
 406 =cut
 407
 408 sub current_holds {
 409     my ($self) = @_;
 410     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 411     return $self->holds(
 412         { reservedate => { '<=' => $dtf->format_date(dt_from_string) } } );
 413 }
 414
 415 =head3 biblioitem
 416
 417 my $field = $self->biblioitem()->itemtype
 418
 419 Returns the related Koha::Biblioitem object for this Biblio object
 420
 421 =cut
 422
 423 sub biblioitem {
 424     my ($self) = @_;
 425
 426     $self->{_biblioitem} ||= Koha::Biblioitems->find( { biblionumber => $self->biblionumber() } );
 427
 428     return $self->{_biblioitem};
 429 }
 430
 431 =head3 subscriptions
 432
 433 my $subscriptions = $self->subscriptions
 434
 435 Returns the related Koha::Subscriptions object for this Biblio object
 436
 437 =cut
 438
 439 sub subscriptions {
 440     my ($self) = @_;
 441
 442     $self->{_subscriptions} ||= Koha::Subscriptions->search( { biblionumber => $self->biblionumber } );
 443
 444     return $self->{_subscriptions};
 445 }
 446
 447 =head3 has_items_waiting_or_intransit
 448
 449 my $itemsWaitingOrInTransit = $biblio->has_items_waiting_or_intransit
 450
 451 Tells if this bibliographic record has items waiting or in transit.
 452
 453 =cut
 454
 455 sub has_items_waiting_or_intransit {
 456     my ( $self ) = @_;
 457
 458     if ( Koha::Holds->search({ biblionumber => $self->id,
 459                                found => ['W', 'T'] })->count ) {
 460         return 1;
 461     }
 462
 463     foreach my $item ( $self->items ) {
 464         return 1 if $item->get_transfer;
 465     }
 466
 467     return 0;
 468 }
 469
 470 =head3 type
 471
 472 =cut
 473
 474 sub _type {
 475     return 'Biblio';
 476 }
 477
 478 =head1 AUTHOR
 479
 480 Kyle M Hall <kyle@bywatersolutions.com>
 481
 482 =cut
 483
 484 1;