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