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