Bug 15395: Make QA test script happy
[koha.git] / Koha / Biblio.pm
blob1dca4d9cf68c20f13bbbc9772078a218ed40ff20
1 package Koha::Biblio;
3 # Copyright ByWater Solutions 2014
5 # This file is part of Koha.
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.
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.
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.
20 use Modern::Perl;
22 use Carp;
24 use C4::Biblio qw();
26 use Koha::Database;
27 use Koha::DateUtils qw( dt_from_string );
29 use base qw(Koha::Object);
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;
40 =head1 NAME
42 Koha::Biblio - Koha Biblio Object class
44 =head1 API
46 =head2 Class Methods
48 =cut
50 =head3 store
52 Overloaded I<store> method to set default values
54 =cut
56 sub store {
57 my ( $self ) = @_;
59 $self->datecreated( dt_from_string ) unless $self->datecreated;
61 return $self->SUPER::store;
64 =head3 subtitles
66 my @subtitles = $biblio->subtitles();
68 Returns list of subtitles for a record.
70 Keyword to MARC mapping for subtitle must be set for this method to return any possible values.
72 =cut
74 sub subtitles {
75 my ( $self ) = @_;
77 return map { $_->{subfield} } @{
78 C4::Biblio::GetRecordValue(
79 'subtitle',
80 C4::Biblio::GetMarcBiblio({ biblionumber => $self->id }),
81 $self->frameworkcode ) };
84 =head3 can_article_request
86 my $bool = $biblio->can_article_request( $borrower );
88 Returns true if article requests can be made for this record
90 $borrower must be a Koha::Patron object
92 =cut
94 sub can_article_request {
95 my ( $self, $borrower ) = @_;
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';
101 return q{};
104 =head3 can_be_transferred
106 $biblio->can_be_transferred({ to => $to_library, from => $from_library })
108 Checks if at least one item of a biblio can be transferred to given library.
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
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().
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
125 Returns 1 if at least one of the item of a biblio can be transferred
126 to $to_library, otherwise 0.
128 =cut
130 sub can_be_transferred {
131 my ($self, $params) = @_;
133 my $to = $params->{to};
134 my $from = $params->{from};
136 return 1 unless C4::Context->preference('UseBranchTransferLimits');
137 my $limittype = C4::Context->preference('BranchTransferLimitsType');
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;
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;
169 return 0;
172 =head3 article_request_type
174 my $type = $biblio->article_request_type( $borrower );
176 Returns the article request type based on items, or on the record
177 itself if there are no items.
179 $borrower must be a Koha::Patron object
181 =cut
183 sub article_request_type {
184 my ( $self, $borrower ) = @_;
186 return q{} unless $borrower;
188 my $rule = $self->article_request_type_for_items( $borrower );
189 return $rule if $rule;
191 # If the record has no items that are requestable, go by the record itemtype
192 $rule = $self->article_request_type_for_bib($borrower);
193 return $rule if $rule;
195 return q{};
198 =head3 article_request_type_for_bib
200 my $type = $biblio->article_request_type_for_bib
202 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record
204 =cut
206 sub article_request_type_for_bib {
207 my ( $self, $borrower ) = @_;
209 return q{} unless $borrower;
211 my $borrowertype = $borrower->categorycode;
212 my $itemtype = $self->itemtype();
214 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule({ categorycode => $borrowertype, itemtype => $itemtype });
216 return q{} unless $issuing_rule;
217 return $issuing_rule->article_requests || q{}
220 =head3 article_request_type_for_items
222 my $type = $biblio->article_request_type_for_items
224 Returns the article request type 'yes', 'no', 'item_only', 'bib_only', for the given record's items
226 If there is a conflict where some items are 'bib_only' and some are 'item_only', 'bib_only' will be returned.
228 =cut
230 sub article_request_type_for_items {
231 my ( $self, $borrower ) = @_;
233 my $counts;
234 foreach my $item ( $self->items()->as_list() ) {
235 my $rule = $item->article_request_type($borrower);
236 return $rule if $rule eq 'bib_only'; # we don't need to go any further
237 $counts->{$rule}++;
240 return 'item_only' if $counts->{item_only};
241 return 'yes' if $counts->{yes};
242 return 'no' if $counts->{no};
243 return q{};
246 =head3 article_requests
248 my @requests = $biblio->article_requests
250 Returns the article requests associated with this Biblio
252 =cut
254 sub article_requests {
255 my ( $self, $borrower ) = @_;
257 $self->{_article_requests} ||= Koha::ArticleRequests->search( { biblionumber => $self->biblionumber() } );
259 return wantarray ? $self->{_article_requests}->as_list : $self->{_article_requests};
262 =head3 article_requests_current
264 my @requests = $biblio->article_requests_current
266 Returns the article requests associated with this Biblio that are incomplete
268 =cut
270 sub article_requests_current {
271 my ( $self, $borrower ) = @_;
273 $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
275 biblionumber => $self->biblionumber(),
276 -or => [
277 { status => Koha::ArticleRequest::Status::Pending },
278 { status => Koha::ArticleRequest::Status::Processing }
283 return wantarray ? $self->{_article_requests_current}->as_list : $self->{_article_requests_current};
286 =head3 article_requests_finished
288 my @requests = $biblio->article_requests_finished
290 Returns the article requests associated with this Biblio that are completed
292 =cut
294 sub article_requests_finished {
295 my ( $self, $borrower ) = @_;
297 $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
299 biblionumber => $self->biblionumber(),
300 -or => [
301 { status => Koha::ArticleRequest::Status::Completed },
302 { status => Koha::ArticleRequest::Status::Canceled }
307 return wantarray ? $self->{_article_requests_finished}->as_list : $self->{_article_requests_finished};
310 =head3 items
312 my @items = $biblio->items();
313 my $items = $biblio->items();
315 Returns the related Koha::Items object for this biblio in scalar context,
316 or list of Koha::Item objects in list context.
318 =cut
320 sub items {
321 my ($self) = @_;
323 $self->{_items} ||= Koha::Items->search( { biblionumber => $self->biblionumber() } );
325 return wantarray ? $self->{_items}->as_list : $self->{_items};
328 =head3 itemtype
330 my $itemtype = $biblio->itemtype();
332 Returns the itemtype for this record.
334 =cut
336 sub itemtype {
337 my ( $self ) = @_;
339 return $self->biblioitem()->itemtype();
342 =head3 holds
344 my $holds = $biblio->holds();
346 return the current holds placed on this record
348 =cut
350 sub holds {
351 my ( $self, $params, $attributes ) = @_;
352 $attributes->{order_by} = 'priority' unless exists $attributes->{order_by};
353 my $hold_rs = $self->_result->reserves->search( $params, $attributes );
354 return Koha::Holds->_new_from_dbic($hold_rs);
357 =head3 current_holds
359 my $holds = $biblio->current_holds
361 Return the holds placed on this bibliographic record.
362 It does not include future holds.
364 =cut
366 sub current_holds {
367 my ($self) = @_;
368 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
369 return $self->holds(
370 { reservedate => { '<=' => $dtf->format_date(dt_from_string) } } );
373 =head3 biblioitem
375 my $field = $self->biblioitem()->itemtype
377 Returns the related Koha::Biblioitem object for this Biblio object
379 =cut
381 sub biblioitem {
382 my ($self) = @_;
384 $self->{_biblioitem} ||= Koha::Biblioitems->find( { biblionumber => $self->biblionumber() } );
386 return $self->{_biblioitem};
389 =head3 subscriptions
391 my $subscriptions = $self->subscriptions
393 Returns the related Koha::Subscriptions object for this Biblio object
395 =cut
397 sub subscriptions {
398 my ($self) = @_;
400 $self->{_subscriptions} ||= Koha::Subscriptions->search( { biblionumber => $self->biblionumber } );
402 return $self->{_subscriptions};
405 =head3 has_items_waiting_or_intransit
407 my $itemsWaitingOrInTransit = $biblio->has_items_waiting_or_intransit
409 Tells if this bibliographic record has items waiting or in transit.
411 =cut
413 sub has_items_waiting_or_intransit {
414 my ( $self ) = @_;
416 if ( Koha::Holds->search({ biblionumber => $self->id,
417 found => ['W', 'T'] })->count ) {
418 return 1;
421 foreach my $item ( $self->items ) {
422 return 1 if $item->get_transfer;
425 return 0;
428 =head3 type
430 =cut
432 sub _type {
433 return 'Biblio';
436 =head1 AUTHOR
438 Kyle M Hall <kyle@bywatersolutions.com>
440 =cut