Bug 30362: Fix GetSoonestRenewDate to really return soonest renew date
[koha.git] / C4 / Circulation.pm
1 package C4::Circulation;
2
3 # Copyright 2000-2002 Katipo Communications
4 # copyright 2010 BibLibre
5 #
6 # This file is part of Koha.
7 #
8 # Koha is free software; you can redistribute it and/or modify it
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
12 #
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
17 #
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
20
21 use Modern::Perl;
22 use DateTime;
23 use POSIX qw( floor );
24 use YAML::XS;
25 use Encode;
26
27 use C4::Context;
28 use C4::Stats qw( UpdateStats );
29 use C4::Reserves qw( CheckReserves CanItemBeReserved MoveReserve ModReserve ModReserveMinusPriority RevertWaitingStatus IsItemOnHoldAndFound IsAvailableForItemLevelRequest );
30 use C4::Biblio qw( UpdateTotalIssues );
31 use C4::Items qw( ModItemTransfer ModDateLastSeen CartToShelf );
32 use C4::Accounts;
33 use C4::ItemCirculationAlertPreference;
34 use C4::Message;
35 use C4::Log qw( logaction ); # logaction
36 use C4::Overdues;
37 use C4::RotatingCollections qw(GetCollectionItemBranches);
38 use Algorithm::CheckDigits qw( CheckDigits );
39
40 use Data::Dumper qw( Dumper );
41 use Koha::Account;
42 use Koha::AuthorisedValues;
43 use Koha::BackgroundJob::BatchUpdateBiblioHoldsQueue;
44 use Koha::Biblioitems;
45 use Koha::DateUtils qw( dt_from_string );
46 use Koha::Calendar;
47 use Koha::Checkouts;
48 use Koha::Illrequests;
49 use Koha::Items;
50 use Koha::Patrons;
51 use Koha::Patron::Debarments qw( DelUniqueDebarment AddUniqueDebarment );
52 use Koha::Database;
53 use Koha::Libraries;
54 use Koha::Account::Lines;
55 use Koha::Holds;
56 use Koha::Account::Lines;
57 use Koha::Account::Offsets;
58 use Koha::Config::SysPrefs;
59 use Koha::Charges::Fees;
60 use Koha::Config::SysPref;
61 use Koha::Checkouts::ReturnClaims;
62 use Koha::SearchEngine::Indexer;
63 use Koha::Exceptions::Checkout;
64 use Koha::Plugins;
65 use Koha::Recalls;
66 use Carp qw( carp );
67 use List::MoreUtils qw( any );
68 use Scalar::Util qw( looks_like_number blessed );
69 use Date::Calc qw( Date_to_Days );
70 our (@ISA, @EXPORT_OK);
71 BEGIN {
72
73     require Exporter;
74     @ISA = qw(Exporter);
75
76     # FIXME subs that should probably be elsewhere
77     push @EXPORT_OK, qw(
78       barcodedecode
79       LostItem
80       ReturnLostItem
81       GetPendingOnSiteCheckouts
82
83       CanBookBeIssued
84       checkHighHolds
85       CanBookBeRenewed
86       AddIssue
87       GetLoanLength
88       GetHardDueDate
89       AddRenewal
90       GetRenewCount
91       GetSoonestRenewDate
92       GetLatestAutoRenewDate
93       GetIssuingCharges
94       AddIssuingCharge
95       GetBranchBorrowerCircRule
96       GetBranchItemRule
97       GetBiblioIssues
98       GetUpcomingDueIssues
99       CheckIfIssuedToPatron
100       IsItemIssued
101       GetAgeRestriction
102       GetTopIssues
103
104       AddReturn
105       MarkIssueReturned
106
107       transferbook
108       TooMany
109       GetTransfersFromTo
110       updateWrongTransfer
111       CalcDateDue
112       CheckValidBarcode
113       IsBranchTransferAllowed
114       CreateBranchTransferLimit
115       DeleteBranchTransferLimits
116       TransferSlip
117
118       GetOfflineOperations
119       GetOfflineOperation
120       AddOfflineOperation
121       DeleteOfflineOperation
122       ProcessOfflineOperation
123       ProcessOfflinePayment
124       ProcessOfflineIssue
125     );
126     push @EXPORT_OK, '_GetCircControlBranch';    # This is wrong!
127 }
128
129 =head1 NAME
130
131 C4::Circulation - Koha circulation module
132
133 =head1 SYNOPSIS
134
135 use C4::Circulation;
136
137 =head1 DESCRIPTION
138
139 The functions in this module deal with circulation, issues, and
140 returns, as well as general information about the library.
141 Also deals with inventory.
142
143 =head1 FUNCTIONS
144
145 =head2 barcodedecode
146
147   $str = &barcodedecode($barcode, [$filter]);
148
149 Generic filter function for barcode string.
150 Called on every circ if the System Pref itemBarcodeInputFilter is set.
151 Will do some manipulation of the barcode for systems that deliver a barcode
152 to circulation.pl that differs from the barcode stored for the item.
153 For proper functioning of this filter, calling the function on the 
154 correct barcode string (items.barcode) should return an unaltered barcode.
155 Barcode is going to be automatically trimmed of leading/trailing whitespaces.
156
157 The optional $filter argument is to allow for testing or explicit 
158 behavior that ignores the System Pref.  Valid values are the same as the 
159 System Pref options.
160
161 =cut
162
163 # FIXME -- the &decode fcn below should be wrapped into this one.
164 # FIXME -- these plugins should be moved out of Circulation.pm
165 #
166 sub barcodedecode {
167     my ($barcode, $filter) = @_;
168
169     return unless defined $barcode;
170
171     my $branch = C4::Context::mybranch();
172     $barcode =~ s/^\s+|\s+$//g;
173     $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter;
174     Koha::Plugins->call('item_barcode_transform',  \$barcode );
175     $filter or return $barcode;     # ensure filter is defined, else return untouched barcode
176         if ($filter eq 'whitespace') {
177                 $barcode =~ s/\s//g;
178         } elsif ($filter eq 'cuecat') {
179                 chomp($barcode);
180             my @fields = split( /\./, $barcode );
181             my @results = map( C4::Circulation::_decode($_), @fields[ 1 .. $#fields ] );
182             ($#results == 2) and return $results[2];
183         } elsif ($filter eq 'T-prefix') {
184                 if ($barcode =~ /^[Tt](\d)/) {
185                         (defined($1) and $1 eq '0') and return $barcode;
186             $barcode = substr($barcode, 2) + 0;     # FIXME: probably should be substr($barcode, 1)
187                 }
188         return sprintf("T%07d", $barcode);
189         # FIXME: $barcode could be "T1", causing warning: substr outside of string
190         # Why drop the nonzero digit after the T?
191         # Why pass non-digits (or empty string) to "T%07d"?
192         } elsif ($filter eq 'libsuite8') {
193                 unless($barcode =~ m/^($branch)-/i){    #if barcode starts with branch code its in Koha style. Skip it.
194                         if($barcode =~ m/^(\d)/i){      #Some barcodes even start with 0's & numbers and are assumed to have b as the item type in the libsuite8 software
195                                 $barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i;
196                         }else{
197                                 $barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i;
198                         }
199                 }
200     } elsif ($filter eq 'EAN13') {
201         my $ean = CheckDigits('ean');
202         if ( $ean->is_valid($barcode) ) {
203             #$barcode = sprintf('%013d',$barcode); # this doesn't work on 32-bit systems
204             $barcode = '0' x ( 13 - length($barcode) ) . $barcode;
205         } else {
206             warn "# [$barcode] not valid EAN-13/UPC-A\n";
207         }
208         }
209     return $barcode;    # return barcode, modified or not
210 }
211
212 =head2 _decode
213
214   $str = &_decode($chunk);
215
216 Decodes a segment of a string emitted by a CueCat barcode scanner and
217 returns it.
218
219 FIXME: Should be replaced with Barcode::Cuecat from CPAN
220 or Javascript based decoding on the client side.
221
222 =cut
223
224 sub _decode {
225     my ($encoded) = @_;
226     my $seq =
227       'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
228     my @s = map { index( $seq, $_ ); } split( //, $encoded );
229     my $l = ( $#s + 1 ) % 4;
230     if ($l) {
231         if ( $l == 1 ) {
232             # warn "Error: Cuecat decode parsing failed!";
233             return;
234         }
235         $l = 4 - $l;
236         $#s += $l;
237     }
238     my $r = '';
239     while ( $#s >= 0 ) {
240         my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
241         $r .=
242             chr( ( $n >> 16 ) ^ 67 )
243          .chr( ( $n >> 8 & 255 ) ^ 67 )
244          .chr( ( $n & 255 ) ^ 67 );
245         @s = @s[ 4 .. $#s ];
246     }
247     $r = substr( $r, 0, length($r) - $l );
248     return $r;
249 }
250
251 =head2 transferbook
252
253   ($dotransfer, $messages, $iteminformation) = &transferbook({
254                                                    from_branch => $frombranch
255                                                    to_branch => $tobranch,
256                                                    barcode => $barcode,
257                                                    ignore_reserves => $ignore_reserves,
258                                                    trigger => $trigger
259                                                 });
260
261 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
262
263 C<$fbr> is the code for the branch initiating the transfer.
264 C<$tbr> is the code for the branch to which the item should be transferred.
265
266 C<$barcode> is the barcode of the item to be transferred.
267
268 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
269 Otherwise, if an item is reserved, the transfer fails.
270
271 C<$trigger> is the enum value for what triggered the transfer.
272
273 Returns three values:
274
275 =over
276
277 =item $dotransfer 
278
279 is true if the transfer was successful.
280
281 =item $messages
282
283 is a reference-to-hash which may have any of the following keys:
284
285 =over
286
287 =item C<BadBarcode>
288
289 There is no item in the catalog with the given barcode. The value is C<$barcode>.
290
291 =item C<DestinationEqualsHolding>
292
293 The item is already at the branch to which it is being transferred. The transfer is nonetheless considered to have failed. The value should be ignored.
294
295 =item C<WasReturned>
296
297 The item was on loan, and C<&transferbook> automatically returned it before transferring it. The value is the borrower number of the patron who had the item.
298
299 =item C<ResFound>
300
301 The item was reserved. The value is a reference-to-hash whose keys are fields from the reserves table of the Koha database, and C<biblioitemnumber>. It also has the key C<ResFound>, whose value is either C<Waiting> or C<Reserved>.
302
303 =item C<WasTransferred>
304
305 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
306
307 =item C<RecallPlacedAtHoldingBranch>
308
309 A recall for this item was found, and the transfer has already been completed as the item's branch matches the recall's pickup branch.
310
311 =item C<RecallFound>
312
313 A recall for this item was found, and the item needs to be transferred to the recall's pickup branch.
314
315 =back
316
317 =back
318
319 =cut
320
321 sub transferbook {
322     my $params = shift;
323     my $tbr      = $params->{to_branch};
324     my $fbr      = $params->{from_branch};
325     my $ignoreRs = $params->{ignore_reserves};
326     my $barcode  = $params->{barcode};
327     my $trigger  = $params->{trigger};
328     my $messages;
329     my $dotransfer      = 1;
330     my $item = Koha::Items->find( { barcode => $barcode } );
331
332     Koha::Exceptions::MissingParameter->throw(
333         "Missing mandatory parameter: from_branch")
334       unless $fbr;
335
336     Koha::Exceptions::MissingParameter->throw(
337         "Missing mandatory parameter: to_branch")
338       unless $tbr;
339
340     # bad barcode..
341     unless ( $item ) {
342         $messages->{'BadBarcode'} = $barcode;
343         $dotransfer = 0;
344         return ( $dotransfer, $messages );
345     }
346
347     my $itemnumber = $item->itemnumber;
348     # get branches of book...
349     my $hbr = $item->homebranch;
350
351     # if using Branch Transfer Limits
352     if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
353         my $code = C4::Context->preference("BranchTransferLimitsType") eq 'ccode' ? $item->ccode : $item->biblio->biblioitem->itemtype; # BranchTransferLimitsType is 'ccode' or 'itemtype'
354         if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
355             if ( ! IsBranchTransferAllowed( $tbr, $fbr, $item->itype ) ) {
356                 $messages->{'NotAllowed'} = $tbr . "::" . $item->itype;
357                 $dotransfer = 0;
358             }
359         } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $code ) ) {
360             $messages->{'NotAllowed'} = $tbr . "::" . $code;
361             $dotransfer = 0;
362         }
363     }
364
365     # can't transfer book if is already there....
366     if ( $fbr eq $tbr ) {
367         $messages->{'DestinationEqualsHolding'} = 1;
368         $dotransfer = 0;
369     }
370
371     # check if it is still issued to someone, return it...
372     my $issue = $item->checkout;
373     if ( $issue ) {
374         AddReturn( $barcode, $fbr );
375         $messages->{'WasReturned'} = $issue->borrowernumber;
376     }
377
378     # find reserves.....
379     # That'll save a database query.
380     my ( $resfound, $resrec, undef ) =
381       CheckReserves( $item );
382     if ( $resfound ) {
383         $resrec->{'ResFound'} = $resfound;
384         $messages->{'ResFound'} = $resrec;
385         $dotransfer = 0 unless $ignoreRs;
386     }
387
388     # find recall
389     if ( C4::Context->preference('UseRecalls') ) {
390         my $recall = Koha::Recalls->find({ item_id => $itemnumber, status => 'in_transit' });
391         if ( defined $recall ) {
392             # do a transfer if the recall branch is different to the item holding branch
393             if ( $recall->pickup_library_id eq $fbr ) {
394                 $dotransfer = 0;
395                 $messages->{'RecallPlacedAtHoldingBranch'} = 1;
396             } else {
397                 $dotransfer = 1;
398                 $messages->{'RecallFound'} = $recall;
399             }
400         }
401     }
402
403     #actually do the transfer....
404     if ($dotransfer) {
405         ModItemTransfer( $itemnumber, $fbr, $tbr, $trigger );
406
407         # don't need to update MARC anymore, we do it in batch now
408         $messages->{'WasTransfered'} = $tbr;
409
410     }
411     ModDateLastSeen( $itemnumber );
412     return ( $dotransfer, $messages );
413 }
414
415
416 sub TooMany {
417     my $borrower        = shift;
418     my $item_object = shift;
419     my $params = shift;
420     my $onsite_checkout = $params->{onsite_checkout} || 0;
421     my $switch_onsite_checkout = $params->{switch_onsite_checkout} || 0;
422     my $cat_borrower    = $borrower->{'categorycode'};
423     my $dbh             = C4::Context->dbh;
424     # Get which branchcode we need
425     my $branch = _GetCircControlBranch($item_object->unblessed,$borrower);
426     my $type = $item_object->effective_itemtype;
427
428     my ($type_object, $parent_type, $parent_maxissueqty_rule);
429     $type_object = Koha::ItemTypes->find( $type );
430     $parent_type = $type_object->parent_type if $type_object;
431     my $child_types = Koha::ItemTypes->search({ parent_type => $type });
432     # Find any children if we are a parent_type;
433
434     # given branch, patron category, and item type, determine
435     # applicable issuing rule
436
437     $parent_maxissueqty_rule = Koha::CirculationRules->get_effective_rule(
438         {
439             categorycode => $cat_borrower,
440             itemtype     => $parent_type,
441             branchcode   => $branch,
442             rule_name    => 'maxissueqty',
443         }
444     ) if $parent_type;
445     # If the parent rule is for default type we discount it
446     $parent_maxissueqty_rule = undef if $parent_maxissueqty_rule && !defined $parent_maxissueqty_rule->itemtype;
447
448     my $maxissueqty_rule = Koha::CirculationRules->get_effective_rule(
449         {
450             categorycode => $cat_borrower,
451             itemtype     => $type,
452             branchcode   => $branch,
453             rule_name    => 'maxissueqty',
454         }
455     );
456
457     my $maxonsiteissueqty_rule = Koha::CirculationRules->get_effective_rule(
458         {
459             categorycode => $cat_borrower,
460             itemtype     => $type,
461             branchcode   => $branch,
462             rule_name    => 'maxonsiteissueqty',
463         }
464     );
465
466
467     my $patron = Koha::Patrons->find($borrower->{borrowernumber});
468     # if a rule is found and has a loan limit set, count
469     # how many loans the patron already has that meet that
470     # rule
471     if (defined($maxissueqty_rule) and $maxissueqty_rule->rule_value ne "") {
472
473         my $checkouts;
474         if ( $maxissueqty_rule->branchcode ) {
475             if ( C4::Context->preference('CircControl') eq 'PickupLibrary' ) {
476                 $checkouts = $patron->checkouts->search(
477                     { 'me.branchcode' => $maxissueqty_rule->branchcode } );
478             } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
479                 $checkouts = $patron->checkouts; # if branch is the patron's home branch, then count all loans by patron
480             } else {
481                 my $branch_type = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
482                 $checkouts = $patron->checkouts->search(
483                     { "item.$branch_type" => $maxissueqty_rule->branchcode } );
484             }
485         } else {
486             $checkouts = $patron->checkouts; # if rule is not branch specific then count all loans by patron
487         }
488         $checkouts = $checkouts->search(undef, { prefetch => 'item' });
489
490         my $sum_checkouts;
491         my $rule_itemtype = $maxissueqty_rule->itemtype;
492
493         my @types;
494         unless ( $rule_itemtype ) {
495             # matching rule has the default item type, so count only
496             # those existing loans that don't fall under a more
497             # specific rule
498             @types = Koha::CirculationRules->search(
499                 {
500                     branchcode => $maxissueqty_rule->branchcode,
501                     categorycode => [ $maxissueqty_rule->categorycode, $cat_borrower ],
502                     itemtype  => { '!=' => undef },
503                     rule_name => 'maxissueqty'
504                 }
505             )->get_column('itemtype');
506         } else {
507             if ( $parent_maxissueqty_rule ) {
508                 # if we have a parent item type then we count loans of the
509                 # specific item type or its siblings or parent
510                 my $children = Koha::ItemTypes->search({ parent_type => $parent_type });
511                 @types = $children->get_column('itemtype');
512                 push @types, $parent_type;
513             } elsif ( $child_types ) {
514                 # If we are a parent type, we need to count all child types and our own type
515                 @types = $child_types->get_column('itemtype');
516                 push @types, $type; # And don't forget to count our own types
517             } else {
518                 # Otherwise only count the specific itemtype
519                 push @types, $type;
520             }
521         }
522
523         while ( my $c = $checkouts->next ) {
524             my $itemtype = $c->item->effective_itemtype;
525
526             unless ( $rule_itemtype ) {
527                 next if grep {$_ eq $itemtype} @types;
528             } else {
529                 next unless grep {$_ eq $itemtype} @types;
530             }
531
532             $sum_checkouts->{total}++;
533             $sum_checkouts->{onsite_checkouts}++ if $c->onsite_checkout;
534             $sum_checkouts->{itemtype}->{$itemtype}++;
535         }
536
537         my $checkout_count_type = $sum_checkouts->{itemtype}->{$type} || 0;
538         my $checkout_count = $sum_checkouts->{total} || 0;
539         my $onsite_checkout_count = $sum_checkouts->{onsite_checkouts} || 0;
540
541         my $checkout_rules = {
542             checkout_count               => $checkout_count,
543             onsite_checkout_count        => $onsite_checkout_count,
544             onsite_checkout              => $onsite_checkout,
545             max_checkouts_allowed        => $maxissueqty_rule ? $maxissueqty_rule->rule_value : undef,
546             max_onsite_checkouts_allowed => $maxonsiteissueqty_rule ? $maxonsiteissueqty_rule->rule_value : undef,
547             switch_onsite_checkout       => $switch_onsite_checkout,
548         };
549         # If parent rules exists
550         if ( defined($parent_maxissueqty_rule) and defined($parent_maxissueqty_rule->rule_value) ){
551             $checkout_rules->{max_checkouts_allowed} = $parent_maxissueqty_rule ? $parent_maxissueqty_rule->rule_value : undef;
552             my $qty_over = _check_max_qty($checkout_rules);
553             return $qty_over if defined $qty_over;
554
555             # If the parent rule is less than or equal to the child, we only need check the parent
556             if( $maxissueqty_rule->rule_value < $parent_maxissueqty_rule->rule_value && defined($maxissueqty_rule->itemtype) ) {
557                 $checkout_rules->{checkout_count} = $checkout_count_type;
558                 $checkout_rules->{max_checkouts_allowed} = $maxissueqty_rule ? $maxissueqty_rule->rule_value : undef;
559                 my $qty_over = _check_max_qty($checkout_rules);
560                 return $qty_over if defined $qty_over;
561             }
562         } else {
563             my $qty_over = _check_max_qty($checkout_rules);
564             return $qty_over if defined $qty_over;
565         }
566     }
567
568     # Now count total loans against the limit for the branch
569     my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
570     if (defined($branch_borrower_circ_rule->{patron_maxissueqty}) and $branch_borrower_circ_rule->{patron_maxissueqty} ne '') {
571         my $checkouts;
572         if ( C4::Context->preference('CircControl') eq 'PickupLibrary' ) {
573             $checkouts = $patron->checkouts->search(
574                 { 'me.branchcode' => $branch} );
575         } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
576             $checkouts = $patron->checkouts; # if branch is the patron's home branch, then count all loans by patron
577         } else {
578             my $branch_type = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
579             $checkouts = $patron->checkouts->search(
580                 { "item.$branch_type" => $branch},
581                 { prefetch            => 'item' } );
582         }
583
584         my $checkout_count = $checkouts->count;
585         my $onsite_checkout_count = $checkouts->search({ onsite_checkout => 1 })->count;
586         my $max_checkouts_allowed = $branch_borrower_circ_rule->{patron_maxissueqty};
587         my $max_onsite_checkouts_allowed = $branch_borrower_circ_rule->{patron_maxonsiteissueqty} || undef;
588
589         my $qty_over = _check_max_qty(
590             {
591                 checkout_count               => $checkout_count,
592                 onsite_checkout_count        => $onsite_checkout_count,
593                 onsite_checkout              => $onsite_checkout,
594                 max_checkouts_allowed        => $max_checkouts_allowed,
595                 max_onsite_checkouts_allowed => $max_onsite_checkouts_allowed,
596                 switch_onsite_checkout       => $switch_onsite_checkout
597             }
598         );
599         return $qty_over if defined $qty_over;
600     }
601
602     if ( not defined( $maxissueqty_rule ) and not defined($branch_borrower_circ_rule->{patron_maxissueqty}) ) {
603         return { reason => 'NO_RULE_DEFINED', max_allowed => 0 };
604     }
605
606     # OK, the patron can issue !!!
607     return;
608 }
609
610 sub _check_max_qty {
611     my $params                       = shift;
612     my $checkout_count               = $params->{checkout_count};
613     my $onsite_checkout_count        = $params->{onsite_checkout_count};
614     my $onsite_checkout              = $params->{onsite_checkout};
615     my $max_checkouts_allowed        = $params->{max_checkouts_allowed};
616     my $max_onsite_checkouts_allowed = $params->{max_onsite_checkouts_allowed};
617     my $switch_onsite_checkout       = $params->{switch_onsite_checkout};
618
619     if ( $onsite_checkout and defined $max_onsite_checkouts_allowed ) {
620         if ( $max_onsite_checkouts_allowed eq '' ) { return; }
621         if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed ) {
622             return {
623                 reason      => 'TOO_MANY_ONSITE_CHECKOUTS',
624                 count       => $onsite_checkout_count,
625                 max_allowed => $max_onsite_checkouts_allowed,
626             };
627         }
628     }
629     if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
630         if ( $max_checkouts_allowed eq '' ) { return; }
631         my $delta = $switch_onsite_checkout ? 1 : 0;
632         if ( $checkout_count >= $max_checkouts_allowed + $delta ) {
633             return {
634                 reason      => 'TOO_MANY_CHECKOUTS',
635                 count       => $checkout_count,
636                 max_allowed => $max_checkouts_allowed,
637             };
638         }
639     }
640     elsif ( not $onsite_checkout ) {
641         if ( $max_checkouts_allowed eq '' ) { return; }
642         if (
643             $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed )
644         {
645             return {
646                 reason      => 'TOO_MANY_CHECKOUTS',
647                 count       => $checkout_count - $onsite_checkout_count,
648                 max_allowed => $max_checkouts_allowed,
649             };
650         }
651     }
652
653     return;
654 }
655
656 =head2 CanBookBeIssued
657
658   ( $issuingimpossible, $needsconfirmation, [ $alerts ] ) =  CanBookBeIssued( $patron,
659                       $barcode, $duedate, $inprocess, $ignore_reserves, $params );
660
661 Check if a book can be issued.
662
663 C<$issuingimpossible> and C<$needsconfirmation> are hashrefs.
664
665 IMPORTANT: The assumption by users of this routine is that causes blocking
666 the issue are keyed by uppercase labels and other returned
667 data is keyed in lower case!
668
669 =over 4
670
671 =item C<$patron> is a Koha::Patron
672
673 =item C<$barcode> is the bar code of the book being issued.
674
675 =item C<$duedates> is a DateTime object.
676
677 =item C<$inprocess> boolean switch
678
679 =item C<$ignore_reserves> boolean switch
680
681 =item C<$params> Hashref of additional parameters
682
683 Available keys:
684     override_high_holds - Ignore high holds
685     onsite_checkout     - Checkout is an onsite checkout that will not leave the library
686     item                - Optionally pass the object for the item we are checking out to save a lookup
687
688 =back
689
690 Returns :
691
692 =over 4
693
694 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
695 Possible values are :
696
697 =back
698
699 =head3 INVALID_DATE 
700
701 sticky due date is invalid
702
703 =head3 GNA
704
705 borrower gone with no address
706
707 =head3 CARD_LOST
708
709 borrower declared it's card lost
710
711 =head3 DEBARRED
712
713 borrower debarred
714
715 =head3 UNKNOWN_BARCODE
716
717 barcode unknown
718
719 =head3 NOT_FOR_LOAN
720
721 item is not for loan
722
723 =head3 WTHDRAWN
724
725 item withdrawn.
726
727 =head3 RESTRICTED
728
729 item is restricted (set by ??)
730
731 C<$needsconfirmation> a reference to a hash. It contains reasons why the loan 
732 could be prevented, but ones that can be overriden by the operator.
733
734 Possible values are :
735
736 =head3 DEBT
737
738 borrower has debts.
739
740 =head3 RENEW_ISSUE
741
742 renewing, not issuing
743
744 =head3 ISSUED_TO_ANOTHER
745
746 issued to someone else.
747
748 =head3 RESERVED
749
750 reserved for someone else.
751
752 =head3 TRANSFERRED
753
754 reserved and being transferred for someone else.
755
756 =head3 INVALID_DATE
757
758 sticky due date is invalid or due date in the past
759
760 =head3 TOO_MANY
761
762 if the borrower borrows to much things
763
764 =head3 RECALLED
765
766 recalled by someone else
767
768 =cut
769
770 sub CanBookBeIssued {
771     my ( $patron, $barcode, $duedate, $inprocess, $ignore_reserves, $params ) = @_;
772     my %needsconfirmation;    # filled with problems that needs confirmations
773     my %issuingimpossible;    # filled with problems that causes the issue to be IMPOSSIBLE
774     my %alerts;               # filled with messages that shouldn't stop issuing, but the librarian should be aware of.
775     my %messages;             # filled with information messages that should be displayed.
776
777     my $onsite_checkout     = $params->{onsite_checkout}     || 0;
778     my $override_high_holds = $params->{override_high_holds} || 0;
779
780     my $item_object = $params->{item}
781       // Koha::Items->find( { barcode => $barcode } );
782
783     # MANDATORY CHECKS - unless item exists, nothing else matters
784     unless ( $item_object ) {
785         $issuingimpossible{UNKNOWN_BARCODE} = 1;
786     }
787     return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible;
788
789     my $item_unblessed = $item_object->unblessed; # Transition...
790     my $issue = $item_object->checkout;
791     my $biblio = $item_object->biblio;
792
793     my $biblioitem = $biblio->biblioitem;
794     my $effective_itemtype = $item_object->effective_itemtype;
795     my $dbh             = C4::Context->dbh;
796     my $patron_unblessed = $patron->unblessed;
797
798     my $circ_library = Koha::Libraries->find( _GetCircControlBranch($item_unblessed, $patron_unblessed) );
799
800     my $now = dt_from_string();
801     $duedate ||= CalcDateDue( $now, $effective_itemtype, $circ_library->branchcode, $patron_unblessed );
802     if (DateTime->compare($duedate,$now) == -1 ) { # duedate cannot be before now
803          $needsconfirmation{INVALID_DATE} = $duedate;
804     }
805
806     my $fees = Koha::Charges::Fees->new(
807         {
808             patron    => $patron,
809             library   => $circ_library,
810             item      => $item_object,
811             to_date   => $duedate,
812         }
813     );
814
815     #
816     # BORROWER STATUS
817     #
818     if ( $patron->category->category_type eq 'X' && (  $item_object->barcode  )) {
819         # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1  .
820         C4::Stats::UpdateStats(
821             {
822                 branch         => C4::Context->userenv->{'branch'},
823                 type           => 'localuse',
824                 itemnumber     => $item_object->itemnumber,
825                 itemtype       => $effective_itemtype,
826                 borrowernumber => $patron->borrowernumber,
827                 ccode          => $item_object->ccode,
828                 categorycode   => $patron->categorycode,
829                 location       => $item_object->location,
830                 interface      => C4::Context->interface,
831             }
832         );
833         ModDateLastSeen( $item_object->itemnumber ); # FIXME Move to Koha::Item
834         return( { STATS => 1 }, {});
835     }
836
837     if ( $patron->gonenoaddress && $patron->gonenoaddress == 1 ) {
838         $issuingimpossible{GNA} = 1;
839     }
840
841     if ( $patron->lost && $patron->lost == 1 ) {
842         $issuingimpossible{CARD_LOST} = 1;
843     }
844     if ( $patron->is_debarred ) {
845         $issuingimpossible{DEBARRED} = 1;
846     }
847
848     if ( $patron->is_expired ) {
849         $issuingimpossible{EXPIRED} = 1;
850     }
851
852     #
853     # BORROWER STATUS
854     #
855
856     # DEBTS
857     my $account = $patron->account;
858     my $balance = $account->balance;
859     my $non_issues_charges = $account->non_issues_charges;
860     my $other_charges = $balance - $non_issues_charges;
861
862     my $amountlimit = C4::Context->preference("noissuescharge");
863     my $allowfineoverride = C4::Context->preference("AllowFineOverride");
864     my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride");
865
866     # Check the debt of this patrons guarantees
867     my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
868     $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
869     if ( defined $no_issues_charge_guarantees ) {
870         my @guarantees = map { $_->guarantee } $patron->guarantee_relationships->as_list;
871         my $guarantees_non_issues_charges = 0;
872         foreach my $g ( @guarantees ) {
873             $guarantees_non_issues_charges += $g->account->non_issues_charges;
874         }
875
876         if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees && !$inprocess && !$allowfineoverride) {
877             $issuingimpossible{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
878         } elsif ( $guarantees_non_issues_charges > $no_issues_charge_guarantees && !$inprocess && $allowfineoverride) {
879             $needsconfirmation{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
880         } elsif ( $allfinesneedoverride && $guarantees_non_issues_charges > 0 && $guarantees_non_issues_charges <= $no_issues_charge_guarantees && !$inprocess ) {
881             $needsconfirmation{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
882         }
883     }
884
885     # Check the debt of this patrons guarantors *and* the guarantees of those guarantors
886     my $no_issues_charge_guarantors = C4::Context->preference("NoIssuesChargeGuarantorsWithGuarantees");
887     $no_issues_charge_guarantors = undef unless looks_like_number( $no_issues_charge_guarantors );
888     if ( defined $no_issues_charge_guarantors ) {
889         my $guarantors_non_issues_charges = $patron->relationships_debt({ include_guarantors => 1, only_this_guarantor => 0, include_this_patron => 1 });
890
891         if ( $guarantors_non_issues_charges > $no_issues_charge_guarantors && !$inprocess && !$allowfineoverride) {
892             $issuingimpossible{DEBT_GUARANTORS} = $guarantors_non_issues_charges;
893         } elsif ( $guarantors_non_issues_charges > $no_issues_charge_guarantors && !$inprocess && $allowfineoverride) {
894             $needsconfirmation{DEBT_GUARANTORS} = $guarantors_non_issues_charges;
895         } elsif ( $allfinesneedoverride && $guarantors_non_issues_charges > 0 && $guarantors_non_issues_charges <= $no_issues_charge_guarantors && !$inprocess ) {
896             $needsconfirmation{DEBT_GUARANTORS} = $guarantors_non_issues_charges;
897         }
898     }
899
900     if ( C4::Context->preference("IssuingInProcess") ) {
901         if ( $non_issues_charges > $amountlimit && !$inprocess && !$allowfineoverride) {
902             $issuingimpossible{DEBT} = $non_issues_charges;
903         } elsif ( $non_issues_charges > $amountlimit && !$inprocess && $allowfineoverride) {
904             $needsconfirmation{DEBT} = $non_issues_charges;
905         } elsif ( $allfinesneedoverride && $non_issues_charges > 0 && $non_issues_charges <= $amountlimit && !$inprocess ) {
906             $needsconfirmation{DEBT} = $non_issues_charges;
907         }
908     }
909     else {
910         if ( $non_issues_charges > $amountlimit && $allowfineoverride ) {
911             $needsconfirmation{DEBT} = $non_issues_charges;
912         } elsif ( $non_issues_charges > $amountlimit && !$allowfineoverride) {
913             $issuingimpossible{DEBT} = $non_issues_charges;
914         } elsif ( $non_issues_charges > 0 && $allfinesneedoverride ) {
915             $needsconfirmation{DEBT} = $non_issues_charges;
916         }
917     }
918
919     if ($balance > 0 && $other_charges > 0) {
920         $alerts{OTHER_CHARGES} = sprintf( "%.2f", $other_charges );
921     }
922
923     $patron = Koha::Patrons->find( $patron->borrowernumber ); # FIXME Refetch just in case, to avoid regressions. But must not be needed
924     $patron_unblessed = $patron->unblessed;
925
926     if ( my $debarred_date = $patron->is_debarred ) {
927          # patron has accrued fine days or has a restriction. $count is a date
928         if ($debarred_date eq '9999-12-31') {
929             $issuingimpossible{USERBLOCKEDNOENDDATE} = $debarred_date;
930         }
931         else {
932             $issuingimpossible{USERBLOCKEDWITHENDDATE} = $debarred_date;
933         }
934     } elsif ( my $num_overdues = $patron->has_overdues ) {
935         ## patron has outstanding overdue loans
936         if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){
937             $issuingimpossible{USERBLOCKEDOVERDUE} = $num_overdues;
938         }
939         elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){
940             $needsconfirmation{USERBLOCKEDOVERDUE} = $num_overdues;
941         }
942     }
943
944     # Additional Materials Check
945     if ( C4::Context->preference("CircConfirmItemParts")
946         && $item_object->materials )
947     {
948         $needsconfirmation{ADDITIONAL_MATERIALS} = $item_object->materials;
949     }
950
951     #
952     # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
953     #
954     if ( $issue && $issue->borrowernumber eq $patron->borrowernumber ){
955
956         # Already issued to current borrower.
957         # If it is an on-site checkout if it can be switched to a normal checkout
958         # or ask whether the loan should be renewed
959
960         if ( $issue->onsite_checkout
961                 and C4::Context->preference('SwitchOnSiteCheckouts') ) {
962             $messages{ONSITE_CHECKOUT_WILL_BE_SWITCHED} = 1;
963         } else {
964             my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed($patron, $issue);
965             if ( $CanBookBeRenewed == 0 ) {    # no more renewals allowed
966                 if ( $renewerror eq 'onsite_checkout' ) {
967                     $issuingimpossible{NO_RENEWAL_FOR_ONSITE_CHECKOUTS} = 1;
968                 }
969                 else {
970                     $issuingimpossible{NO_MORE_RENEWALS} = 1;
971                 }
972             }
973             else {
974                 $needsconfirmation{RENEW_ISSUE} = 1;
975             }
976         }
977     }
978     elsif ( $issue ) {
979
980         # issued to someone else
981
982         my $patron = Koha::Patrons->find( $issue->borrowernumber );
983
984         my ( $can_be_returned, $message ) = CanBookBeReturned( $item_unblessed, C4::Context->userenv->{branch} );
985
986         if ( !$can_be_returned ) {
987             $issuingimpossible{RETURN_IMPOSSIBLE} = 1;
988             $issuingimpossible{branch_to_return} = $message;
989         } else {
990             if ( C4::Context->preference('AutoReturnCheckedOutItems') ) {
991                 $alerts{RETURNED_FROM_ANOTHER} = { patron => $patron };
992             }
993             else {
994                 $needsconfirmation{ISSUED_TO_ANOTHER} = 1;
995                 $needsconfirmation{issued_firstname} = $patron->firstname;
996                 $needsconfirmation{issued_surname} = $patron->surname;
997                 $needsconfirmation{issued_cardnumber} = $patron->cardnumber;
998                 $needsconfirmation{issued_borrowernumber} = $patron->borrowernumber;
999             }
1000         }
1001     }
1002
1003     # JB34 CHECKS IF BORROWERS DON'T HAVE ISSUE TOO MANY BOOKS
1004     #
1005     my $switch_onsite_checkout = (
1006           C4::Context->preference('SwitchOnSiteCheckouts')
1007       and $issue
1008       and $issue->onsite_checkout
1009       and $issue->borrowernumber == $patron->borrowernumber ? 1 : 0 );
1010     my $toomany = TooMany( $patron_unblessed, $item_object, { onsite_checkout => $onsite_checkout, switch_onsite_checkout => $switch_onsite_checkout, } );
1011     # if TooMany max_allowed returns 0 the user doesn't have permission to check out this book
1012     if ( $toomany && not exists $needsconfirmation{RENEW_ISSUE} ) {
1013         if ( $toomany->{max_allowed} == 0 ) {
1014             $needsconfirmation{PATRON_CANT} = 1;
1015         }
1016         if ( C4::Context->preference("AllowTooManyOverride") ) {
1017             $needsconfirmation{TOO_MANY} = $toomany->{reason};
1018             $needsconfirmation{current_loan_count} = $toomany->{count};
1019             $needsconfirmation{max_loans_allowed} = $toomany->{max_allowed};
1020         } else {
1021             $issuingimpossible{TOO_MANY} = $toomany->{reason};
1022             $issuingimpossible{current_loan_count} = $toomany->{count};
1023             $issuingimpossible{max_loans_allowed} = $toomany->{max_allowed};
1024         }
1025     }
1026
1027     #
1028     # CHECKPREVCHECKOUT: CHECK IF ITEM HAS EVER BEEN LENT TO PATRON
1029     #
1030     $patron = Koha::Patrons->find( $patron->borrowernumber ); # FIXME Refetch just in case, to avoid regressions. But must not be needed
1031     if ( $patron->wants_check_for_previous_checkout && $patron->do_check_for_previous_checkout($item_unblessed) ) {
1032         $needsconfirmation{PREVISSUE} = 1;
1033     }
1034
1035     #
1036     # ITEM CHECKING
1037     #
1038     if ( $item_object->notforloan )
1039     {
1040         if(!C4::Context->preference("AllowNotForLoanOverride")){
1041             $issuingimpossible{NOT_FOR_LOAN} = 1;
1042             $issuingimpossible{item_notforloan} = $item_object->notforloan;
1043         }else{
1044             $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
1045             $needsconfirmation{item_notforloan} = $item_object->notforloan;
1046         }
1047     }
1048     else {
1049         # we have to check itemtypes.notforloan also
1050         if (C4::Context->preference('item-level_itypes')){
1051             # this should probably be a subroutine
1052             my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
1053             $sth->execute($effective_itemtype);
1054             my $notforloan=$sth->fetchrow_hashref();
1055             if ($notforloan->{'notforloan'}) {
1056                 if (!C4::Context->preference("AllowNotForLoanOverride")) {
1057                     $issuingimpossible{NOT_FOR_LOAN} = 1;
1058                     $issuingimpossible{itemtype_notforloan} = $effective_itemtype;
1059                 } else {
1060                     $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
1061                     $needsconfirmation{itemtype_notforloan} = $effective_itemtype;
1062                 }
1063             }
1064         }
1065         else {
1066             my $itemtype = Koha::ItemTypes->find($biblioitem->itemtype);
1067             if ( $itemtype && defined $itemtype->notforloan && $itemtype->notforloan == 1){
1068                 if (!C4::Context->preference("AllowNotForLoanOverride")) {
1069                     $issuingimpossible{NOT_FOR_LOAN} = 1;
1070                     $issuingimpossible{itemtype_notforloan} = $effective_itemtype;
1071                 } else {
1072                     $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
1073                     $needsconfirmation{itemtype_notforloan} = $effective_itemtype;
1074                 }
1075             }
1076         }
1077     }
1078     if ( $item_object->withdrawn && $item_object->withdrawn > 0 )
1079     {
1080         $issuingimpossible{WTHDRAWN} = 1;
1081     }
1082     if (   $item_object->restricted
1083         && $item_object->restricted == 1 )
1084     {
1085         $issuingimpossible{RESTRICTED} = 1;
1086     }
1087     if ( $item_object->itemlost && C4::Context->preference("IssueLostItem") ne 'nothing' ) {
1088         my $av = Koha::AuthorisedValues->search({ category => 'LOST', authorised_value => $item_object->itemlost });
1089         my $code = $av->count ? $av->next->lib : '';
1090         $needsconfirmation{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'confirm' );
1091         $alerts{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'alert' );
1092     }
1093     if ( C4::Context->preference("IndependentBranches") ) {
1094         my $userenv = C4::Context->userenv;
1095         unless ( C4::Context->IsSuperLibrarian() ) {
1096             my $HomeOrHoldingBranch = C4::Context->preference("HomeOrHoldingBranch");
1097             if ( $item_object->$HomeOrHoldingBranch ne $userenv->{branch} ){
1098                 $issuingimpossible{ITEMNOTSAMEBRANCH} = 1;
1099                 $issuingimpossible{'itemhomebranch'} = $item_object->$HomeOrHoldingBranch;
1100             }
1101             $needsconfirmation{BORRNOTSAMEBRANCH} = $patron->branchcode
1102               if ( $patron->branchcode ne $userenv->{branch} );
1103         }
1104     }
1105
1106     #
1107     # CHECK IF THERE IS RENTAL CHARGES. RENTAL MUST BE CONFIRMED BY THE BORROWER
1108     #
1109     my $rentalConfirmation = C4::Context->preference("RentalFeesCheckoutConfirmation");
1110     if ($rentalConfirmation) {
1111         my ($rentalCharge) = GetIssuingCharges( $item_object->itemnumber, $patron->borrowernumber );
1112
1113         my $itemtype_object = Koha::ItemTypes->find( $item_object->effective_itemtype );
1114         if ($itemtype_object) {
1115             my $accumulate_charge = $fees->accumulate_rentalcharge();
1116             if ( $accumulate_charge > 0 ) {
1117                 $rentalCharge += $accumulate_charge;
1118             }
1119         }
1120
1121         if ( $rentalCharge > 0 ) {
1122             $needsconfirmation{RENTALCHARGE} = $rentalCharge;
1123         }
1124     }
1125
1126     my $recall;
1127     # CHECK IF ITEM HAS BEEN RECALLED BY ANOTHER PATRON
1128     # Only bother doing this if UseRecalls is enabled and the item is recallable
1129     # Don't look at recalls that are in transit
1130     if ( C4::Context->preference('UseRecalls') and $item_object->can_be_waiting_recall ) {
1131         my @recalls = $biblio->recalls({},{ order_by => { -asc => 'created_date' } })->filter_by_current->as_list;
1132
1133         foreach my $r ( @recalls ) {
1134             if ( $r->item_id and
1135                 $r->item_id == $item_object->itemnumber and
1136                 $r->patron_id == $patron->borrowernumber and
1137                 ( $r->waiting or $r->requested ) ) {
1138                 $messages{RECALLED} = $r->id;
1139                 $recall = $r;
1140                 # this item is recalled by or already waiting for this borrower and the recall can be fulfilled
1141                 last;
1142             }
1143             elsif ( $r->item_id and
1144                 $r->item_id == $item_object->itemnumber and
1145                 $r->in_transit ) {
1146                 # recalled item is in transit
1147                 $issuingimpossible{RECALLED_INTRANSIT} = $r->pickup_library_id;
1148             }
1149             elsif ( $r->item_level and
1150                 $r->item_id == $item_object->itemnumber and
1151                 $r->patron_id != $patron->borrowernumber and
1152                 !$r->in_transit ) {
1153                 # this specific item has been recalled by a different patron
1154                 $needsconfirmation{RECALLED} = $r;
1155                 $recall = $r;
1156                 last;
1157             }
1158             elsif ( !$r->item_level and
1159                 $r->patron_id != $patron->borrowernumber and
1160                 !$r->in_transit ) {
1161                 # a different patron has placed a biblio-level recall and this item is eligible to fill it
1162                 $needsconfirmation{RECALLED} = $r;
1163                 $recall = $r;
1164                 last;
1165             }
1166         }
1167     }
1168
1169     unless ( $ignore_reserves and defined $recall ) {
1170         # See if the item is on reserve.
1171         my ( $restype, $res ) = CheckReserves( $item_object );
1172         if ($restype) {
1173             my $resbor = $res->{'borrowernumber'};
1174             if ( $resbor ne $patron->borrowernumber ) {
1175                 my $patron = Koha::Patrons->find( $resbor );
1176                 if ( $restype eq "Waiting" )
1177                 {
1178                     # The item is on reserve and waiting, but has been
1179                     # reserved by some other patron.
1180                     $needsconfirmation{RESERVE_WAITING} = 1;
1181                     $needsconfirmation{'resfirstname'} = $patron->firstname;
1182                     $needsconfirmation{'ressurname'} = $patron->surname;
1183                     $needsconfirmation{'rescardnumber'} = $patron->cardnumber;
1184                     $needsconfirmation{'resborrowernumber'} = $patron->borrowernumber;
1185                     $needsconfirmation{'resbranchcode'} = $res->{branchcode};
1186                     $needsconfirmation{'reswaitingdate'} = $res->{'waitingdate'};
1187                     $needsconfirmation{'reserve_id'} = $res->{reserve_id};
1188                 }
1189                 elsif ( $restype eq "Reserved" ) {
1190                     # The item is on reserve for someone else.
1191                     $needsconfirmation{RESERVED} = 1;
1192                     $needsconfirmation{'resfirstname'} = $patron->firstname;
1193                     $needsconfirmation{'ressurname'} = $patron->surname;
1194                     $needsconfirmation{'rescardnumber'} = $patron->cardnumber;
1195                     $needsconfirmation{'resborrowernumber'} = $patron->borrowernumber;
1196                     $needsconfirmation{'resbranchcode'} = $res->{branchcode};
1197                     $needsconfirmation{'resreservedate'} = $res->{reservedate};
1198                     $needsconfirmation{'reserve_id'} = $res->{reserve_id};
1199                 }
1200                 elsif ( $restype eq "Transferred" ) {
1201                     # The item is determined hold being transferred for someone else.
1202                     $needsconfirmation{TRANSFERRED} = 1;
1203                     $needsconfirmation{'resfirstname'} = $patron->firstname;
1204                     $needsconfirmation{'ressurname'} = $patron->surname;
1205                     $needsconfirmation{'rescardnumber'} = $patron->cardnumber;
1206                     $needsconfirmation{'resborrowernumber'} = $patron->borrowernumber;
1207                     $needsconfirmation{'resbranchcode'} = $res->{branchcode};
1208                     $needsconfirmation{'resreservedate'} = $res->{reservedate};
1209                     $needsconfirmation{'reserve_id'} = $res->{reserve_id};
1210                 }
1211                 elsif ( $restype eq "Processing" ) {
1212                     # The item is determined hold being processed for someone else.
1213                     $needsconfirmation{PROCESSING} = 1;
1214                     $needsconfirmation{'resfirstname'} = $patron->firstname;
1215                     $needsconfirmation{'ressurname'} = $patron->surname;
1216                     $needsconfirmation{'rescardnumber'} = $patron->cardnumber;
1217                     $needsconfirmation{'resborrowernumber'} = $patron->borrowernumber;
1218                     $needsconfirmation{'resbranchcode'} = $res->{branchcode};
1219                     $needsconfirmation{'resreservedate'} = $res->{reservedate};
1220                     $needsconfirmation{'reserve_id'} = $res->{reserve_id};
1221                 }
1222             }
1223         }
1224     }
1225
1226     ## CHECK AGE RESTRICTION
1227     my $agerestriction  = $biblioitem->agerestriction;
1228     my ($restriction_age, $daysToAgeRestriction) = GetAgeRestriction( $agerestriction, $patron->unblessed );
1229     if ( $daysToAgeRestriction && $daysToAgeRestriction > 0 ) {
1230         if ( C4::Context->preference('AgeRestrictionOverride') ) {
1231             $needsconfirmation{AGE_RESTRICTION} = "$agerestriction";
1232         }
1233         else {
1234             $issuingimpossible{AGE_RESTRICTION} = "$agerestriction";
1235         }
1236     }
1237
1238     ## check for high holds decreasing loan period
1239     if ( C4::Context->preference('decreaseLoanHighHolds') ) {
1240         my $check = checkHighHolds( $item_object, $patron );
1241
1242         if ( $check->{exceeded} ) {
1243             my $highholds = {
1244                 num_holds  => $check->{outstanding},
1245                 duration   => $check->{duration},
1246                 returndate => $check->{due_date},
1247             };
1248             if ($override_high_holds) {
1249                 $alerts{HIGHHOLDS} = $highholds;
1250             }
1251             else {
1252                 $needsconfirmation{HIGHHOLDS} = $highholds;
1253             }
1254         }
1255     }
1256
1257     if (
1258         !C4::Context->preference('AllowMultipleIssuesOnABiblio') &&
1259         # don't do the multiple loans per bib check if we've
1260         # already determined that we've got a loan on the same item
1261         !$issuingimpossible{NO_MORE_RENEWALS} &&
1262         !$needsconfirmation{RENEW_ISSUE}
1263     ) {
1264         # Check if borrower has already issued an item from the same biblio
1265         # Only if it's not a subscription
1266         my $biblionumber = $item_object->biblionumber;
1267         require C4::Serials;
1268         my $is_a_subscription = C4::Serials::CountSubscriptionFromBiblionumber($biblionumber);
1269         unless ($is_a_subscription) {
1270             # FIXME Should be $patron->checkouts($args);
1271             my $checkouts = Koha::Checkouts->search(
1272                 {
1273                     borrowernumber => $patron->borrowernumber,
1274                     biblionumber   => $biblionumber,
1275                 },
1276                 {
1277                     join => 'item',
1278                 }
1279             );
1280             # if we get here, we don't already have a loan on this item,
1281             # so if there are any loans on this bib, ask for confirmation
1282             if ( $checkouts->count ) {
1283                 $needsconfirmation{BIBLIO_ALREADY_ISSUED} = 1;
1284             }
1285         }
1286     }
1287
1288     return ( \%issuingimpossible, \%needsconfirmation, \%alerts, \%messages, );
1289 }
1290
1291 =head2 CanBookBeReturned
1292
1293   ($returnallowed, $message) = CanBookBeReturned($item, $branch)
1294
1295 Check whether the item can be returned to the provided branch
1296
1297 =over 4
1298
1299 =item C<$item> is a hash of item information as returned Koha::Items->find->unblessed (Temporary, should be a Koha::Item instead)
1300
1301 =item C<$branch> is the branchcode where the return is taking place
1302
1303 =back
1304
1305 Returns:
1306
1307 =over 4
1308
1309 =item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)
1310
1311 =item C<$message> is the branchcode where the item SHOULD be returned, if the return is not allowed
1312
1313 =back
1314
1315 =cut
1316
1317 sub CanBookBeReturned {
1318   my ($item, $branch) = @_;
1319   my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") || 'anywhere';
1320
1321   # assume return is allowed to start
1322   my $allowed = 1;
1323   my $message;
1324
1325   # identify all cases where return is forbidden
1326   if ($allowreturntobranch eq 'homebranch' && $branch ne $item->{'homebranch'}) {
1327      $allowed = 0;
1328      $message = $item->{'homebranch'};
1329   } elsif ($allowreturntobranch eq 'holdingbranch' && $branch ne $item->{'holdingbranch'}) {
1330      $allowed = 0;
1331      $message = $item->{'holdingbranch'};
1332   } elsif ($allowreturntobranch eq 'homeorholdingbranch' && $branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
1333      $allowed = 0;
1334      $message = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary
1335   }
1336
1337   return ($allowed, $message);
1338 }
1339
1340 =head2 CheckHighHolds
1341
1342     used when syspref decreaseLoanHighHolds is active. Returns 1 or 0 to define whether the minimum value held in
1343     decreaseLoanHighHoldsValue is exceeded, the total number of outstanding holds, the number of days the loan
1344     has been decreased to (held in syspref decreaseLoanHighHoldsValue), and the new due date
1345
1346 =cut
1347
1348 sub checkHighHolds {
1349     my ( $item, $patron ) = @_;
1350     my $branchcode = _GetCircControlBranch( $item->unblessed, $patron->unblessed );
1351
1352     my $return_data = {
1353         exceeded    => 0,
1354         outstanding => 0,
1355         duration    => 0,
1356         due_date    => undef,
1357     };
1358
1359
1360     # Count holds on this record, ignoring the borrowers own holds as they would be filled by the checkout
1361     my $holds = Koha::Holds->search({
1362         biblionumber => $item->biblionumber,
1363         borrowernumber => { '!=' => $patron->borrowernumber }
1364     });
1365
1366     if ( $holds->count() ) {
1367         $return_data->{outstanding} = $holds->count();
1368
1369         my $decreaseLoanHighHoldsControl        = C4::Context->preference('decreaseLoanHighHoldsControl');
1370         my $decreaseLoanHighHoldsValue          = C4::Context->preference('decreaseLoanHighHoldsValue');
1371         my $decreaseLoanHighHoldsIgnoreStatuses = C4::Context->preference('decreaseLoanHighHoldsIgnoreStatuses');
1372
1373         my @decreaseLoanHighHoldsIgnoreStatuses = split( /,/, $decreaseLoanHighHoldsIgnoreStatuses );
1374
1375         if ( $decreaseLoanHighHoldsControl eq 'static' ) {
1376
1377             # static means just more than a given number of holds on the record
1378
1379             # If the number of holds is not above the threshold, we can stop here
1380             if ( $holds->count() <= $decreaseLoanHighHoldsValue ) {
1381                 return $return_data;
1382             }
1383         }
1384         elsif ( $decreaseLoanHighHoldsControl eq 'dynamic' ) {
1385
1386             # dynamic means X more than the number of holdable items on the record
1387
1388             # let's get the items
1389             my @items = $holds->next()->biblio()->items()->as_list;
1390
1391             # Remove any items with status defined to be ignored even if the would not make item unholdable
1392             foreach my $status (@decreaseLoanHighHoldsIgnoreStatuses) {
1393                 @items = grep { !$_->$status } @items;
1394             }
1395
1396             # Remove any items that are not holdable for this patron
1397             # We need to ignore hold counts as the borrower's own hold that will be filled by the checkout
1398             # could prevent them from placing further holds
1399             @items = grep { CanItemBeReserved( $patron, $_, undef, { ignore_hold_counts => 1 } )->{status} eq 'OK' } @items;
1400
1401             my $items_count = scalar @items;
1402
1403             my $threshold = $items_count + $decreaseLoanHighHoldsValue;
1404
1405             # If the number of holds is less than the count of items we have
1406             # plus the number of holds allowed above that count, we can stop here
1407             if ( $holds->count() <= $threshold ) {
1408                 return $return_data;
1409             }
1410         }
1411
1412         my $issuedate = dt_from_string();
1413
1414         my $itype = $item->effective_itemtype;
1415         my $daysmode = Koha::CirculationRules->get_effective_daysmode(
1416             {
1417                 categorycode => $patron->categorycode,
1418                 itemtype     => $itype,
1419                 branchcode   => $branchcode,
1420             }
1421         );
1422         my $calendar = Koha::Calendar->new( branchcode => $branchcode, days_mode => $daysmode );
1423
1424         my $orig_due = C4::Circulation::CalcDateDue( $issuedate, $itype, $branchcode, $patron->unblessed );
1425
1426         my $rule = Koha::CirculationRules->get_effective_rule_value(
1427             {
1428                 categorycode => $patron->categorycode,
1429                 itemtype     => $item->effective_itemtype,
1430                 branchcode   => $branchcode,
1431                 rule_name    => 'decreaseloanholds',
1432             }
1433         );
1434
1435         my $duration;
1436         if ( defined($rule) && $rule ne '' ){
1437             # overrides decreaseLoanHighHoldsDuration syspref
1438             $duration = $rule;
1439         } else {
1440             $duration = C4::Context->preference('decreaseLoanHighHoldsDuration');
1441         }
1442         my $reduced_datedue = $calendar->addDuration( $issuedate, $duration );
1443         $reduced_datedue->set_hour($orig_due->hour);
1444         $reduced_datedue->set_minute($orig_due->minute);
1445         $reduced_datedue->truncate( to => 'minute' );
1446
1447         if ( DateTime->compare( $reduced_datedue, $orig_due ) == -1 ) {
1448             $return_data->{exceeded} = 1;
1449             $return_data->{duration} = $duration;
1450             $return_data->{due_date} = $reduced_datedue;
1451         }
1452     }
1453
1454     return $return_data;
1455 }
1456
1457 =head2 AddIssue
1458
1459   &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
1460
1461 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
1462
1463 =over 4
1464
1465 =item C<$borrower> is a hash with borrower informations (from Koha::Patron->unblessed).
1466
1467 =item C<$barcode> is the barcode of the item being issued.
1468
1469 =item C<$datedue> is a DateTime object for the max date of return, i.e. the date due (optional).
1470 Calculated if empty.
1471
1472 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
1473
1474 =item C<$issuedate> is a DateTime object for the date to issue the item (optional).
1475 Defaults to today.
1476
1477 AddIssue does the following things :
1478
1479   - step 01: check that there is a borrowernumber & a barcode provided
1480   - check for RENEWAL (book issued & being issued to the same patron)
1481       - renewal YES = Calculate Charge & renew
1482       - renewal NO  =
1483           * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
1484           * RESERVE PLACED ?
1485               - fill reserve if reserve to this patron
1486               - cancel reserve or not, otherwise
1487           * RECALL PLACED ?
1488               - fill recall if recall to this patron
1489               - cancel recall or not
1490               - revert recall's waiting status or not
1491           * TRANSFERT PENDING ?
1492               - complete the transfert
1493           * ISSUE THE BOOK
1494
1495 =back
1496
1497 =cut
1498
1499 sub AddIssue {
1500     my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode, $params ) = @_;
1501
1502     my $onsite_checkout = $params && $params->{onsite_checkout} ? 1 : 0;
1503     my $switch_onsite_checkout = $params && $params->{switch_onsite_checkout};
1504     my $auto_renew = $params && $params->{auto_renew};
1505     my $cancel_recall = $params && $params->{cancel_recall};
1506     my $recall_id = $params && $params->{recall_id};
1507     my $dbh          = C4::Context->dbh;
1508     my $barcodecheck = CheckValidBarcode($barcode);
1509
1510     my $issue;
1511
1512     if ( $datedue && ref $datedue ne 'DateTime' ) {
1513         $datedue = dt_from_string($datedue);
1514     }
1515
1516     # $issuedate defaults to today.
1517     if ( !defined $issuedate ) {
1518         $issuedate = dt_from_string();
1519     }
1520     else {
1521         if ( ref $issuedate ne 'DateTime' ) {
1522             $issuedate = dt_from_string($issuedate);
1523
1524         }
1525     }
1526
1527     # Stop here if the patron or barcode doesn't exist
1528     if ( $borrower && $barcode && $barcodecheck ) {
1529         # find which item we issue
1530         my $item_object = Koha::Items->find({ barcode => $barcode })
1531           or return;    # if we don't get an Item, abort.
1532         my $item_unblessed = $item_object->unblessed;
1533
1534         my $branchcode = _GetCircControlBranch( $item_unblessed, $borrower );
1535
1536         # get actual issuing if there is one
1537         my $actualissue = $item_object->checkout;
1538
1539         # check if we just renew the issue.
1540         if ( $actualissue and $actualissue->borrowernumber eq $borrower->{'borrowernumber'}
1541                 and not $switch_onsite_checkout ) {
1542             $datedue = AddRenewal(
1543                 {
1544                     borrowernumber => $borrower->{'borrowernumber'},
1545                     itemnumber     => $item_object->itemnumber,
1546                     branch         => $branchcode,
1547                     datedue        => $datedue,
1548                     lastreneweddate =>
1549                       $issuedate,    # here interpreted as the renewal date
1550                 }
1551             );
1552             $issue = $item_object->checkout;
1553         }
1554         else {
1555
1556             unless ($datedue) {
1557                 my $itype = $item_object->effective_itemtype;
1558                 $datedue = CalcDateDue( $issuedate, $itype, $branchcode, $borrower );
1559
1560             }
1561
1562             # Check if we need to use an exact due date set by the ILL module
1563             if ( C4::Context->preference('ILLModule') ) {
1564                 # Check if there is an ILL connected with the biblio of the item we are issuing
1565                 my $ill_request = Koha::Illrequests->search({
1566                     biblio_id => $item_object->biblionumber,
1567                     borrowernumber => $borrower->{'borrowernumber'},
1568                     completed => undef,
1569                     due_date => { '!=', undef },
1570                 })->next;
1571
1572                 if ( $ill_request and length( $ill_request->due_date ) > 0 ) {
1573                     my $ill_dt = dt_from_string( $ill_request->due_date );
1574                     $ill_dt->set_hour(23);
1575                     $ill_dt->set_minute(59);
1576                     $datedue = $ill_dt;
1577                 }
1578             }
1579
1580             $datedue->truncate( to => 'minute' );
1581
1582             my $patron = Koha::Patrons->find( $borrower );
1583             my $library = Koha::Libraries->find( $branchcode );
1584             my $fees = Koha::Charges::Fees->new(
1585                 {
1586                     patron    => $patron,
1587                     library   => $library,
1588                     item      => $item_object,
1589                     to_date   => $datedue,
1590                 }
1591             );
1592
1593             # it's NOT a renewal
1594             if ( $actualissue and not $switch_onsite_checkout ) {
1595                 # This book is currently on loan, but not to the person
1596                 # who wants to borrow it now. mark it returned before issuing to the new borrower
1597                 my ( $allowed, $message ) = CanBookBeReturned( $item_unblessed, C4::Context->userenv->{branch} );
1598                 return unless $allowed;
1599                 AddReturn( $item_object->barcode, C4::Context->userenv->{'branch'} );
1600                 # AddReturn certainly has side-effects, like onloan => undef
1601                 $item_object->discard_changes;
1602             }
1603
1604             if ( C4::Context->preference('UseRecalls') ) {
1605                 Koha::Recalls->move_recall(
1606                     {
1607                         action         => $cancel_recall,
1608                         recall_id      => $recall_id,
1609                         item           => $item_object,
1610                         borrowernumber => $borrower->{borrowernumber},
1611                     }
1612                 );
1613             }
1614
1615             C4::Reserves::MoveReserve( $item_object->itemnumber, $borrower->{'borrowernumber'}, $cancelreserve );
1616
1617             # Starting process for transfer job (checking transfert and validate it if we have one)
1618             if ( my $transfer = $item_object->get_transfer ) {
1619                 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
1620                 $transfer->set(
1621                     {
1622                         datearrived => dt_from_string,
1623                         tobranch    => C4::Context->userenv->{branch},
1624                         comments    => 'Forced branchtransfer'
1625                     }
1626                 )->store;
1627                 if ( $transfer->reason && $transfer->reason eq 'Reserve' ) {
1628                     my $hold = $item_object->holds->search( { found => 'T' } )->next;
1629                     if ( $hold ) { # Is this really needed?
1630                         $hold->set( { found => undef } )->store;
1631                         C4::Reserves::ModReserveMinusPriority($item_object->itemnumber, $hold->reserve_id);
1632                     }
1633                 }
1634             }
1635
1636             # If automatic renewal wasn't selected while issuing, set the value according to the issuing rule.
1637             unless ($auto_renew) {
1638                 my $rule = Koha::CirculationRules->get_effective_rule_value(
1639                     {
1640                         categorycode => $borrower->{categorycode},
1641                         itemtype     => $item_object->effective_itemtype,
1642                         branchcode   => $branchcode,
1643                         rule_name    => 'auto_renew'
1644                     }
1645                 );
1646
1647                 $auto_renew = $rule if defined $rule && $rule ne '';
1648             }
1649
1650             my $issue_attributes = {
1651                 borrowernumber  => $borrower->{'borrowernumber'},
1652                 issuedate       => $issuedate,
1653                 date_due        => $datedue,
1654                 branchcode      => C4::Context->userenv->{'branch'},
1655                 onsite_checkout => $onsite_checkout,
1656                 auto_renew      => $auto_renew ? 1 : 0,
1657             };
1658
1659             # Get ID of logged in user.  if called from a batch job,
1660             # no user session exists and C4::Context->userenv() returns
1661             # the scalar '0'. Only do this if the syspref says so
1662             if ( C4::Context->preference('RecordStaffUserOnCheckout') ) {
1663                 my $userenv = C4::Context->userenv();
1664                 my $usernumber = (ref($userenv) eq 'HASH') ? $userenv->{'number'} : undef;
1665                 if ($usernumber) {
1666                     $issue_attributes->{issuer_id} = $usernumber;
1667                 }
1668             }
1669
1670             # In the case that the borrower has an on-site checkout
1671             # and SwitchOnSiteCheckouts is enabled this converts it to a regular checkout
1672             $issue = Koha::Checkouts->find( { itemnumber => $item_object->itemnumber } );
1673             if ($issue) {
1674                 $issue->set($issue_attributes)->store;
1675             }
1676             else {
1677                 $issue = Koha::Checkout->new(
1678                     {
1679                         itemnumber => $item_object->itemnumber,
1680                         %$issue_attributes,
1681                     }
1682                 )->store;
1683             }
1684             $issue->discard_changes;
1685             C4::Auth::track_login_daily( $borrower->{userid} );
1686             if ( $item_object->location && $item_object->location eq 'CART'
1687                 && ( !$item_object->permanent_location || $item_object->permanent_location ne 'CART' ) ) {
1688             ## Item was moved to cart via UpdateItemLocationOnCheckin, anything issued should be taken off the cart.
1689                 CartToShelf( $item_object->itemnumber );
1690             }
1691
1692             if ( C4::Context->preference('UpdateTotalIssuesOnCirc') ) {
1693                 UpdateTotalIssues( $item_object->biblionumber, 1, undef, { skip_holds_queue => 1 } );
1694             }
1695
1696             # Record if item was lost
1697             my $was_lost = $item_object->itemlost;
1698
1699             $item_object->issues( ( $item_object->issues || 0 ) + 1);
1700             $item_object->holdingbranch(C4::Context->userenv->{'branch'});
1701             $item_object->itemlost(0);
1702             $item_object->onloan($datedue->ymd());
1703             $item_object->datelastborrowed( dt_from_string()->ymd() );
1704             $item_object->datelastseen( dt_from_string() );
1705             $item_object->store( { log_action => 0, skip_holds_queue => 1 } );
1706
1707             # If the item was lost, it has now been found, charge the overdue if necessary
1708             if ($was_lost) {
1709                 if ( $item_object->{_charge} ) {
1710                     $actualissue //= Koha::Old::Checkouts->search(
1711                         { itemnumber => $item_unblessed->{itemnumber} },
1712                         {
1713                             order_by => { '-desc' => 'returndate' },
1714                             rows     => 1
1715                         }
1716                     )->single;
1717                     unless ( exists( $borrower->{branchcode} ) ) {
1718                         my $patron = $actualissue->patron;
1719                         $borrower = $patron->unblessed;
1720                     }
1721                     _CalculateAndUpdateFine(
1722                         {
1723                             issue       => $actualissue,
1724                             item        => $item_unblessed,
1725                             borrower    => $borrower,
1726                             return_date => $issuedate
1727                         }
1728                     );
1729                     _FixOverduesOnReturn( $borrower->{borrowernumber},
1730                         $item_object->itemnumber, undef, 'RENEWED' );
1731                 }
1732             }
1733
1734             # If it costs to borrow this book, charge it to the patron's account.
1735             my ( $charge, $itemtype ) = GetIssuingCharges( $item_object->itemnumber, $borrower->{'borrowernumber'} );
1736             if ( $charge && $charge > 0 ) {
1737                 AddIssuingCharge( $issue, $charge, 'RENT' );
1738             }
1739
1740             my $itemtype_object = Koha::ItemTypes->find( $item_object->effective_itemtype );
1741             if ( $itemtype_object ) {
1742                 my $accumulate_charge = $fees->accumulate_rentalcharge();
1743                 if ( $accumulate_charge > 0 ) {
1744                     AddIssuingCharge( $issue, $accumulate_charge, 'RENT_DAILY' );
1745                     $charge += $accumulate_charge;
1746                     $item_unblessed->{charge} = $charge;
1747                 }
1748             }
1749
1750             my $yaml = C4::Context->preference('UpdateNotForLoanStatusOnCheckout');
1751             if ($yaml) {
1752                 $yaml = "$yaml\n\n";
1753
1754                 my $rules;
1755                 eval { $rules = YAML::XS::Load(Encode::encode_utf8($yaml)); };
1756                 if ($@) {
1757                     warn "Unable to parse UpdateNotForLoanStatusOnCheckout syspref : $@";
1758                 }
1759                 else {
1760                     foreach my $key ( keys %$rules ) {
1761                         if ( $item_object->notforloan eq $key ) {
1762                             $item_object->notforloan($rules->{$key})->store({ log_action => 0, skip_record_index => 1 });
1763                             last;
1764                         }
1765                     }
1766                 }
1767             }
1768
1769             # Record the fact that this book was issued.
1770             C4::Stats::UpdateStats(
1771                 {
1772                     branch => C4::Context->userenv->{'branch'},
1773                     type => ( $onsite_checkout ? 'onsite_checkout' : 'issue' ),
1774                     amount         => $charge,
1775                     other          => ( $sipmode ? "SIP-$sipmode" : '' ),
1776                     itemnumber     => $item_object->itemnumber,
1777                     itemtype       => $item_object->effective_itemtype,
1778                     location       => $item_object->location,
1779                     borrowernumber => $borrower->{'borrowernumber'},
1780                     ccode          => $item_object->ccode,
1781                     categorycode   => $borrower->{'categorycode'},
1782                     interface      => C4::Context->interface,
1783                 }
1784             );
1785
1786             # Send a checkout slip.
1787             my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1788             my %conditions        = (
1789                 branchcode   => $branchcode,
1790                 categorycode => $borrower->{categorycode},
1791                 item_type    => $item_object->effective_itemtype,
1792                 notification => 'CHECKOUT',
1793             );
1794             if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
1795                 SendCirculationAlert(
1796                     {
1797                         type     => 'CHECKOUT',
1798                         item     => $item_object->unblessed,
1799                         borrower => $borrower,
1800                         branch   => $branchcode,
1801                     }
1802                 );
1803             }
1804             logaction(
1805                 "CIRCULATION", "ISSUE",
1806                 $borrower->{'borrowernumber'},
1807                 $item_object->itemnumber,
1808             ) if C4::Context->preference("IssueLog");
1809
1810             Koha::Plugins->call('after_circ_action', {
1811                 action  => 'checkout',
1812                 payload => {
1813                     type     => ( $onsite_checkout ? 'onsite_checkout' : 'issue' ),
1814                     checkout => $issue->get_from_storage
1815                 }
1816             });
1817
1818             Koha::BackgroundJob::BatchUpdateBiblioHoldsQueue->new->enqueue(
1819                 {
1820                     biblio_ids => [ $item_object->biblionumber ]
1821                 }
1822             ) if C4::Context->preference('RealTimeHoldsQueue');
1823         }
1824     }
1825     return $issue;
1826 }
1827
1828 =head2 GetLoanLength
1829
1830   my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1831
1832 Get loan length for an itemtype, a borrower type and a branch
1833
1834 =cut
1835
1836 sub GetLoanLength {
1837     my ( $categorycode, $itemtype, $branchcode ) = @_;
1838
1839     # Initialize default values
1840     my $rules = {
1841         issuelength   => 0,
1842         renewalperiod => 0,
1843         lengthunit    => 'days',
1844     };
1845
1846     my $found = Koha::CirculationRules->get_effective_rules( {
1847         branchcode => $branchcode,
1848         categorycode => $categorycode,
1849         itemtype => $itemtype,
1850         rules => [
1851             'issuelength',
1852             'renewalperiod',
1853             'lengthunit'
1854         ],
1855     } );
1856
1857     # Search for rules!
1858     foreach my $rule_name (keys %$found) {
1859         $rules->{$rule_name} = $found->{$rule_name};
1860     }
1861
1862     return $rules;
1863 }
1864
1865
1866 =head2 GetHardDueDate
1867
1868   my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode)
1869
1870 Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch
1871
1872 =cut
1873
1874 sub GetHardDueDate {
1875     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1876
1877     my $rules = Koha::CirculationRules->get_effective_rules(
1878         {
1879             categorycode => $borrowertype,
1880             itemtype     => $itemtype,
1881             branchcode   => $branchcode,
1882             rules        => [ 'hardduedate', 'hardduedatecompare' ],
1883         }
1884     );
1885
1886     if ( defined( $rules->{hardduedate} ) ) {
1887         if ( $rules->{hardduedate} ) {
1888             return ( dt_from_string( $rules->{hardduedate}, 'iso' ), $rules->{hardduedatecompare} );
1889         }
1890         else {
1891             return ( undef, undef );
1892         }
1893     }
1894 }
1895
1896 =head2 GetBranchBorrowerCircRule
1897
1898   my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1899
1900 Retrieves circulation rule attributes that apply to the given
1901 branch and patron category, regardless of item type.  
1902 The return value is a hashref containing the following key:
1903
1904 patron_maxissueqty - maximum number of loans that a
1905 patron of the given category can have at the given
1906 branch.  If the value is undef, no limit.
1907
1908 patron_maxonsiteissueqty - maximum of on-site checkouts that a
1909 patron of the given category can have at the given
1910 branch.  If the value is undef, no limit.
1911
1912 This will check for different branch/category combinations in the following order:
1913 branch and category
1914 branch only
1915 category only
1916 default branch and category
1917
1918 If no rule has been found in the database, it will default to
1919 the buillt in rule:
1920
1921 patron_maxissueqty - undef
1922 patron_maxonsiteissueqty - undef
1923
1924 C<$branchcode> and C<$categorycode> should contain the
1925 literal branch code and patron category code, respectively - no
1926 wildcards.
1927
1928 =cut
1929
1930 sub GetBranchBorrowerCircRule {
1931     my ( $branchcode, $categorycode ) = @_;
1932
1933     # Initialize default values
1934     my $rules = {
1935         patron_maxissueqty       => undef,
1936         patron_maxonsiteissueqty => undef,
1937     };
1938
1939     # Search for rules!
1940     foreach my $rule_name (qw( patron_maxissueqty patron_maxonsiteissueqty )) {
1941         my $rule = Koha::CirculationRules->get_effective_rule(
1942             {
1943                 categorycode => $categorycode,
1944                 itemtype     => undef,
1945                 branchcode   => $branchcode,
1946                 rule_name    => $rule_name,
1947             }
1948         );
1949
1950         $rules->{$rule_name} = $rule->rule_value if defined $rule;
1951     }
1952
1953     return $rules;
1954 }
1955
1956 =head2 GetBranchItemRule
1957
1958   my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1959
1960 Retrieves circulation rule attributes that apply to the given
1961 branch and item type, regardless of patron category.
1962
1963 The return value is a hashref containing the following keys:
1964
1965 holdallowed => Hold policy for this branch and itemtype. Possible values:
1966   not_allowed:           No holds allowed.
1967   from_home_library:     Holds allowed only by patrons that have the same homebranch as the item.
1968   from_any_library:      Holds allowed from any patron.
1969   from_local_hold_group: Holds allowed from libraries in hold group
1970
1971 This searches branchitemrules in the following order:
1972
1973   * Same branchcode and itemtype
1974   * Same branchcode, itemtype '*'
1975   * branchcode '*', same itemtype
1976   * branchcode and itemtype '*'
1977
1978 Neither C<$branchcode> nor C<$itemtype> should be '*'.
1979
1980 =cut
1981
1982 sub GetBranchItemRule {
1983     my ( $branchcode, $itemtype ) = @_;
1984
1985     # Search for rules!
1986     my $rules = Koha::CirculationRules->get_effective_rules({
1987         branchcode => $branchcode,
1988         itemtype => $itemtype,
1989         rules => ['holdallowed', 'hold_fulfillment_policy']
1990     });
1991
1992     # built-in default circulation rule
1993     $rules->{holdallowed} //= 'from_any_library';
1994     $rules->{hold_fulfillment_policy} //= 'any';
1995
1996     return $rules;
1997 }
1998
1999 =head2 AddReturn
2000
2001   ($doreturn, $messages, $iteminformation, $borrower) =
2002       &AddReturn( $barcode, $branch [,$exemptfine] [,$returndate] );
2003
2004 Returns a book.
2005
2006 =over 4
2007
2008 =item C<$barcode> is the bar code of the book being returned.
2009
2010 =item C<$branch> is the code of the branch where the book is being returned.
2011
2012 =item C<$exemptfine> indicates that overdue charges for the item will be
2013 removed. Optional.
2014
2015 =item C<$return_date> allows the default return date to be overridden
2016 by the given return date. Optional.
2017
2018 =back
2019
2020 C<&AddReturn> returns a list of four items:
2021
2022 C<$doreturn> is true iff the return succeeded.
2023
2024 C<$messages> is a reference-to-hash giving feedback on the operation.
2025 The keys of the hash are:
2026
2027 =over 4
2028
2029 =item C<BadBarcode>
2030
2031 No item with this barcode exists. The value is C<$barcode>.
2032
2033 =item C<NotIssued>
2034
2035 The book is not currently on loan. The value is C<$barcode>.
2036
2037 =item C<withdrawn>
2038
2039 This book has been withdrawn/cancelled. The value should be ignored.
2040
2041 =item C<Wrongbranch>
2042
2043 This book has was returned to the wrong branch.  The value is a hashref
2044 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
2045 contain the branchcode of the incorrect and correct return library, respectively.
2046
2047 =item C<ResFound>
2048
2049 The item was reserved. The value is a reference-to-hash whose keys are
2050 fields from the reserves table of the Koha database, and
2051 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
2052 either C<Waiting>, C<Reserved>, or 0.
2053
2054 =item C<WasReturned>
2055
2056 Value 1 if return is successful.
2057
2058 =item C<NeedsTransfer>
2059
2060 If AutomaticItemReturn is disabled, return branch is given as value of NeedsTransfer.
2061
2062 =item C<RecallFound>
2063
2064 This item can fill a recall. The recall object is returned. If the recall pickup branch differs from
2065 the branch this item is being returned at, C<RecallNeedsTransfer> is also returned which contains this
2066 branchcode.
2067
2068 =item C<TransferredRecall>
2069
2070 This item has been transferred to this branch to fill a recall. The recall object is returned.
2071
2072 =back
2073
2074 C<$iteminformation> is a reference-to-hash, giving information about the
2075 returned item from the issues table.
2076
2077 C<$borrower> is a reference-to-hash, giving information about the
2078 patron who last borrowed the book.
2079
2080 =cut
2081
2082 sub AddReturn {
2083     my ( $barcode, $branch, $exemptfine, $return_date ) = @_;
2084
2085     if ($branch and not Koha::Libraries->find($branch)) {
2086         warn "AddReturn error: branch '$branch' not found.  Reverting to " . C4::Context->userenv->{'branch'};
2087         undef $branch;
2088     }
2089     $branch = C4::Context->userenv->{'branch'} unless $branch;  # we trust userenv to be a safe fallback/default
2090     my $return_date_specified = !!$return_date;
2091     $return_date //= dt_from_string();
2092     my $messages;
2093     my $patron;
2094     my $doreturn       = 1;
2095     my $validTransfer = 1;
2096     my $stat_type = 'return';
2097
2098     # get information on item
2099     my $item = Koha::Items->find({ barcode => $barcode });
2100     unless ($item) {
2101         return ( 0, { BadBarcode => $barcode } );    # no barcode means no item or borrower.  bail out.
2102     }
2103
2104     my $itemnumber = $item->itemnumber;
2105     my $itemtype = $item->effective_itemtype;
2106
2107     my $issue  = $item->checkout;
2108     if ( $issue ) {
2109         $patron = $issue->patron
2110             or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existent borrowernumber '" . $issue->borrowernumber . "'\n"
2111                 . Dumper($issue->unblessed) . "\n";
2112     } else {
2113         $messages->{'NotIssued'} = $barcode;
2114         $item->onloan(undef)->store( { skip_record_index => 1, skip_holds_queue => 1 } ) if defined $item->onloan;
2115
2116         # even though item is not on loan, it may still be transferred;  therefore, get current branch info
2117         $doreturn = 0;
2118         # No issue, no borrowernumber.  ONLY if $doreturn, *might* you have a $borrower later.
2119         # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
2120         if (C4::Context->preference("RecordLocalUseOnReturn")) {
2121            $messages->{'LocalUse'} = 1;
2122            $stat_type = 'localuse';
2123         }
2124     }
2125
2126     if ( $item->withdrawn ) { # book has been cancelled
2127         $messages->{'withdrawn'} = 1;
2128
2129         # In the case where we block return of withdrawn, we should completely block the return
2130         # without updating item statuses, so we exit early
2131         return ( 0, $messages, $issue, ( $patron ? $patron->unblessed : {} ))
2132             if C4::Context->preference("BlockReturnOfWithdrawnItems");
2133     }
2134
2135
2136         # full item data, but no borrowernumber or checkout info (no issue)
2137     my $hbr = Koha::CirculationRules->get_return_branch_policy($item);
2138         # get the proper branch to which to return the item
2139     my $returnbranch = $hbr ne 'noreturn' ? $item->$hbr : $branch;
2140         # if $hbr was "noreturn" or any other non-item table value, then it should 'float' (i.e. stay at this branch)
2141     my $transfer_trigger = $hbr eq 'homebranch' ? 'ReturnToHome' : $hbr eq 'holdingbranch' ? 'ReturnToHolding' : undef;
2142
2143     my $borrowernumber = $patron ? $patron->borrowernumber : undef;    # we don't know if we had a borrower or not
2144     my $patron_unblessed = $patron ? $patron->unblessed : {};
2145
2146     my $update_loc_rules = C4::Context->yaml_preference('UpdateItemLocationOnCheckin');
2147     if ($update_loc_rules) {
2148         if ( defined $update_loc_rules->{_ALL_} ) {
2149             if ( $update_loc_rules->{_ALL_} eq '_PERM_' ) {
2150                 $update_loc_rules->{_ALL_} = $item->permanent_location;
2151             }
2152             if ( $update_loc_rules->{_ALL_} eq '_BLANK_' ) {
2153                 $update_loc_rules->{_ALL_} = '';
2154             }
2155             if (
2156                 (
2157                     defined $item->location
2158                     && $item->location ne $update_loc_rules->{_ALL_}
2159                 )
2160                 || ( !defined $item->location
2161                     && $update_loc_rules->{_ALL_} ne "" )
2162               )
2163             {
2164                 $messages->{'ItemLocationUpdated'} =
2165                   { from => $item->location, to => $update_loc_rules->{_ALL_} };
2166                 $item->location( $update_loc_rules->{_ALL_} )->store(
2167                     {
2168                         log_action        => 0,
2169                         skip_record_index => 1,
2170                         skip_holds_queue  => 1
2171                     }
2172                 );
2173             }
2174         }
2175         else {
2176             foreach my $key ( keys %$update_loc_rules ) {
2177                 if ( $update_loc_rules->{$key} eq '_PERM_' ) {
2178                     $update_loc_rules->{$key} = $item->permanent_location;
2179                 }
2180                 elsif ( $update_loc_rules->{$key} eq '_BLANK_' ) {
2181                     $update_loc_rules->{$key} = '';
2182                 }
2183                 if (
2184                     (
2185                            defined $item->location
2186                         && $item->location eq $key
2187                         && $item->location ne $update_loc_rules->{$key}
2188                     )
2189                     || (   $key eq '_BLANK_'
2190                         && ( !defined $item->location || $item->location eq '' )
2191                         && $update_loc_rules->{$key} ne '' )
2192                   )
2193                 {
2194                     $messages->{'ItemLocationUpdated'} = {
2195                         from => $item->location,
2196                         to   => $update_loc_rules->{$key}
2197                     };
2198                     $item->location( $update_loc_rules->{$key} )->store(
2199                         {
2200                             log_action        => 0,
2201                             skip_record_index => 1,
2202                             skip_holds_queue  => 1
2203                         }
2204                     );
2205                     last;
2206                 }
2207             }
2208         }
2209     }
2210
2211     my $yaml = C4::Context->preference('UpdateNotForLoanStatusOnCheckin');
2212     if ($yaml) {
2213         $yaml = "$yaml\n\n";  # YAML is anal on ending \n. Surplus does not hurt
2214         my $rules;
2215         eval { $rules = YAML::XS::Load(Encode::encode_utf8($yaml)); };
2216         if ($@) {
2217             warn "Unable to parse UpdateNotForLoanStatusOnCheckin syspref : $@";
2218         }
2219         else {
2220             foreach my $key ( keys %$rules ) {
2221                 if ( $item->notforloan eq $key ) {
2222                     $messages->{'NotForLoanStatusUpdated'} = { from => $item->notforloan, to => $rules->{$key} };
2223                     $item->notforloan($rules->{$key})->store({ log_action => 0, skip_record_index => 1, skip_holds_queue => 1 }) unless $rules->{$key} eq 'ONLYMESSAGE';
2224                     last;
2225                 }
2226             }
2227         }
2228     }
2229
2230     # check if the return is allowed at this branch
2231     my ($returnallowed, $message) = CanBookBeReturned($item->unblessed, $branch);
2232     unless ($returnallowed){
2233         $messages->{'Wrongbranch'} = {
2234             Wrongbranch => $branch,
2235             Rightbranch => $message
2236         };
2237         $doreturn = 0;
2238         my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
2239         $indexer->index_records( $item->biblionumber, "specialUpdate", "biblioserver" );
2240         return ( $doreturn, $messages, $issue, $patron_unblessed);
2241     }
2242
2243     if ( $item->itemlost and C4::Context->preference("BlockReturnOfLostItems") ) {
2244         $doreturn = 0;
2245     }
2246
2247     # case of a return of document (deal with issues and holdingbranch)
2248     if ($doreturn) {
2249         die "The item is not issed and cannot be returned" unless $issue; # Just in case...
2250         $patron or warn "AddReturn without current borrower";
2251
2252         if ($patron) {
2253             eval {
2254                 MarkIssueReturned( $borrowernumber, $item->itemnumber, $return_date, $patron->privacy, { skip_record_index => 1, skip_holds_queue => 1} );
2255             };
2256             unless ( $@ ) {
2257                 if (
2258                     (
2259                         C4::Context->preference('CalculateFinesOnReturn')
2260                         || ( $return_date_specified && C4::Context->preference('CalculateFinesOnBackdate') )
2261                     )
2262                     && !$item->itemlost
2263                   )
2264                 {
2265                     _CalculateAndUpdateFine( { issue => $issue, item => $item->unblessed, borrower => $patron_unblessed, return_date => $return_date } );
2266                 }
2267             } else {
2268                 carp "The checkin for the following issue failed, Please go to the about page and check all messages on the 'System information' to see if there are configuration / data issues ($@)" . Dumper( $issue->unblessed );
2269
2270                 my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
2271                 $indexer->index_records( $item->biblionumber, "specialUpdate", "biblioserver" );
2272
2273                 return ( 0, { WasReturned => 0, DataCorrupted => 1 }, $issue, $patron_unblessed );
2274             }
2275
2276             # FIXME is the "= 1" right?  This could be the borrower hash.
2277             $messages->{'WasReturned'} = 1;
2278
2279         } else {
2280             $item->onloan(undef)->store({ log_action => 0 , skip_record_index => 1, skip_holds_queue => 1 });
2281         }
2282     }
2283
2284     # the holdingbranch is updated if the document is returned to another location.
2285     # this is always done regardless of whether the item was on loan or not
2286     if ($item->holdingbranch ne $branch) {
2287         $item->holdingbranch($branch)->store({ log_action => 0, skip_record_index => 1, skip_holds_queue => 1 });
2288     }
2289
2290     my $item_was_lost = $item->itemlost;
2291     my $leave_item_lost = C4::Context->preference("BlockReturnOfLostItems") ? 1 : 0;
2292     my $updated_item = ModDateLastSeen( $item->itemnumber, $leave_item_lost, { skip_record_index => 1, skip_holds_queue => 1 } ); # will unset itemlost if needed
2293
2294     # fix up the accounts.....
2295     if ($item_was_lost) {
2296         $messages->{'WasLost'} = 1;
2297         unless ( C4::Context->preference("BlockReturnOfLostItems") ) {
2298             my @object_messages = @{ $updated_item->object_messages };
2299             for my $message (@object_messages) {
2300                 $messages->{'LostItemFeeRefunded'} = 1
2301                   if $message->message eq 'lost_refunded';
2302                 $messages->{'ProcessingFeeRefunded'} = 1
2303                   if $message->message eq 'processing_refunded';
2304                 $messages->{'LostItemFeeRestored'} = 1
2305                   if $message->message eq 'lost_restored';
2306
2307                 if ( $message->message eq 'lost_charge' ) {
2308                     $issue //= Koha::Old::Checkouts->search(
2309                         { itemnumber => $item->itemnumber },
2310                         { order_by   => { '-desc' => 'returndate' }, rows => 1 }
2311                     )->single;
2312                     unless ( exists( $patron_unblessed->{branchcode} ) ) {
2313                         my $patron = $issue->patron;
2314                         $patron_unblessed = $patron->unblessed;
2315                     }
2316                     _CalculateAndUpdateFine(
2317                         {
2318                             issue       => $issue,
2319                             item        => $item->unblessed,
2320                             borrower    => $patron_unblessed,
2321                             return_date => $return_date
2322                         }
2323                     );
2324                     _FixOverduesOnReturn( $patron_unblessed->{borrowernumber},
2325                         $item->itemnumber, undef, 'RETURNED' );
2326                     $messages->{'LostItemFeeCharged'} = 1;
2327                 }
2328             }
2329         }
2330     }
2331
2332     # check if we have a transfer for this document
2333     my $transfer = $item->get_transfer;
2334
2335     # if we have a transfer to complete, we update the line of transfers with the datearrived
2336     if ($transfer) {
2337         $validTransfer = 0;
2338         if ( $transfer->in_transit ) {
2339             if ( $transfer->tobranch eq $branch ) {
2340                 $transfer->receive;
2341                 $messages->{'TransferArrived'} = $transfer->frombranch;
2342                 # validTransfer=1 allows us returning the item back if the reserve is cancelled
2343                 $validTransfer = 1
2344                   if defined $transfer->reason && $transfer->reason eq 'Reserve';
2345             }
2346             else {
2347                 $messages->{'WrongTransfer'}     = $transfer->tobranch;
2348                 $messages->{'WrongTransferItem'} = $item->itemnumber;
2349                 $messages->{'TransferTrigger'}   = $transfer->reason;
2350             }
2351         }
2352         else {
2353             if ( $transfer->tobranch eq $branch ) {
2354                 $transfer->receive;
2355                 $messages->{'TransferArrived'} = $transfer->frombranch;
2356                 # validTransfer=1 allows us returning the item back if the reserve is cancelled
2357                 $validTransfer = 1 if $transfer->reason eq 'Reserve';
2358             }
2359             else {
2360                 $messages->{'TransferTrigger'} = $transfer->reason;
2361                 if ( $transfer->frombranch eq $branch ) {
2362                     $transfer->transit;
2363                     $messages->{'WasTransfered'}   = $transfer->tobranch;
2364                 }
2365                 else {
2366                     $messages->{'WrongTransfer'}     = $transfer->tobranch;
2367                     $messages->{'WrongTransferItem'} = $item->itemnumber;
2368                 }
2369             }
2370         }
2371     }
2372
2373     # fix up the overdues in accounts...
2374     if ($borrowernumber) {
2375         my $fix = _FixOverduesOnReturn( $borrowernumber, $item->itemnumber, $exemptfine, 'RETURNED' );
2376         defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, ".$item->itemnumber."...) failed!";  # zero is OK, check defined
2377
2378         if ( $issue and $issue->is_overdue($return_date) ) {
2379         # fix fine days
2380             my ($debardate,$reminder) = _debar_user_on_return( $patron_unblessed, $item->unblessed, dt_from_string($issue->date_due), $return_date );
2381             if ($debardate and $debardate ne "9999-12-31") {
2382                 if ($reminder){
2383                     $messages->{'PrevDebarred'} = $debardate;
2384                 } else {
2385                     $messages->{'Debarred'} = $debardate;
2386                 }
2387             } elsif ($patron->debarred) {
2388                 if ( $patron->debarred eq "9999-12-31") {
2389                     $messages->{'ForeverDebarred'} = $patron->debarred;
2390                 } else {
2391                     my $borrower_debar_dt = dt_from_string( $patron->debarred );
2392                     $borrower_debar_dt->truncate(to => 'day');
2393                     my $today_dt = $return_date->clone()->truncate(to => 'day');
2394                     if ( DateTime->compare( $borrower_debar_dt, $today_dt ) != -1 ) {
2395                         $messages->{'PrevDebarred'} = $patron->debarred;
2396                     }
2397                 }
2398             }
2399         # there's no overdue on the item but borrower had been previously debarred
2400         } elsif ( $issue->date_due and $patron->debarred ) {
2401              if ( $patron->debarred eq "9999-12-31") {
2402                 $messages->{'ForeverDebarred'} = $patron->debarred;
2403              } else {
2404                   my $borrower_debar_dt = dt_from_string( $patron->debarred );
2405                   $borrower_debar_dt->truncate(to => 'day');
2406                   my $today_dt = $return_date->clone()->truncate(to => 'day');
2407                   if ( DateTime->compare( $borrower_debar_dt, $today_dt ) != -1 ) {
2408                       $messages->{'PrevDebarred'} = $patron->debarred;
2409                   }
2410              }
2411         }
2412     }
2413
2414     # find recalls...
2415     if ( C4::Context->preference('UseRecalls') ) {
2416         # check if this item is recallable first, which includes checking if UseRecalls syspref is enabled
2417         my $recall = undef;
2418         $recall = $item->check_recalls if $item->can_be_waiting_recall;
2419         if ( defined $recall ) {
2420             $messages->{RecallFound} = $recall;
2421             if ( $recall->pickup_library_id ne $branch ) {
2422                 $messages->{RecallNeedsTransfer} = $branch;
2423             }
2424         }
2425     }
2426
2427     # find reserves.....
2428     # launch the Checkreserves routine to find any holds
2429     my ($resfound, $resrec);
2430     my $lookahead= C4::Context->preference('ConfirmFutureHolds'); #number of days to look for future holds
2431     ($resfound, $resrec, undef) = CheckReserves( $item, $lookahead ) unless ( $item->withdrawn );
2432     # if a hold is found and is waiting at another branch, change the priority back to 1 and trigger the hold (this will trigger a transfer and update the hold status properly)
2433     if ( $resfound and $resfound eq "Waiting" and $branch ne $resrec->{branchcode} ) {
2434         my $hold = C4::Reserves::RevertWaitingStatus( { itemnumber => $item->itemnumber } );
2435         $resfound = 'Reserved';
2436         $resrec = $hold->unblessed;
2437     }
2438     if ($resfound) {
2439           $resrec->{'ResFound'} = $resfound;
2440         $messages->{'ResFound'} = $resrec;
2441     }
2442
2443     # Record the fact that this book was returned.
2444     my $categorycode = $patron_unblessed ? $patron_unblessed->{categorycode} : undef;
2445     C4::Stats::UpdateStats({
2446         branch         => $branch,
2447         type           => $stat_type,
2448         itemnumber     => $itemnumber,
2449         itemtype       => $itemtype,
2450         location       => $item->location,
2451         borrowernumber => $borrowernumber,
2452         ccode          => $item->ccode,
2453         categorycode   => $categorycode,
2454         interface      => C4::Context->interface,
2455     });
2456
2457     # Send a check-in slip. # NOTE: borrower may be undef. Do not try to send messages then.
2458     if ( $patron ) {
2459         my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2460         my %conditions = (
2461             branchcode   => $branch,
2462             categorycode => $patron->categorycode,
2463             item_type    => $itemtype,
2464             notification => 'CHECKIN',
2465         );
2466         if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
2467             SendCirculationAlert({
2468                 type     => 'CHECKIN',
2469                 item     => $item->unblessed,
2470                 borrower => $patron->unblessed,
2471                 branch   => $branch,
2472                 issue    => $issue
2473             });
2474         }
2475
2476         logaction("CIRCULATION", "RETURN", $borrowernumber, $item->itemnumber)
2477             if C4::Context->preference("ReturnLog");
2478         }
2479
2480     # Check if this item belongs to a biblio record that is attached to an
2481     # ILL request, if it is we need to update the ILL request's status
2482     if ( $doreturn and C4::Context->preference('CirculateILL')) {
2483         my $request = Koha::Illrequests->find(
2484             { biblio_id => $item->biblio->biblionumber }
2485         );
2486         $request->status('RET') if $request;
2487     }
2488
2489     if ( C4::Context->preference('UseRecalls') ) {
2490         # all recalls that have triggered a transfer will have an allocated itemnumber
2491         my $transfer_recall = Koha::Recalls->find({ item_id => $item->itemnumber, status => 'in_transit' });
2492         if ( $transfer_recall and $transfer_recall->pickup_library_id eq $branch ) {
2493             $messages->{TransferredRecall} = $transfer_recall;
2494         }
2495     }
2496
2497     # Transfer to returnbranch if Automatic transfer set or append message NeedsTransfer
2498     if ( $validTransfer && !C4::RotatingCollections::isItemInAnyCollection( $item->itemnumber )
2499         && ( $doreturn or $messages->{'NotIssued'} )
2500         and !$resfound
2501         and ( $branch ne $returnbranch )
2502         and not $messages->{'WrongTransfer'}
2503         and not $messages->{'WasTransfered'}
2504         and not $messages->{TransferredRecall}
2505         and not $messages->{RecallNeedsTransfer} )
2506     {
2507         my $BranchTransferLimitsType = C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ? 'effective_itemtype' : 'ccode';
2508         if  (C4::Context->preference("AutomaticItemReturn"    ) or
2509             (C4::Context->preference("UseBranchTransferLimits") and
2510              ! IsBranchTransferAllowed($branch, $returnbranch, $item->$BranchTransferLimitsType )
2511            )) {
2512             ModItemTransfer($item->itemnumber, $branch, $returnbranch, $transfer_trigger, { skip_record_index => 1 });
2513             $messages->{'WasTransfered'} = $returnbranch;
2514             $messages->{'TransferTrigger'} = $transfer_trigger;
2515         } else {
2516             $messages->{'NeedsTransfer'} = $returnbranch;
2517             $messages->{'TransferTrigger'} = $transfer_trigger;
2518         }
2519     }
2520
2521     if ( C4::Context->preference('ClaimReturnedLostValue') ) {
2522         my $claims = Koha::Checkouts::ReturnClaims->search(
2523            {
2524                itemnumber => $item->id,
2525                resolution => undef,
2526            }
2527         );
2528
2529         if ( $claims->count ) {
2530             $messages->{ReturnClaims} = $claims;
2531         }
2532     }
2533
2534     # Check for bundle status
2535     if ( $item->in_bundle ) {
2536         my $host = $item->bundle_host;
2537         $messages->{InBundle} = $host;
2538     }
2539
2540     my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
2541     $indexer->index_records( $item->biblionumber, "specialUpdate", "biblioserver" );
2542
2543     if ( $doreturn and $issue ) {
2544         my $checkin = Koha::Old::Checkouts->find($issue->id);
2545
2546         Koha::Plugins->call('after_circ_action', {
2547             action  => 'checkin',
2548             payload => {
2549                 checkout=> $checkin
2550             }
2551         });
2552
2553         Koha::BackgroundJob::BatchUpdateBiblioHoldsQueue->new->enqueue(
2554             {
2555                 biblio_ids => [ $item->biblionumber ]
2556             }
2557         ) if C4::Context->preference('RealTimeHoldsQueue');
2558     }
2559
2560     return ( $doreturn, $messages, $issue, ( $patron ? $patron->unblessed : {} ));
2561 }
2562
2563 =head2 MarkIssueReturned
2564
2565   MarkIssueReturned($borrowernumber, $itemnumber, $returndate, $privacy, [$params] );
2566
2567 Unconditionally marks an issue as being returned by
2568 moving the C<issues> row to C<old_issues> and
2569 setting C<returndate> to the current date.
2570
2571 if C<$returndate> is specified (in iso format), it is used as the date
2572 of the return.
2573
2574 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
2575 the old_issue is immediately anonymised
2576
2577 Ideally, this function would be internal to C<C4::Circulation>,
2578 not exported, but it is currently used in misc/cronjobs/longoverdue.pl
2579 and offline_circ/process_koc.pl.
2580
2581 The last optional parameter allos passing skip_record_index to the item store call.
2582
2583 =cut
2584
2585 sub MarkIssueReturned {
2586     my ( $borrowernumber, $itemnumber, $returndate, $privacy, $params ) = @_;
2587
2588     # Retrieve the issue
2589     my $issue = Koha::Checkouts->find( { itemnumber => $itemnumber } ) or return;
2590
2591     return unless $issue->borrowernumber == $borrowernumber; # If the item is checked out to another patron we do not return it
2592
2593     my $issue_id = $issue->issue_id;
2594
2595     my $schema = Koha::Database->schema;
2596
2597     # FIXME Improve the return value and handle it from callers
2598     $schema->txn_do(sub {
2599
2600         my $patron = Koha::Patrons->find( $borrowernumber );
2601
2602         # Update the returndate value
2603         if ( $returndate ) {
2604             $issue->returndate( $returndate )->store->discard_changes; # update and refetch
2605         }
2606         else {
2607             $issue->returndate( \'NOW()' )->store->discard_changes; # update and refetch
2608         }
2609
2610         # Create the old_issues entry
2611         my $old_checkout = Koha::Old::Checkout->new($issue->unblessed)->store;
2612
2613         # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
2614         if ( $privacy && $privacy == 2) {
2615             $old_checkout->anonymize;
2616         }
2617
2618         # And finally delete the issue
2619         $issue->delete;
2620
2621         $issue->item->onloan(undef)->store(
2622             {   log_action        => 0,
2623                 skip_record_index => $params->{skip_record_index},
2624                 skip_holds_queue  => $params->{skip_holds_queue}
2625             }
2626         );
2627
2628         if ( C4::Context->preference('StoreLastBorrower') ) {
2629             my $item = Koha::Items->find( $itemnumber );
2630             $item->last_returned_by( $patron->borrowernumber )->store;
2631         }
2632
2633         # Remove any OVERDUES related debarment if the borrower has no overdues
2634         my $overdue_restrictions = $patron->restrictions->search({ type => 'OVERDUES' });
2635         if ( C4::Context->preference('AutoRemoveOverduesRestrictions')
2636           && $patron->debarred
2637           && !$patron->has_overdues
2638           && $overdue_restrictions->count
2639         ) {
2640             DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2641         }
2642
2643     });
2644
2645     return $issue_id;
2646 }
2647
2648 =head2 _debar_user_on_return
2649
2650     _debar_user_on_return($borrower, $item, $datedue, $returndate);
2651
2652 C<$borrower> borrower hashref
2653
2654 C<$item> item hashref
2655
2656 C<$datedue> date due DateTime object
2657
2658 C<$returndate> DateTime object representing the return time
2659
2660 Internal function, called only by AddReturn that calculates and updates
2661  the user fine days, and debars them if necessary.
2662
2663 Should only be called for overdue returns
2664
2665 Calculation of the debarment date has been moved to a separate subroutine _calculate_new_debar_dt
2666 to ease testing.
2667
2668 =cut
2669
2670 sub _calculate_new_debar_dt {
2671     my ( $borrower, $item, $dt_due, $return_date ) = @_;
2672
2673     my $branchcode = _GetCircControlBranch( $item, $borrower );
2674     my $circcontrol = C4::Context->preference('CircControl');
2675     my $issuing_rule = Koha::CirculationRules->get_effective_rules(
2676         {   categorycode => $borrower->{categorycode},
2677             itemtype     => $item->{itype},
2678             branchcode   => $branchcode,
2679             rules => [
2680                 'finedays',
2681                 'lengthunit',
2682                 'firstremind',
2683                 'maxsuspensiondays',
2684                 'suspension_chargeperiod',
2685             ]
2686         }
2687     );
2688     my $finedays = $issuing_rule ? $issuing_rule->{finedays} : undef;
2689     my $unit     = $issuing_rule ? $issuing_rule->{lengthunit} : undef;
2690     my $chargeable_units = C4::Overdues::get_chargeable_units($unit, $dt_due, $return_date, $branchcode);
2691
2692     return unless $finedays;
2693
2694     # finedays is in days, so hourly loans must multiply by 24
2695     # thus 1 hour late equals 1 day suspension * finedays rate
2696     $finedays = $finedays * 24 if ( $unit eq 'hours' );
2697
2698     # grace period is measured in the same units as the loan
2699     my $grace =
2700       DateTime::Duration->new( $unit => $issuing_rule->{firstremind} // 0);
2701
2702     my $deltadays = DateTime::Duration->new(
2703         days => $chargeable_units
2704     );
2705
2706     if ( $deltadays->subtract($grace)->is_positive() ) {
2707         my $suspension_days = $deltadays * $finedays;
2708
2709         if ( defined $issuing_rule->{suspension_chargeperiod} && $issuing_rule->{suspension_chargeperiod} > 1 ) {
2710             # No need to / 1 and do not consider / 0
2711             $suspension_days = DateTime::Duration->new(
2712                 days => floor( $suspension_days->in_units('days') / $issuing_rule->{suspension_chargeperiod} )
2713             );
2714         }
2715
2716         # If the max suspension days is < than the suspension days
2717         # the suspension days is limited to this maximum period.
2718         my $max_sd = $issuing_rule->{maxsuspensiondays};
2719         if ( defined $max_sd && $max_sd ne '' ) {
2720             $max_sd = DateTime::Duration->new( days => $max_sd );
2721             $suspension_days = $max_sd
2722               if DateTime::Duration->compare( $max_sd, $suspension_days ) < 0;
2723         }
2724
2725         my ( $has_been_extended );
2726         if ( C4::Context->preference('CumulativeRestrictionPeriods') and $borrower->{debarred} ) {
2727             my $patron = Koha::Patrons->find($borrower->{borrowernumber});
2728             my $debarment = $patron->restrictions->search({type => 'SUSPENSION' },{rows => 1})->single;
2729             if ( $debarment ) {
2730                 $return_date = dt_from_string( $debarment->expiration, 'sql' );
2731                 $has_been_extended = 1;
2732             }
2733         }
2734
2735         my $new_debar_dt;
2736         # Use the calendar or not to calculate the debarment date
2737         if ( C4::Context->preference('SuspensionsCalendar') eq 'noSuspensionsWhenClosed' ) {
2738             my $calendar = Koha::Calendar->new(
2739                 branchcode => $branchcode,
2740                 days_mode  => 'Calendar'
2741             );
2742             $new_debar_dt = $calendar->addDuration( $return_date, $suspension_days );
2743         }
2744         else {
2745             $new_debar_dt = $return_date->clone()->add_duration($suspension_days);
2746         }
2747         return $new_debar_dt;
2748     }
2749     return;
2750 }
2751
2752 sub _debar_user_on_return {
2753     my ( $borrower, $item, $dt_due, $return_date ) = @_;
2754
2755     $return_date //= dt_from_string();
2756
2757     my $new_debar_dt = _calculate_new_debar_dt ($borrower, $item, $dt_due, $return_date);
2758
2759     return unless $new_debar_dt;
2760
2761     Koha::Patron::Debarments::AddUniqueDebarment({
2762         borrowernumber => $borrower->{borrowernumber},
2763         expiration     => $new_debar_dt->ymd(),
2764         type           => 'SUSPENSION',
2765     });
2766     # if borrower was already debarred but does not get an extra debarment
2767     my $patron = Koha::Patrons->find( $borrower->{borrowernumber} );
2768     my ($new_debarment_str, $is_a_reminder);
2769     if ( $borrower->{debarred} && $borrower->{debarred} eq $patron->is_debarred ) {
2770         $is_a_reminder = 1;
2771         $new_debarment_str = $borrower->{debarred};
2772     } else {
2773         $new_debarment_str = $new_debar_dt->ymd();
2774     }
2775     # FIXME Should return a DateTime object
2776     return $new_debarment_str, $is_a_reminder;
2777 }
2778
2779 =head2 _FixOverduesOnReturn
2780
2781    &_FixOverduesOnReturn($borrowernumber, $itemnumber, $exemptfine, $status);
2782
2783 C<$borrowernumber> borrowernumber
2784
2785 C<$itemnumber> itemnumber
2786
2787 C<$exemptfine> BOOL -- remove overdue charge associated with this issue. 
2788
2789 C<$status> ENUM -- reason for fix [ RETURNED, RENEWED, LOST, FORGIVEN ]
2790
2791 Internal function
2792
2793 =cut
2794
2795 sub _FixOverduesOnReturn {
2796     my ( $borrowernumber, $item, $exemptfine, $status ) = @_;
2797     unless( $borrowernumber ) {
2798         warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
2799         return;
2800     }
2801     unless( $item ) {
2802         warn "_FixOverduesOnReturn() not supplied valid itemnumber";
2803         return;
2804     }
2805     unless( $status ) {
2806         warn "_FixOverduesOnReturn() not supplied valid status";
2807         return;
2808     }
2809
2810     my $schema = Koha::Database->schema;
2811
2812     my $result = $schema->txn_do(
2813         sub {
2814             # check for overdue fine
2815             my $accountlines = Koha::Account::Lines->search(
2816                 {
2817                     borrowernumber  => $borrowernumber,
2818                     itemnumber      => $item,
2819                     debit_type_code => 'OVERDUE',
2820                     status          => 'UNRETURNED'
2821                 }
2822             );
2823             return 0 unless $accountlines->count; # no warning, there's just nothing to fix
2824
2825             my $accountline = $accountlines->next;
2826             my $payments = $accountline->credits;
2827
2828             my $amountoutstanding = $accountline->amountoutstanding;
2829             if ( $accountline->amount == 0 && $payments->count == 0 ) {
2830                 $accountline->delete;
2831                 return 0; # no warning, we've just removed a zero value fine (backdated return)
2832             } elsif ($exemptfine && ($amountoutstanding != 0)) {
2833                 my $account = Koha::Account->new({patron_id => $borrowernumber});
2834                 my $credit = $account->add_credit(
2835                     {
2836                         amount     => $amountoutstanding,
2837                         user_id    => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
2838                         library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
2839                         interface  => C4::Context->interface,
2840                         type       => 'FORGIVEN',
2841                         item_id    => $item
2842                     }
2843                 );
2844
2845                 $credit->apply({ debits => [ $accountline ] });
2846
2847                 if (C4::Context->preference("FinesLog")) {
2848                     &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
2849                 }
2850             }
2851
2852             $accountline->status($status);
2853             return $accountline->store();
2854         }
2855     );
2856
2857     return $result;
2858 }
2859
2860 =head2 _GetCircControlBranch
2861
2862    my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2863
2864 Internal function : 
2865
2866 Return the library code to be used to determine which circulation
2867 policy applies to a transaction.  Looks up the CircControl and
2868 HomeOrHoldingBranch system preferences.
2869
2870 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2871
2872 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2873
2874 =cut
2875
2876 sub _GetCircControlBranch {
2877     my ($item, $borrower) = @_;
2878     my $circcontrol = C4::Context->preference('CircControl');
2879     my $branch;
2880
2881     if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2882         $branch= C4::Context->userenv->{'branch'};
2883     } elsif ($circcontrol eq 'PatronLibrary') {
2884         $branch=$borrower->{branchcode};
2885     } else {
2886         my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2887         $branch = $item->{$branchfield};
2888         # default to item home branch if holdingbranch is used
2889         # and is not defined
2890         if (!defined($branch) && $branchfield eq 'holdingbranch') {
2891             $branch = $item->{homebranch};
2892         }
2893     }
2894     return $branch;
2895 }
2896
2897 =head2 GetUpcomingDueIssues
2898
2899   my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2900
2901 =cut
2902
2903 sub GetUpcomingDueIssues {
2904     my $params = shift;
2905
2906     $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2907     my $dbh = C4::Context->dbh;
2908     my $statement;
2909     $statement = q{
2910         SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2911         FROM issues
2912         LEFT JOIN items USING (itemnumber)
2913         LEFT JOIN branches ON branches.branchcode =
2914     };
2915     $statement .= $params->{'owning_library'} ? " items.homebranch " : " issues.branchcode ";
2916     $statement .= " WHERE returndate is NULL AND TO_DAYS( date_due )-TO_DAYS( NOW() ) BETWEEN 0 AND ?";
2917     my @bind_parameters = ( $params->{'days_in_advance'} );
2918     
2919     my $sth = $dbh->prepare( $statement );
2920     $sth->execute( @bind_parameters );
2921     my $upcoming_dues = $sth->fetchall_arrayref({});
2922
2923     return $upcoming_dues;
2924 }
2925
2926 =head2 CanBookBeRenewed
2927
2928   ($ok,$error,$info) = &CanBookBeRenewed($patron, $issue, $override_limit);
2929
2930 Find out whether a borrowed item may be renewed.
2931
2932 C<$patron> is the patron who currently has the issue.
2933
2934 C<$issue> is the checkout to renew.
2935
2936 C<$override_limit>, if supplied with a true value, causes
2937 the limit on the number of times that the loan can be renewed
2938 (as controlled by the item type) to be ignored. Overriding also allows
2939 to renew sooner than "No renewal before" and to manually renew loans
2940 that are automatically renewed.
2941
2942 C<$CanBookBeRenewed> returns a true value if the item may be renewed. The
2943 item must currently be on loan to the specified borrower; renewals
2944 must be allowed for the item's type; and the borrower must not have
2945 already renewed the loan.
2946     $error will contain the reason the renewal can not proceed
2947     $info will contain a hash of additional info
2948       currently 'soonest_renew_date' if error is 'too soon'
2949
2950 =cut
2951
2952 sub CanBookBeRenewed {
2953     my ( $patron, $issue, $override_limit, $cron ) = @_;
2954
2955     my $auto_renew = "no";
2956     my $soonest;
2957     my $item = $issue->item;
2958
2959     return ( 0, 'no_item' ) unless $item;
2960     return ( 0, 'no_checkout' ) unless $issue;
2961     return ( 0, 'onsite_checkout' ) if $issue->onsite_checkout;
2962     return ( 0, 'item_issued_to_other_patron') if $issue->borrowernumber != $patron->borrowernumber;
2963     return ( 0, 'item_denied_renewal') if $item->is_denied_renewal;
2964
2965        # override_limit will override anything else except on_reserve
2966     unless ( $override_limit ){
2967         my $branchcode = _GetCircControlBranch( $item->unblessed, $patron->unblessed );
2968         my $issuing_rule = Koha::CirculationRules->get_effective_rules(
2969             {
2970                 categorycode => $patron->categorycode,
2971                 itemtype     => $item->effective_itemtype,
2972                 branchcode   => $branchcode,
2973                 rules => [
2974                     'renewalsallowed',
2975                     'lengthunit',
2976                     'unseen_renewals_allowed'
2977                 ]
2978             }
2979         );
2980
2981         return ( 0, "too_many" )
2982           if not $issuing_rule->{renewalsallowed} or $issuing_rule->{renewalsallowed} <= $issue->renewals_count;
2983
2984         return ( 0, "too_unseen" )
2985           if C4::Context->preference('UnseenRenewals') &&
2986             looks_like_number($issuing_rule->{unseen_renewals_allowed}) &&
2987             $issuing_rule->{unseen_renewals_allowed} <= $issue->unseen_renewals;
2988
2989         my $overduesblockrenewing = C4::Context->preference('OverduesBlockRenewing');
2990         my $restrictionblockrenewing = C4::Context->preference('RestrictionBlockRenewing');
2991         my $restricted  = $patron->is_debarred;
2992         my $hasoverdues = $patron->has_overdues;
2993
2994         if ( $restricted and $restrictionblockrenewing ) {
2995             return ( 0, 'restriction');
2996         } elsif ( ($hasoverdues and $overduesblockrenewing eq 'block') || ($issue->is_overdue and $overduesblockrenewing eq 'blockitem') ) {
2997             return ( 0, 'overdue');
2998         }
2999
3000         ( $auto_renew, $soonest ) = _CanBookBeAutoRenewed({
3001             patron     => $patron,
3002             item       => $item,
3003             branchcode => $branchcode,
3004             issue      => $issue
3005         });
3006         return ( 0, $auto_renew, { soonest_renew_date => $soonest } ) if $auto_renew =~ 'auto_too_soon' && $cron;
3007         # cron wants 'too_soon' over 'on_reserve' for performance and to avoid
3008         # extra notices being sent. Cron also implies no override
3009         return ( 0, $auto_renew  ) if $auto_renew =~ 'auto_account_expired';
3010         return ( 0, $auto_renew  ) if $auto_renew =~ 'auto_too_late';
3011         return ( 0, $auto_renew  ) if $auto_renew =~ 'auto_too_much_oweing';
3012     }
3013
3014     if ( C4::Context->preference('UseRecalls') ) {
3015         my $recall = undef;
3016         $recall = $item->check_recalls if $item->can_be_waiting_recall;
3017         if ( defined $recall ) {
3018             if ( $recall->item_level ) {
3019                 # item-level recall. check if this item is the recalled item, otherwise renewal will be allowed
3020                 return ( 0, 'recalled' ) if ( $recall->item_id == $item->itemnumber );
3021             } else {
3022                 # biblio-level recall, so only disallow renewal if the biblio-level recall has been fulfilled by a different item
3023                 return ( 0, 'recalled' ) unless ( $recall->waiting );
3024             }
3025         }
3026     }
3027
3028     # There is an item level hold on this item, no other item can fill the hold
3029     return ( 0, "on_reserve" )
3030       if ( $item->current_holds->search( { non_priority => 0 } )->count );
3031
3032     my $fillable_holds = Koha::Holds->search(
3033         {
3034             biblionumber => $item->biblionumber,
3035             non_priority => 0,
3036             found        => undef,
3037             reservedate  => { '<=' => \'NOW()' },
3038             suspend      => 0
3039         }
3040     );
3041     if ( $fillable_holds->count ) {
3042         if ( C4::Context->preference('AllowRenewalIfOtherItemsAvailable') ) {
3043             my @possible_holds = $fillable_holds->as_list;
3044
3045             # Get all other items that could possibly fill reserves
3046             # FIXME We could join reserves (or more tables) here to eliminate some checks later
3047             my @other_items = Koha::Items->search({
3048                 biblionumber => $item->biblionumber,
3049                 onloan       => undef,
3050                 notforloan   => 0,
3051                 -not         => { itemnumber => $item->itemnumber } })->as_list;
3052
3053             return ( 0, "on_reserve" ) if @possible_holds && (scalar @other_items < scalar @possible_holds);
3054
3055             my %matched_items;
3056             foreach my $possible_hold (@possible_holds) {
3057                 my $fillable = 0;
3058                 my $patron_with_reserve = Koha::Patrons->find($possible_hold->borrowernumber);
3059
3060                 # FIXME: We are not checking whether the item we are renewing can fill the hold
3061
3062                 foreach my $other_item (@other_items) {
3063                   next if defined $matched_items{$other_item->itemnumber};
3064                   next if IsItemOnHoldAndFound( $other_item->itemnumber );
3065                   next unless IsAvailableForItemLevelRequest($other_item, $patron_with_reserve, undef);
3066                   next unless CanItemBeReserved($patron_with_reserve,$other_item,undef,{ignore_hold_counts=>1})->{status} eq 'OK';
3067                   # NOTE: At checkin we call 'CheckReserves' which checks hold 'policy'
3068                   # CanItemBeReserved checks 'rules' and 'policies' which means
3069                   # items will fill holds at checkin that are rejected here
3070                   $fillable = 1;
3071                   $matched_items{$other_item->itemnumber} = 1;
3072                   last;
3073                 }
3074                 return ( 0, "on_reserve" ) unless $fillable;
3075             }
3076         }
3077         else {
3078             my ($status, $matched_reserve, $possible_reserves) = CheckReserves($item);
3079             return ( 0, "on_reserve" ) if $status;
3080         }
3081     }
3082
3083     return ( 0, $auto_renew, { soonest_renew_date => $soonest } ) if $auto_renew =~ 'too_soon';#$auto_renew ne "no" && $auto_renew ne "ok";
3084     $soonest = GetSoonestRenewDate($patron, $issue);
3085     if ( $soonest > dt_from_string() ){
3086         return (0, "too_soon", { soonest_renew_date => $soonest } ) unless $override_limit;
3087     }
3088
3089     return ( 0, "auto_renew" ) if $auto_renew eq "ok" && !$override_limit; # 0 if auto-renewal should not succeed
3090
3091     return ( 1, undef );
3092 }
3093
3094 =head2 AddRenewal
3095
3096   $new_date_due = AddRenewal({
3097       borrowernumber   => $borrowernumber,
3098       itemnumber       => $itemnumber,
3099       branch           => $branch,
3100       [datedue         => $datedue],
3101       [lastreneweddate => $lastreneweddate],
3102       [skipfinecalc    => $skipfinecalc],
3103       [seen            => $seen],
3104       [automatic       => $automatic],
3105       [skip_record_index => $skip_record_index]
3106   });
3107
3108 Renews a loan, returns the updated due date upon success.
3109
3110 C<$borrowernumber> is the borrower number of the patron who currently
3111 has the item.
3112
3113 C<$itemnumber> is the number of the item to renew.
3114
3115 C<$branch> is the library where the renewal took place (if any).
3116            The library that controls the circ policies for the renewal is retrieved from the issues record.
3117
3118 C<$datedue> can be a DateTime object used to set the due date.
3119
3120 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate.  If
3121 this parameter is not supplied, lastreneweddate is set to the current date.
3122
3123 C<$skipfinecalc> is an optional boolean. There may be circumstances where, even if the
3124 CalculateFinesOnReturn syspref is enabled, we don't want to calculate fines upon renew,
3125 for example, when we're renewing as a result of a fine being paid (see RenewAccruingItemWhenPaid
3126 syspref)
3127
3128 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
3129 from the book's item type.
3130
3131 C<$seen> is a boolean flag indicating if the item was seen or not during the renewal. This
3132 informs the incrementing of the unseen_renewals column. If this flag is not supplied, we
3133 fallback to a true value
3134
3135 C<$automatic> is a boolean flag indicating the renewal was triggered automatically and not by a person ( librarian or patron )
3136
3137 C<$skip_record_index> is an optional boolean flag to indicate whether queuing the search indexing
3138 should be skipped for this renewal.
3139
3140 =cut
3141
3142 sub AddRenewal {
3143     my $params = shift;
3144
3145     my $borrowernumber  = $params->{borrowernumber};
3146     my $itemnumber      = $params->{itemnumber};
3147     return unless $itemnumber;
3148
3149     my $branch            = $params->{branch};
3150     my $datedue           = $params->{datedue};
3151     my $lastreneweddate   = $params->{lastreneweddate} // dt_from_string();
3152     my $skipfinecalc      = $params->{skipfinecalc};
3153     my $seen              = $params->{seen};
3154     my $automatic         = $params->{automatic};
3155     my $skip_record_index = $params->{skip_record_index};
3156
3157     # Fallback on a 'seen' renewal
3158     $seen = defined $seen && $seen == 0 ? 0 : 1;
3159
3160     my $item_object   = Koha::Items->find($itemnumber) or return;
3161     my $biblio = $item_object->biblio;
3162     my $issue  = $item_object->checkout;
3163     my $item_unblessed = $item_object->unblessed;
3164
3165     my $renewal_type = $automatic ? "Automatic" : "Manual";
3166
3167     my $dbh = C4::Context->dbh;
3168
3169     return unless $issue;
3170
3171     $borrowernumber ||= $issue->borrowernumber;
3172
3173     if ( defined $datedue && ref $datedue ne 'DateTime' ) {
3174         $datedue = dt_from_string($datedue, 'sql');
3175     }
3176
3177     my $patron = Koha::Patrons->find( $borrowernumber ) or return; # FIXME Should do more than just return
3178     my $patron_unblessed = $patron->unblessed;
3179
3180     my $circ_library = Koha::Libraries->find( _GetCircControlBranch($item_unblessed, $patron_unblessed) );
3181
3182     my $schema = Koha::Database->schema;
3183     $schema->txn_do(sub{
3184
3185         if ( !$skipfinecalc && C4::Context->preference('CalculateFinesOnReturn') ) {
3186             _CalculateAndUpdateFine( { issue => $issue, item => $item_unblessed, borrower => $patron_unblessed } );
3187         }
3188         _FixOverduesOnReturn( $borrowernumber, $itemnumber, undef, 'RENEWED' );
3189
3190         # If the due date wasn't specified, calculate it by adding the
3191         # book's loan length to today's date or the current due date
3192         # based on the value of the RenewalPeriodBase syspref.
3193         my $itemtype = $item_object->effective_itemtype;
3194         unless ($datedue) {
3195
3196             $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
3197                                             dt_from_string( $issue->date_due, 'sql' ) :
3198                                             dt_from_string();
3199             $datedue =  CalcDateDue($datedue, $itemtype, $circ_library->branchcode, $patron_unblessed, 'is a renewal');
3200         }
3201
3202         my $fees = Koha::Charges::Fees->new(
3203             {
3204                 patron    => $patron,
3205                 library   => $circ_library,
3206                 item      => $item_object,
3207                 from_date => dt_from_string( $issue->date_due, 'sql' ),
3208                 to_date   => dt_from_string($datedue),
3209             }
3210         );
3211
3212         # Increment the unseen renewals, if appropriate
3213         # We only do so if the syspref is enabled and
3214         # a maximum value has been set in the circ rules
3215         my $unseen_renewals = $issue->unseen_renewals;
3216         if (C4::Context->preference('UnseenRenewals')) {
3217             my $rule = Koha::CirculationRules->get_effective_rule(
3218                 {   categorycode => $patron->categorycode,
3219                     itemtype     => $item_object->effective_itemtype,
3220                     branchcode   => $circ_library->branchcode,
3221                     rule_name    => 'unseen_renewals_allowed'
3222                 }
3223             );
3224             if (!$seen && $rule && looks_like_number($rule->rule_value)) {
3225                 $unseen_renewals++;
3226             } else {
3227                 # If the renewal is seen, unseen should revert to 0
3228                 $unseen_renewals = 0;
3229             }
3230         }
3231
3232         # Update the issues record to have the new due date, and a new count
3233         # of how many times it has been renewed.
3234         my $renews = ( $issue->renewals_count || 0 ) + 1;
3235         my $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals_count = ?, unseen_renewals = ?, lastreneweddate = ? WHERE issue_id = ?");
3236
3237         eval{
3238             $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $unseen_renewals, $lastreneweddate, $issue->issue_id );
3239         };
3240         if( $sth->err ){
3241             Koha::Exceptions::Checkout::FailedRenewal->throw(
3242                 error => 'Update of issue# ' . $issue->issue_id . ' failed with error: ' . $sth->errstr
3243             );
3244         }
3245
3246         # Update the renewal count on the item, and tell zebra to reindex
3247         $renews = ( $item_object->renewals || 0 ) + 1;
3248         $item_object->renewals($renews);
3249         $item_object->onloan($datedue);
3250         # Don't index as we are in a transaction, skip hardcoded here
3251         $item_object->store({ log_action => 0, skip_record_index => 1 });
3252
3253         # Charge a new rental fee, if applicable
3254         my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
3255         if ( $charge > 0 ) {
3256             AddIssuingCharge($issue, $charge, 'RENT_RENEW');
3257         }
3258
3259         # Charge a new accumulate rental fee, if applicable
3260         my $itemtype_object = Koha::ItemTypes->find( $itemtype );
3261         if ( $itemtype_object ) {
3262             my $accumulate_charge = $fees->accumulate_rentalcharge();
3263             if ( $accumulate_charge > 0 ) {
3264                 AddIssuingCharge( $issue, $accumulate_charge, 'RENT_DAILY_RENEW' )
3265             }
3266             $charge += $accumulate_charge;
3267         }
3268
3269         # Send a renewal slip according to checkout alert preferencei
3270         if ( C4::Context->preference('RenewalSendNotice') eq '1' ) {
3271             my $circulation_alert = 'C4::ItemCirculationAlertPreference';
3272             my %conditions        = (
3273                 branchcode   => $branch,
3274                 categorycode => $patron->categorycode,
3275                 item_type    => $itemtype,
3276                 notification => 'CHECKOUT',
3277             );
3278             if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
3279                 SendCirculationAlert(
3280                     {
3281                         type     => 'RENEWAL',
3282                         item     => $item_unblessed,
3283                         borrower => $patron->unblessed,
3284                         branch   => $branch,
3285                     }
3286                 );
3287             }
3288         }
3289
3290         # Remove any OVERDUES related debarment if the borrower has no overdues
3291         my $overdue_restrictions = $patron->restrictions->search({ type => 'OVERDUES' });
3292         if ( $patron
3293           && $patron->is_debarred
3294           && ! $patron->has_overdues
3295           && $overdue_restrictions->count
3296         ) {
3297             DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
3298         }
3299
3300         # Add renewal record
3301         my $renewal = Koha::Checkouts::Renewal->new(
3302             {
3303                 checkout_id  => $issue->issue_id,
3304                 interface    => C4::Context->interface,
3305                 renewal_type => $renewal_type,
3306                 renewer_id   => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
3307                 seen         => $seen,
3308             }
3309         )->store();
3310
3311         # Add the renewal to stats
3312         C4::Stats::UpdateStats(
3313             {
3314                 branch         => $item_object->renewal_branchcode({branch => $branch}),
3315                 type           => 'renew',
3316                 amount         => $charge,
3317                 itemnumber     => $itemnumber,
3318                 itemtype       => $itemtype,
3319                 location       => $item_object->location,
3320                 borrowernumber => $borrowernumber,
3321                 ccode          => $item_object->ccode,
3322                 categorycode   => $patron->categorycode,
3323                 interface      => C4::Context->interface,
3324             }
3325         );
3326
3327         #Log the renewal
3328         logaction("CIRCULATION", "RENEWAL", $borrowernumber, $itemnumber) if C4::Context->preference("RenewalLog");
3329
3330         Koha::Plugins->call('after_circ_action', {
3331             action  => 'renewal',
3332             payload => {
3333                 checkout  => $issue->get_from_storage
3334             }
3335         });
3336     });
3337
3338     unless( $skip_record_index ){
3339         # We index now, after the transaction is committed
3340         my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
3341         $indexer->index_records( $item_object->biblionumber, "specialUpdate", "biblioserver" );
3342     }
3343
3344     return $datedue;
3345 }
3346
3347 sub GetRenewCount {
3348     # check renewal status
3349     my ( $borrowernumber_or_patron, $itemnumber_or_item ) = @_;
3350
3351     my $dbh           = C4::Context->dbh;
3352     my $renewcount    = 0;
3353     my $unseencount    = 0;
3354     my $renewsallowed = 0;
3355     my $unseenallowed = 0;
3356     my $renewsleft    = 0;
3357     my $unseenleft    = 0;
3358     my $patron = blessed $borrowernumber_or_patron ?
3359         $borrowernumber_or_patron : Koha::Patrons->find($borrowernumber_or_patron);
3360     my $item = blessed $itemnumber_or_item ?
3361         $itemnumber_or_item : Koha::Items->find($itemnumber_or_item);
3362
3363     return (0, 0, 0, 0, 0, 0) unless $patron or $item; # Wrong call, no renewal allowed
3364
3365     # Look in the issues table for this item, lent to this borrower,
3366     # and not yet returned.
3367
3368     # FIXME - I think this function could be redone to use only one SQL call.
3369     my $sth = $dbh->prepare(q{
3370         SELECT * FROM issues
3371         WHERE  (borrowernumber = ?) AND (itemnumber = ?)
3372     });
3373     $sth->execute( $patron->borrowernumber, $item->itemnumber );
3374     my $data = $sth->fetchrow_hashref;
3375     $renewcount = $data->{'renewals_count'} if $data->{'renewals_count'};
3376     $unseencount = $data->{'unseen_renewals'} if $data->{'unseen_renewals'};
3377     # $item and $borrower should be calculated
3378     my $branchcode = _GetCircControlBranch($item->unblessed, $patron->unblessed);
3379
3380     my $rules = Koha::CirculationRules->get_effective_rules(
3381         {
3382             categorycode => $patron->categorycode,
3383             itemtype     => $item->effective_itemtype,
3384             branchcode   => $branchcode,
3385             rules        => [ 'renewalsallowed', 'unseen_renewals_allowed' ]
3386         }
3387     );
3388     $renewsallowed = $rules ? $rules->{renewalsallowed} : 0;
3389     $unseenallowed = $rules->{unseen_renewals_allowed} ?
3390         $rules->{unseen_renewals_allowed} :
3391         0;
3392     $renewsleft    = $renewsallowed - $renewcount;
3393     $unseenleft    = $unseenallowed - $unseencount;
3394     if($renewsleft < 0){ $renewsleft = 0; }
3395     if($unseenleft < 0){ $unseenleft = 0; }
3396     return (
3397         $renewcount,
3398         $renewsallowed,
3399         $renewsleft,
3400         $unseencount,
3401         $unseenallowed,
3402         $unseenleft
3403     );
3404 }
3405
3406 =head2 GetSoonestRenewDate
3407
3408   $NoRenewalBeforeThisDate = &GetSoonestRenewDate($patron, $issue);
3409
3410 Find out the soonest possible renew date of a borrowed item.
3411
3412 C<$patron> is the patron who currently has the item on loan.
3413
3414 C<$issue> is the the item issue.
3415
3416 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
3417 renew date, based on the value "No renewal before" of the applicable
3418 issuing rule. Returns the current date if the item can already be
3419 renewed, and returns undefined if the patron, item, or checkout
3420 cannot be found.
3421
3422 =cut
3423
3424 sub GetSoonestRenewDate {
3425     my ( $patron, $issue ) = @_;
3426     return unless $issue;
3427     return unless $patron;
3428
3429     my $item = $issue->item;
3430     return unless $item;
3431
3432     my $dbh = C4::Context->dbh;
3433
3434     my $branchcode = _GetCircControlBranch( $item->unblessed, $patron->unblessed );
3435     my $issuing_rule = Koha::CirculationRules->get_effective_rules(
3436         {   categorycode => $patron->categorycode,
3437             itemtype     => $item->effective_itemtype,
3438             branchcode   => $branchcode,
3439             rules => [
3440                 'norenewalbefore',
3441                 'lengthunit',
3442             ]
3443         }
3444     );
3445
3446     my $now = dt_from_string;
3447
3448     if ( defined $issuing_rule->{norenewalbefore}
3449         and $issuing_rule->{norenewalbefore} ne "" )
3450     {
3451         my $soonestrenewal =
3452           dt_from_string( $issue->date_due )->subtract(
3453             $issuing_rule->{lengthunit} => $issuing_rule->{norenewalbefore} );
3454
3455         if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
3456             and $issuing_rule->{lengthunit} eq 'days' )
3457         {
3458             $soonestrenewal->truncate( to => 'day' );
3459         }
3460         return $soonestrenewal;
3461     } elsif ( $issue->auto_renew && $patron->autorenew_checkouts ) {
3462         # Checkouts with auto-renewing fall back to due date
3463         my $soonestrenewal = dt_from_string( $issue->date_due );
3464         if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
3465             and $issuing_rule->{lengthunit} eq 'days' )
3466         {
3467             $soonestrenewal->truncate( to => 'day' );
3468         }
3469         return $soonestrenewal;
3470     }
3471     return $now;
3472 }
3473
3474 =head2 GetLatestAutoRenewDate
3475
3476   $NoAutoRenewalAfterThisDate = &GetLatestAutoRenewDate($patron, $issue);
3477
3478 Find out the latest possible auto renew date of a borrowed item.
3479
3480 C<$patron> is the patron who currently has the item on loan.
3481
3482 C<$issue> is the item issue.
3483
3484 C<$GetLatestAutoRenewDate> returns the DateTime of the latest possible
3485 auto renew date, based on the value "No auto renewal after" and the "No auto
3486 renewal after (hard limit) of the applicable issuing rule.
3487 Returns undef if there is no date specify in the circ rules or if the patron, loan,
3488 or item cannot be found.
3489
3490 =cut
3491
3492 sub GetLatestAutoRenewDate {
3493     my ( $patron, $issue ) = @_;
3494     return unless $issue;
3495     return unless $patron;
3496
3497     my $item = $issue->item;
3498     return unless $item;
3499
3500     my $dbh = C4::Context->dbh;
3501
3502     my $branchcode = _GetCircControlBranch( $item->unblessed, $patron->unblessed );
3503     my $circulation_rules = Koha::CirculationRules->get_effective_rules(
3504         {
3505             categorycode => $patron->categorycode,
3506             itemtype     => $item->effective_itemtype,
3507             branchcode   => $branchcode,
3508             rules => [
3509                 'no_auto_renewal_after',
3510                 'no_auto_renewal_after_hard_limit',
3511                 'lengthunit',
3512             ]
3513         }
3514     );
3515
3516     return unless $circulation_rules;
3517     return
3518       if ( not $circulation_rules->{no_auto_renewal_after}
3519             or $circulation_rules->{no_auto_renewal_after} eq '' )
3520       and ( not $circulation_rules->{no_auto_renewal_after_hard_limit}
3521              or $circulation_rules->{no_auto_renewal_after_hard_limit} eq '' );
3522
3523     my $maximum_renewal_date;
3524     if ( $circulation_rules->{no_auto_renewal_after} ) {
3525         $maximum_renewal_date = dt_from_string($issue->issuedate);
3526         $maximum_renewal_date->add(
3527             $circulation_rules->{lengthunit} => $circulation_rules->{no_auto_renewal_after}
3528         );
3529     }
3530
3531     if ( $circulation_rules->{no_auto_renewal_after_hard_limit} ) {
3532         my $dt = dt_from_string( $circulation_rules->{no_auto_renewal_after_hard_limit} );
3533         $maximum_renewal_date = $dt if not $maximum_renewal_date or $maximum_renewal_date > $dt;
3534     }
3535     return $maximum_renewal_date;
3536 }
3537
3538
3539 =head2 GetIssuingCharges
3540
3541   ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
3542
3543 Calculate how much it would cost for a given patron to borrow a given
3544 item, including any applicable discounts.
3545
3546 C<$itemnumber> is the item number of item the patron wishes to borrow.
3547
3548 C<$borrowernumber> is the patron's borrower number.
3549
3550 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
3551 and C<$item_type> is the code for the item's item type (e.g., C<VID>
3552 if it's a video).
3553
3554 =cut
3555
3556 sub GetIssuingCharges {
3557
3558     # calculate charges due
3559     my ( $itemnumber, $borrowernumber ) = @_;
3560     my $charge = 0;
3561     my $dbh    = C4::Context->dbh;
3562     my $item_type;
3563
3564     # Get the book's item type and rental charge (via its biblioitem).
3565     my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
3566         LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
3567     $charge_query .= (C4::Context->preference('item-level_itypes'))
3568         ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
3569         : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
3570
3571     $charge_query .= ' WHERE items.itemnumber =?';
3572
3573     my $sth = $dbh->prepare($charge_query);
3574     $sth->execute($itemnumber);
3575     my $patron;
3576     if ( my $item_data = $sth->fetchrow_hashref ) {
3577         $item_type = $item_data->{itemtype};
3578         $charge    = $item_data->{rentalcharge};
3579         if ($charge) {
3580             # FIXME This should follow CircControl
3581             my $branch = C4::Context::mybranch();
3582             $patron //= Koha::Patrons->find( $borrowernumber );
3583             my $discount = Koha::CirculationRules->get_effective_rule({
3584                 categorycode => $patron->categorycode,
3585                 branchcode   => $branch,
3586                 itemtype     => $item_type,
3587                 rule_name    => 'rentaldiscount'
3588             });
3589             if ($discount) {
3590                 $charge = ( $charge * ( 100 - $discount->rule_value ) ) / 100;
3591             }
3592             $charge = sprintf '%.2f', $charge; # ensure no fractions of a penny returned
3593         }
3594     }
3595
3596     return ( $charge, $item_type );
3597 }
3598
3599 =head2 AddIssuingCharge
3600
3601   &AddIssuingCharge( $checkout, $charge, $type )
3602
3603 =cut
3604
3605 sub AddIssuingCharge {
3606     my ( $checkout, $charge, $type ) = @_;
3607
3608     # FIXME What if checkout does not exist?
3609
3610     my $account = Koha::Account->new({ patron_id => $checkout->borrowernumber });
3611     my $accountline = $account->add_debit(
3612         {
3613             amount      => $charge,
3614             note        => undef,
3615             user_id     => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
3616             library_id  => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
3617             interface   => C4::Context->interface,
3618             type        => $type,
3619             item_id     => $checkout->itemnumber,
3620             issue_id    => $checkout->issue_id,
3621         }
3622     );
3623 }
3624
3625 =head2 GetTransfersFromTo
3626
3627   @results = GetTransfersFromTo($frombranch,$tobranch);
3628
3629 Returns the list of pending transfers between $from and $to branch
3630
3631 =cut
3632
3633 sub GetTransfersFromTo {
3634     my ( $frombranch, $tobranch ) = @_;
3635     return unless ( $frombranch && $tobranch );
3636     my $dbh   = C4::Context->dbh;
3637     my $query = "
3638         SELECT branchtransfer_id,itemnumber,datesent,frombranch
3639         FROM   branchtransfers
3640         WHERE  frombranch=?
3641           AND  tobranch=?
3642           AND datecancelled IS NULL
3643           AND datesent IS NOT NULL
3644           AND datearrived IS NULL
3645     ";
3646     my $sth = $dbh->prepare($query);
3647     $sth->execute( $frombranch, $tobranch );
3648     my @gettransfers;
3649
3650     while ( my $data = $sth->fetchrow_hashref ) {
3651         push @gettransfers, $data;
3652     }
3653     return (@gettransfers);
3654 }
3655
3656 =head2 SendCirculationAlert
3657
3658 Send out a C<check-in> or C<checkout> alert using the messaging system.
3659
3660 B<Parameters>:
3661
3662 =over 4
3663
3664 =item type
3665
3666 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3667
3668 =item item
3669
3670 Hashref of information about the item being checked in or out.
3671
3672 =item borrower
3673
3674 Hashref of information about the borrower of the item.
3675
3676 =item branch
3677
3678 The branchcode from where the checkout or check-in took place.
3679
3680 =back
3681
3682 B<Example>:
3683
3684     SendCirculationAlert({
3685         type     => 'CHECKOUT',
3686         item     => $item,
3687         borrower => $borrower,
3688         branch   => $branch,
3689     });
3690
3691 =cut
3692
3693 sub SendCirculationAlert {
3694     my ($opts) = @_;
3695     my ($type, $item, $borrower, $branch, $issue) =
3696         ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch}, $opts->{issue});
3697     my %message_name = (
3698         CHECKIN  => 'Item_Check_in',
3699         CHECKOUT => 'Item_Checkout',
3700         RENEWAL  => 'Item_Checkout',
3701     );
3702     my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3703         borrowernumber => $borrower->{borrowernumber},
3704         message_name   => $message_name{$type},
3705     });
3706
3707
3708     my $tables = {
3709         items => $item->{itemnumber},
3710         biblio      => $item->{biblionumber},
3711         biblioitems => $item->{biblionumber},
3712         borrowers   => $borrower,
3713         branches    => $branch,
3714     };
3715
3716     # TODO: Currently, we need to pass an issue_id as identifier for old_issues, but still an itemnumber for issues.
3717     # See C4::Letters:: _parseletter_sth
3718     if( $type eq 'CHECKIN' ){
3719         $tables->{old_issues} = $issue->issue_id;
3720     } else {
3721         $tables->{issues} = $item->{itemnumber};
3722     }
3723
3724     my $schema = Koha::Database->new->schema;
3725     my @transports = keys %{ $borrower_preferences->{transports} };
3726
3727     # From the MySQL doc:
3728     # LOCK TABLES is not transaction-safe and implicitly commits any active transaction before attempting to lock the tables.
3729     # If the LOCK/UNLOCK statements are executed from tests, the current transaction will be committed.
3730     # To avoid that we need to guess if this code is execute from tests or not (yes it is a bit hacky)
3731     my $do_not_lock = ( exists $ENV{_} && $ENV{_} =~ m|prove| ) || $ENV{KOHA_TESTING};
3732
3733     for my $mtt (@transports) {
3734         my $letter =  C4::Letters::GetPreparedLetter (
3735             module => 'circulation',
3736             letter_code => $type,
3737             branchcode => $branch,
3738             message_transport_type => $mtt,
3739             lang => $borrower->{lang},
3740             tables => $tables,
3741         ) or next;
3742
3743         C4::Context->dbh->do(q|LOCK TABLE message_queue READ|) unless $do_not_lock;
3744         C4::Context->dbh->do(q|LOCK TABLE message_queue WRITE|) unless $do_not_lock;
3745         my $message = C4::Message->find_last_message($borrower, $type, $mtt);
3746         unless ( $message ) {
3747             C4::Context->dbh->do(q|UNLOCK TABLES|) unless $do_not_lock;
3748             my $patron = Koha::Patrons->find($borrower->{borrowernumber});
3749             C4::Message->enqueue($letter, $patron, $mtt);
3750         } else {
3751             $message->append($letter);
3752             $message->update;
3753         }
3754         C4::Context->dbh->do(q|UNLOCK TABLES|) unless $do_not_lock;
3755     }
3756
3757     return;
3758 }
3759
3760 =head2 updateWrongTransfer
3761
3762   $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3763
3764 This function validate the line of brachtransfer but with the wrong destination (mistake from a librarian ...), and create a new line in branchtransfer from the actual library to the original library of reservation 
3765
3766 =cut
3767
3768 sub updateWrongTransfer {
3769         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3770
3771     # first step: cancel the original transfer
3772     my $item = Koha::Items->find($itemNumber);
3773     my $transfer = $item->get_transfer;
3774     $transfer->set({ datecancelled => dt_from_string, cancellation_reason => 'WrongTransfer' })->store();
3775
3776     # second step: create a new transfer to the right location
3777     my $new_transfer = $item->request_transfer(
3778         {
3779             to            => $transfer->to_library,
3780             reason        => $transfer->reason,
3781             comment       => $transfer->comments,
3782             ignore_limits => 1,
3783             enqueue       => 1
3784         }
3785     );
3786
3787     return $new_transfer;
3788 }
3789
3790 =head2 CalcDateDue
3791
3792 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3793
3794 this function calculates the due date given the start date and configured circulation rules,
3795 checking against the holidays calendar as per the daysmode circulation rule.
3796 C<$startdate>   = DateTime object representing start date of loan period (assumed to be today)
3797 C<$itemtype>  = itemtype code of item in question
3798 C<$branch>  = location whose calendar to use
3799 C<$borrower> = Borrower object
3800 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3801
3802 =cut
3803
3804 sub CalcDateDue {
3805     my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3806
3807     $isrenewal ||= 0;
3808
3809     # loanlength now a href
3810     my $loanlength =
3811             GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3812
3813     my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} and $loanlength->{renewalperiod} ne q{} )
3814             ? qq{renewalperiod}
3815             : qq{issuelength};
3816
3817     my $datedue;
3818     if ( $startdate ) {
3819         if (ref $startdate ne 'DateTime' ) {
3820             $datedue = dt_from_string($datedue);
3821         } else {
3822             $datedue = $startdate->clone;
3823         }
3824     } else {
3825         $datedue = dt_from_string()->truncate( to => 'minute' );
3826     }
3827
3828
3829     my $daysmode = Koha::CirculationRules->get_effective_daysmode(
3830         {
3831             categorycode => $borrower->{categorycode},
3832             itemtype     => $itemtype,
3833             branchcode   => $branch,
3834         }
3835     );
3836
3837     # calculate the datedue as normal
3838     if ( $daysmode eq 'Days' )
3839     {    # ignoring calendar
3840         if ( $loanlength->{lengthunit} eq 'hours' ) {
3841             $datedue->add( hours => $loanlength->{$length_key} );
3842         } else {    # days
3843             $datedue->add( days => $loanlength->{$length_key} );
3844             $datedue->set_hour(23);
3845             $datedue->set_minute(59);
3846         }
3847     } else {
3848         my $dur;
3849         if ($loanlength->{lengthunit} eq 'hours') {
3850             $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3851         }
3852         else { # days
3853             $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3854         }
3855         my $calendar = Koha::Calendar->new( branchcode => $branch, days_mode => $daysmode );
3856         $datedue = $calendar->addDuration( $datedue, $dur, $loanlength->{lengthunit} );
3857         if ($loanlength->{lengthunit} eq 'days') {
3858             $datedue->set_hour(23);
3859             $datedue->set_minute(59);
3860         }
3861     }
3862
3863     # if Hard Due Dates are used, retrieve them and apply as necessary
3864     my ( $hardduedate, $hardduedatecompare ) =
3865       GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3866     if ($hardduedate) {    # hardduedates are currently dates
3867         $hardduedate->truncate( to => 'minute' );
3868         $hardduedate->set_hour(23);
3869         $hardduedate->set_minute(59);
3870         my $cmp = DateTime->compare( $hardduedate, $datedue );
3871
3872 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3873 # if the calculated date is before the 'after' Hard Due Date (floor), override
3874 # if the hard due date is set to 'exactly', overrride
3875         if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3876             $datedue = $hardduedate->clone;
3877         }
3878
3879         # in all other cases, keep the date due as it is
3880
3881     }
3882
3883     # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3884     if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3885         my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso', 'floating');
3886         if( $expiry_dt ) { #skip empty expiry date..
3887             $expiry_dt->set( hour => 23, minute => 59);
3888             my $d1= $datedue->clone->set_time_zone('floating');
3889             if ( DateTime->compare( $d1, $expiry_dt ) == 1 ) {
3890                 $datedue = $expiry_dt->clone->set_time_zone( C4::Context->tz );
3891             }
3892         }
3893         if ( $daysmode ne 'Days' ) {
3894           my $calendar = Koha::Calendar->new( branchcode => $branch, days_mode => $daysmode );
3895           if ( $calendar->is_holiday($datedue) ) {
3896               # Don't return on a closed day
3897               $datedue = $calendar->prev_open_days( $datedue, 1 );
3898           }
3899         }
3900     }
3901
3902     return $datedue;
3903 }
3904
3905
3906 sub CheckValidBarcode{
3907 my ($barcode) = @_;
3908 my $dbh = C4::Context->dbh;
3909 my $query=qq|SELECT count(*) 
3910              FROM items 
3911              WHERE barcode=?
3912             |;
3913 my $sth = $dbh->prepare($query);
3914 $sth->execute($barcode);
3915 my $exist=$sth->fetchrow ;
3916 return $exist;
3917 }
3918
3919 =head2 IsBranchTransferAllowed
3920
3921   $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3922
3923 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3924
3925 Deprecated in favor of Koha::Item::Transfer::Limits->find/search and
3926 Koha::Item->can_be_transferred.
3927
3928 =cut
3929
3930 sub IsBranchTransferAllowed {
3931         my ( $toBranch, $fromBranch, $code ) = @_;
3932
3933         if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3934         
3935         my $limitType = C4::Context->preference("BranchTransferLimitsType");   
3936         my $dbh = C4::Context->dbh;
3937             
3938         my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3939         $sth->execute( $toBranch, $fromBranch, $code );
3940         my $limit = $sth->fetchrow_hashref();
3941                         
3942         ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3943         if ( $limit->{'limitId'} ) {
3944                 return 0;
3945         } else {
3946                 return 1;
3947         }
3948 }                                                        
3949
3950 =head2 CreateBranchTransferLimit
3951
3952   CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3953
3954 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3955
3956 Deprecated in favor of Koha::Item::Transfer::Limit->new.
3957
3958 =cut
3959
3960 sub CreateBranchTransferLimit {
3961    my ( $toBranch, $fromBranch, $code ) = @_;
3962    return unless defined($toBranch) && defined($fromBranch);
3963    my $limitType = C4::Context->preference("BranchTransferLimitsType");
3964    
3965    my $dbh = C4::Context->dbh;
3966    
3967    my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3968    return $sth->execute( $code, $toBranch, $fromBranch );
3969 }
3970
3971 =head2 DeleteBranchTransferLimits
3972
3973     my $result = DeleteBranchTransferLimits($frombranch);
3974
3975 Deletes all the library transfer limits for one library.  Returns the
3976 number of limits deleted, 0e0 if no limits were deleted, or undef if
3977 no arguments are supplied.
3978
3979 Deprecated in favor of Koha::Item::Transfer::Limits->search({
3980     fromBranch => $fromBranch
3981     })->delete.
3982
3983 =cut
3984
3985 sub DeleteBranchTransferLimits {
3986     my $branch = shift;
3987     return unless defined $branch;
3988     my $dbh    = C4::Context->dbh;
3989     my $sth    = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3990     return $sth->execute($branch);
3991 }
3992
3993 sub ReturnLostItem{
3994     my ( $borrowernumber, $itemnum ) = @_;
3995     MarkIssueReturned( $borrowernumber, $itemnum );
3996 }
3997
3998 =head2 LostItem
3999
4000   LostItem( $itemnumber, $mark_lost_from, $force_mark_returned, [$params] );
4001
4002 The final optional parameter, C<$params>, expected to contain
4003 'skip_record_index' key, which relayed down to Koha::Item/store,
4004 there it prevents calling of ModZebra index_records,
4005 which takes most of the time in batch adds/deletes: index_records better
4006 to be called later in C<additem.pl> after the whole loop.
4007
4008 $params:
4009     skip_record_index => 1|0
4010
4011 =cut
4012
4013 sub LostItem{
4014     my ($itemnumber, $mark_lost_from, $force_mark_returned, $params) = @_;
4015
4016     unless ( $mark_lost_from ) {
4017         # Temporary check to avoid regressions
4018         die q|LostItem called without $mark_lost_from, check the API.|;
4019     }
4020
4021     my $mark_returned;
4022     if ( $force_mark_returned ) {
4023         $mark_returned = 1;
4024     } else {
4025         my $pref = C4::Context->preference('MarkLostItemsAsReturned') // q{};
4026         $mark_returned = ( $pref =~ m|$mark_lost_from| );
4027     }
4028
4029     my $dbh = C4::Context->dbh();
4030     my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title 
4031                            FROM issues 
4032                            JOIN items USING (itemnumber) 
4033                            JOIN biblio USING (biblionumber)
4034                            WHERE issues.itemnumber=?");
4035     $sth->execute($itemnumber);
4036     my $issues=$sth->fetchrow_hashref();
4037
4038     # If a borrower lost the item, add a replacement cost to the their record
4039     if ( my $borrowernumber = $issues->{borrowernumber} ){
4040         my $patron = Koha::Patrons->find( $borrowernumber );
4041
4042         my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, C4::Context->preference('WhenLostForgiveFine'), 'LOST');
4043         defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!";  # zero is OK, check defined
4044
4045         if (C4::Context->preference('WhenLostChargeReplacementFee')){
4046             C4::Accounts::chargelostitem(
4047                 $borrowernumber,
4048                 $itemnumber,
4049                 $issues->{'replacementprice'},
4050                 sprintf( "%s %s %s",
4051                     $issues->{'title'}          || q{},
4052                     $issues->{'barcode'}        || q{},
4053                     $issues->{'itemcallnumber'} || q{},
4054                 ),
4055             );
4056             #FIXME : Should probably have a way to distinguish this from an item that really was returned.
4057             #warn " $issues->{'borrowernumber'}  /  $itemnumber ";
4058         }
4059
4060         MarkIssueReturned($borrowernumber,$itemnumber,undef,$patron->privacy,$params) if $mark_returned;
4061     }
4062
4063     # When an item is marked as lost, we should automatically cancel its outstanding transfers.
4064     my $item = Koha::Items->find($itemnumber);
4065     my $transfers = $item->get_transfers;
4066     while (my $transfer = $transfers->next) {
4067         $transfer->cancel({ reason => 'ItemLost', force => 1 });
4068     }
4069 }
4070
4071 sub GetOfflineOperations {
4072     my $dbh = C4::Context->dbh;
4073     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
4074     $sth->execute(C4::Context->userenv->{'branch'});
4075     my $results = $sth->fetchall_arrayref({});
4076     return $results;
4077 }
4078
4079 sub GetOfflineOperation {
4080     my $operationid = shift;
4081     return unless $operationid;
4082     my $dbh = C4::Context->dbh;
4083     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
4084     $sth->execute( $operationid );
4085     return $sth->fetchrow_hashref;
4086 }
4087
4088 sub AddOfflineOperation {
4089     my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
4090     my $dbh = C4::Context->dbh;
4091     my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
4092     $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
4093     return "Added.";
4094 }
4095
4096 sub DeleteOfflineOperation {
4097     my $dbh = C4::Context->dbh;
4098     my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
4099     $sth->execute( shift );
4100     return "Deleted.";
4101 }
4102
4103 sub ProcessOfflineOperation {
4104     my $operation = shift;
4105
4106     my $report;
4107     if ( $operation->{action} eq 'return' ) {
4108         $report = ProcessOfflineReturn( $operation );
4109     } elsif ( $operation->{action} eq 'issue' ) {
4110         $report = ProcessOfflineIssue( $operation );
4111     } elsif ( $operation->{action} eq 'payment' ) {
4112         $report = ProcessOfflinePayment( $operation );
4113     }
4114
4115     DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
4116
4117     return $report;
4118 }
4119
4120 sub ProcessOfflineReturn {
4121     my $operation = shift;
4122
4123     my $item = Koha::Items->find({barcode => $operation->{barcode}});
4124
4125     if ( $item ) {
4126         my $itemnumber = $item->itemnumber;
4127         my $issue = $item->checkout;
4128         if ( $issue ) {
4129             my $leave_item_lost = C4::Context->preference("BlockReturnOfLostItems") ? 1 : 0;
4130             ModDateLastSeen( $itemnumber, $leave_item_lost );
4131             MarkIssueReturned(
4132                 $issue->borrowernumber,
4133                 $itemnumber,
4134                 $operation->{timestamp},
4135             );
4136             $item->onloan(undef);
4137             $item->store({ log_action => 0 });
4138             return "Success.";
4139         } else {
4140             return "Item not issued.";
4141         }
4142     } else {
4143         return "Item not found.";
4144     }
4145 }
4146
4147 sub ProcessOfflineIssue {
4148     my $operation = shift;
4149
4150     my $patron = Koha::Patrons->find( { cardnumber => $operation->{cardnumber} } );
4151
4152     if ( $patron ) {
4153         my $item = Koha::Items->find({ barcode => $operation->{barcode} });
4154         unless ($item) {
4155             return "Barcode not found.";
4156         }
4157         my $itemnumber = $item->itemnumber;
4158         my $issue = $item->checkout;
4159
4160         if ( $issue and ( $issue->borrowernumber ne $patron->borrowernumber ) ) { # Item already issued to another patron mark it returned
4161             MarkIssueReturned(
4162                 $issue->borrowernumber,
4163                 $itemnumber,
4164                 $operation->{timestamp},
4165             );
4166         }
4167         AddIssue(
4168             $patron->unblessed,
4169             $operation->{'barcode'},
4170             undef,
4171             undef,
4172             $operation->{timestamp},
4173             undef,
4174         );
4175         return "Success.";
4176     } else {
4177         return "Borrower not found.";
4178     }
4179 }
4180
4181 sub ProcessOfflinePayment {
4182     my $operation = shift;
4183
4184     my $patron = Koha::Patrons->find({ cardnumber => $operation->{cardnumber} });
4185
4186     $patron->account->pay(
4187         {
4188             amount     => $operation->{amount},
4189             library_id => $operation->{branchcode},
4190             interface  => 'koc'
4191         }
4192     );
4193
4194     return "Success.";
4195 }
4196
4197 =head2 TransferSlip
4198
4199   TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
4200
4201   Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
4202
4203 =cut
4204
4205 sub TransferSlip {
4206     my ($branch, $itemnumber, $barcode, $to_branch) = @_;
4207
4208     my $item =
4209       $itemnumber
4210       ? Koha::Items->find($itemnumber)
4211       : Koha::Items->find( { barcode => $barcode } );
4212
4213     $item or return;
4214
4215     return C4::Letters::GetPreparedLetter (
4216         module => 'circulation',
4217         letter_code => 'TRANSFERSLIP',
4218         branchcode => $branch,
4219         tables => {
4220             'branches'    => $to_branch,
4221             'biblio'      => $item->biblionumber,
4222             'items'       => $item->unblessed,
4223         },
4224     );
4225 }
4226
4227 =head2 CheckIfIssuedToPatron
4228
4229   CheckIfIssuedToPatron($borrowernumber, $biblionumber)
4230
4231   Return 1 if any record item is issued to patron, otherwise return 0
4232
4233 =cut
4234
4235 sub CheckIfIssuedToPatron {
4236     my ($borrowernumber, $biblionumber) = @_;
4237
4238     my $dbh = C4::Context->dbh;
4239     my $query = q|
4240         SELECT COUNT(*) FROM issues
4241         LEFT JOIN items ON items.itemnumber = issues.itemnumber
4242         WHERE items.biblionumber = ?
4243         AND issues.borrowernumber = ?
4244     |;
4245     my $is_issued = $dbh->selectrow_array($query, {}, $biblionumber, $borrowernumber );
4246     return 1 if $is_issued;
4247     return;
4248 }
4249
4250 =head2 IsItemIssued
4251
4252   IsItemIssued( $itemnumber )
4253
4254   Return 1 if the item is on loan, otherwise return 0
4255
4256 =cut
4257
4258 sub IsItemIssued {
4259     my $itemnumber = shift;
4260     my $dbh = C4::Context->dbh;
4261     my $sth = $dbh->prepare(q{
4262         SELECT COUNT(*)
4263         FROM issues
4264         WHERE itemnumber = ?
4265     });
4266     $sth->execute($itemnumber);
4267     return $sth->fetchrow;
4268 }
4269
4270 =head2 GetAgeRestriction
4271
4272   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
4273   my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
4274
4275   if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as they are older or as old as the agerestriction }
4276   if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
4277
4278 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
4279 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
4280 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
4281          Negative days mean the borrower has gone past the age restriction age.
4282
4283 =cut
4284
4285 sub GetAgeRestriction {
4286     my ($record_restrictions, $borrower) = @_;
4287     my $markers = C4::Context->preference('AgeRestrictionMarker');
4288
4289     return unless $record_restrictions;
4290     # Split $record_restrictions to something like FSK 16 or PEGI 6
4291     my @values = split ' ', uc($record_restrictions);
4292     return unless @values;
4293
4294     # Search first occurrence of one of the markers
4295     my @markers = split /\|/, uc($markers);
4296     return unless @markers;
4297
4298     my $index            = 0;
4299     my $restriction_year = 0;
4300     for my $value (@values) {
4301         $index++;
4302         for my $marker (@markers) {
4303             $marker =~ s/^\s+//;    #remove leading spaces
4304             $marker =~ s/\s+$//;    #remove trailing spaces
4305             if ( $marker eq $value ) {
4306                 if ( $index <= $#values ) {
4307                     $restriction_year += $values[$index];
4308                 }
4309                 last;
4310             }
4311             elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
4312
4313                 # Perhaps it is something like "K16" (as in Finland)
4314                 $restriction_year += $1;
4315                 last;
4316             }
4317         }
4318         last if ( $restriction_year > 0 );
4319     }
4320
4321     #Check if the borrower is age restricted for this material and for how long.
4322     if ($restriction_year && $borrower) {
4323         if ( $borrower->{'dateofbirth'} ) {
4324             my @alloweddate = split /-/, $borrower->{'dateofbirth'};
4325             $alloweddate[0] += $restriction_year;
4326
4327             #Prevent runime eror on leap year (invalid date)
4328             if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
4329                 $alloweddate[2] = 28;
4330             }
4331
4332             #Get how many days the borrower has to reach the age restriction
4333             my @Today = split /-/, dt_from_string()->ymd();
4334             my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(@Today);
4335             #Negative days means the borrower went past the age restriction age
4336             return ($restriction_year, $daysToAgeRestriction);
4337         }
4338     }
4339
4340     return ($restriction_year);
4341 }
4342
4343
4344 =head2 GetPendingOnSiteCheckouts
4345
4346 =cut
4347
4348 sub GetPendingOnSiteCheckouts {
4349     my $dbh = C4::Context->dbh;
4350     return $dbh->selectall_arrayref(q|
4351         SELECT
4352           items.barcode,
4353           items.biblionumber,
4354           items.itemnumber,
4355           items.itemnotes,
4356           items.itemcallnumber,
4357           items.location,
4358           issues.date_due,
4359           issues.branchcode,
4360           issues.date_due < NOW() AS is_overdue,
4361           biblio.author,
4362           biblio.title,
4363           borrowers.firstname,
4364           borrowers.surname,
4365           borrowers.cardnumber,
4366           borrowers.borrowernumber
4367         FROM items
4368         LEFT JOIN issues ON items.itemnumber = issues.itemnumber
4369         LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
4370         LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
4371         WHERE issues.onsite_checkout = 1
4372     |, { Slice => {} } );
4373 }
4374
4375 sub GetTopIssues {
4376     my ($params) = @_;
4377
4378     my ($count, $branch, $itemtype, $ccode, $newness)
4379         = @$params{qw(count branch itemtype ccode newness)};
4380
4381     my $dbh = C4::Context->dbh;
4382     my $query = q{
4383         SELECT * FROM (
4384         SELECT b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
4385           bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
4386           i.ccode, SUM(i.issues) AS count
4387         FROM biblio b
4388         LEFT JOIN items i ON (i.biblionumber = b.biblionumber)
4389         LEFT JOIN biblioitems bi ON (bi.biblionumber = b.biblionumber)
4390     };
4391
4392     my (@where_strs, @where_args);
4393
4394     if ($branch) {
4395         push @where_strs, 'i.homebranch = ?';
4396         push @where_args, $branch;
4397     }
4398     if ($itemtype) {
4399         if (C4::Context->preference('item-level_itypes')){
4400             push @where_strs, 'i.itype = ?';
4401             push @where_args, $itemtype;
4402         } else {
4403             push @where_strs, 'bi.itemtype = ?';
4404             push @where_args, $itemtype;
4405         }
4406     }
4407     if ($ccode) {
4408         push @where_strs, 'i.ccode = ?';
4409         push @where_args, $ccode;
4410     }
4411     if ($newness) {
4412         push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
4413         push @where_args, $newness;
4414     }
4415
4416     if (@where_strs) {
4417         $query .= 'WHERE ' . join(' AND ', @where_strs);
4418     }
4419
4420     $query .= q{
4421         GROUP BY b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
4422           bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
4423           i.ccode
4424         ORDER BY count DESC
4425     };
4426
4427     $query .= q{ ) xxx WHERE count > 0 };
4428     $count = int($count);
4429     if ($count > 0) {
4430         $query .= "LIMIT $count";
4431     }
4432
4433     my $rows = $dbh->selectall_arrayref($query, { Slice => {} }, @where_args);
4434
4435     return @$rows;
4436 }
4437
4438 =head2 Internal methods
4439
4440 =cut
4441
4442 sub _CalculateAndUpdateFine {
4443     my ($params) = @_;
4444
4445     my $borrower    = $params->{borrower};
4446     my $item        = $params->{item};
4447     my $issue       = $params->{issue};
4448     my $return_date = $params->{return_date};
4449
4450     unless ($borrower) { carp "No borrower passed in!" && return; }
4451     unless ($item)     { carp "No item passed in!"     && return; }
4452     unless ($issue)    { carp "No issue passed in!"    && return; }
4453
4454     my $datedue = dt_from_string( $issue->date_due );
4455
4456     # we only need to calculate and change the fines if we want to do that on return
4457     # Should be on for hourly loans
4458     my $control = C4::Context->preference('CircControl');
4459     my $branch_type = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
4460     my $control_branchcode =
4461         ( $control eq 'ItemHomeLibrary' ) ? $item->{$branch_type}
4462       : ( $control eq 'PatronLibrary' )   ? $borrower->{branchcode}
4463       :                                     $issue->branchcode;
4464
4465     my $date_returned = $return_date ? $return_date : dt_from_string();
4466
4467     my ( $amount, $unitcounttotal, $unitcount  ) =
4468       C4::Overdues::CalcFine( $item, $borrower->{categorycode}, $control_branchcode, $datedue, $date_returned );
4469
4470     if ( C4::Context->preference('finesMode') eq 'production' ) {
4471         if ( $amount > 0 ) {
4472             C4::Overdues::UpdateFine({
4473                 issue_id       => $issue->issue_id,
4474                 itemnumber     => $issue->itemnumber,
4475                 borrowernumber => $issue->borrowernumber,
4476                 amount         => $amount,
4477                 due            => $datedue,
4478             });
4479         }
4480         elsif ($return_date) {
4481
4482             # Backdated returns may have fines that shouldn't exist,
4483             # so in this case, we need to drop those fines to 0
4484
4485             C4::Overdues::UpdateFine({
4486                 issue_id       => $issue->issue_id,
4487                 itemnumber     => $issue->itemnumber,
4488                 borrowernumber => $issue->borrowernumber,
4489                 amount         => 0,
4490                 due            => $datedue,
4491             });
4492         }
4493     }
4494 }
4495
4496 sub _CanBookBeAutoRenewed {
4497     my ( $params ) = @_;
4498     my $patron = $params->{patron};
4499     my $item = $params->{item};
4500     my $branchcode = $params->{branchcode};
4501     my $issue = $params->{issue};
4502
4503     return "no" unless $issue->auto_renew && $patron->autorenew_checkouts;
4504
4505     my $issuing_rule = Koha::CirculationRules->get_effective_rules(
4506         {
4507             categorycode => $patron->categorycode,
4508             itemtype     => $item->effective_itemtype,
4509             branchcode   => $branchcode,
4510             rules => [
4511                 'no_auto_renewal_after',
4512                 'no_auto_renewal_after_hard_limit',
4513                 'lengthunit',
4514                 'norenewalbefore',
4515             ]
4516         }
4517     );
4518
4519     if ( $patron->is_expired && $patron->category->effective_BlockExpiredPatronOpacActions ) {
4520         return 'auto_account_expired';
4521     }
4522
4523     if ( defined $issuing_rule->{no_auto_renewal_after}
4524             and $issuing_rule->{no_auto_renewal_after} ne "" ) {
4525         # Get issue_date and add no_auto_renewal_after
4526         # If this is greater than today, it's too late for renewal.
4527         my $maximum_renewal_date = dt_from_string($issue->issuedate, 'sql');
4528         $maximum_renewal_date->add(
4529             $issuing_rule->{lengthunit} => $issuing_rule->{no_auto_renewal_after}
4530         );
4531         my $now = dt_from_string;
4532         if ( $now >= $maximum_renewal_date ) {
4533             return "auto_too_late";
4534         }
4535     }
4536     if ( defined $issuing_rule->{no_auto_renewal_after_hard_limit}
4537                   and $issuing_rule->{no_auto_renewal_after_hard_limit} ne "" ) {
4538         # If no_auto_renewal_after_hard_limit is >= today, it's also too late for renewal
4539         if ( dt_from_string >= dt_from_string( $issuing_rule->{no_auto_renewal_after_hard_limit} ) ) {
4540             return "auto_too_late";
4541         }
4542     }
4543
4544     if ( C4::Context->preference('OPACFineNoRenewalsBlockAutoRenew') ) {
4545         my $fine_no_renewals = C4::Context->preference("OPACFineNoRenewals");
4546         my $amountoutstanding =
4547           C4::Context->preference("OPACFineNoRenewalsIncludeCredit")
4548           ? $patron->account->balance
4549           : $patron->account->outstanding_debits->total_outstanding;
4550         if ( $amountoutstanding and $amountoutstanding > $fine_no_renewals ) {
4551             return "auto_too_much_oweing";
4552         }
4553     }
4554
4555     my $soonest = GetSoonestRenewDate($patron, $issue);
4556     if ( $soonest > dt_from_string() )
4557     {
4558         return ( "auto_too_soon", $soonest );
4559     }
4560
4561     return "ok";
4562 }
4563
4564
4565 1;
4566
4567 __END__
4568
4569 =head1 AUTHOR
4570
4571 Koha Development Team <http://koha-community.org/>
4572
4573 =cut