Merge remote-tracking branch 'origin/new/bug_8251'
[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 under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 2 of the License, or (at your option) any later
11 # version.
12 #
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
20
21
22 use strict;
23 #use warnings; FIXME - Bug 2505
24 use DateTime;
25 use C4::Context;
26 use C4::Stats;
27 use C4::Reserves;
28 use C4::Biblio;
29 use C4::Items;
30 use C4::Members;
31 use C4::Dates;
32 use C4::Dates qw(format_date);
33 use C4::Accounts;
34 use C4::ItemCirculationAlertPreference;
35 use C4::Message;
36 use C4::Debug;
37 use C4::Branch; # GetBranches
38 use C4::Log; # logaction
39 use C4::Koha qw(GetAuthorisedValueByCode);
40 use C4::Overdues qw(CalcFine UpdateFine);
41 use Data::Dumper;
42 use Koha::DateUtils;
43 use Koha::Calendar;
44 use Carp;
45
46 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
47
48 BEGIN {
49         require Exporter;
50     $VERSION = 3.07.00.049;     # for version checking
51         @ISA    = qw(Exporter);
52
53         # FIXME subs that should probably be elsewhere
54         push @EXPORT, qw(
55                 &barcodedecode
56         &LostItem
57         &ReturnLostItem
58         );
59
60         # subs to deal with issuing a book
61         push @EXPORT, qw(
62                 &CanBookBeIssued
63                 &CanBookBeRenewed
64                 &AddIssue
65                 &AddRenewal
66                 &GetRenewCount
67                 &GetItemIssue
68                 &GetItemIssues
69                 &GetIssuingCharges
70                 &GetIssuingRule
71         &GetBranchBorrowerCircRule
72         &GetBranchItemRule
73                 &GetBiblioIssues
74                 &GetOpenIssue
75                 &AnonymiseIssueHistory
76         );
77
78         # subs to deal with returns
79         push @EXPORT, qw(
80                 &AddReturn
81         &MarkIssueReturned
82         );
83
84         # subs to deal with transfers
85         push @EXPORT, qw(
86                 &transferbook
87                 &GetTransfers
88                 &GetTransfersFromTo
89                 &updateWrongTransfer
90                 &DeleteTransfer
91                 &IsBranchTransferAllowed
92                 &CreateBranchTransferLimit
93                 &DeleteBranchTransferLimits
94         &TransferSlip
95         );
96
97     # subs to deal with offline circulation
98     push @EXPORT, qw(
99       &GetOfflineOperations
100       &GetOfflineOperation
101       &AddOfflineOperation
102       &DeleteOfflineOperation
103       &ProcessOfflineOperation
104     );
105 }
106
107 =head1 NAME
108
109 C4::Circulation - Koha circulation module
110
111 =head1 SYNOPSIS
112
113 use C4::Circulation;
114
115 =head1 DESCRIPTION
116
117 The functions in this module deal with circulation, issues, and
118 returns, as well as general information about the library.
119 Also deals with stocktaking.
120
121 =head1 FUNCTIONS
122
123 =head2 barcodedecode
124
125   $str = &barcodedecode($barcode, [$filter]);
126
127 Generic filter function for barcode string.
128 Called on every circ if the System Pref itemBarcodeInputFilter is set.
129 Will do some manipulation of the barcode for systems that deliver a barcode
130 to circulation.pl that differs from the barcode stored for the item.
131 For proper functioning of this filter, calling the function on the 
132 correct barcode string (items.barcode) should return an unaltered barcode.
133
134 The optional $filter argument is to allow for testing or explicit 
135 behavior that ignores the System Pref.  Valid values are the same as the 
136 System Pref options.
137
138 =cut
139
140 # FIXME -- the &decode fcn below should be wrapped into this one.
141 # FIXME -- these plugins should be moved out of Circulation.pm
142 #
143 sub barcodedecode {
144     my ($barcode, $filter) = @_;
145     my $branch = C4::Branch::mybranch();
146     $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter;
147     $filter or return $barcode;     # ensure filter is defined, else return untouched barcode
148         if ($filter eq 'whitespace') {
149                 $barcode =~ s/\s//g;
150         } elsif ($filter eq 'cuecat') {
151                 chomp($barcode);
152             my @fields = split( /\./, $barcode );
153             my @results = map( decode($_), @fields[ 1 .. $#fields ] );
154             ($#results == 2) and return $results[2];
155         } elsif ($filter eq 'T-prefix') {
156                 if ($barcode =~ /^[Tt](\d)/) {
157                         (defined($1) and $1 eq '0') and return $barcode;
158             $barcode = substr($barcode, 2) + 0;     # FIXME: probably should be substr($barcode, 1)
159                 }
160         return sprintf("T%07d", $barcode);
161         # FIXME: $barcode could be "T1", causing warning: substr outside of string
162         # Why drop the nonzero digit after the T?
163         # Why pass non-digits (or empty string) to "T%07d"?
164         } elsif ($filter eq 'libsuite8') {
165                 unless($barcode =~ m/^($branch)-/i){    #if barcode starts with branch code its in Koha style. Skip it.
166                         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
167                                 $barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i;
168                         }else{
169                                 $barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i;
170                         }
171                 }
172         }
173     return $barcode;    # return barcode, modified or not
174 }
175
176 =head2 decode
177
178   $str = &decode($chunk);
179
180 Decodes a segment of a string emitted by a CueCat barcode scanner and
181 returns it.
182
183 FIXME: Should be replaced with Barcode::Cuecat from CPAN
184 or Javascript based decoding on the client side.
185
186 =cut
187
188 sub decode {
189     my ($encoded) = @_;
190     my $seq =
191       'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
192     my @s = map { index( $seq, $_ ); } split( //, $encoded );
193     my $l = ( $#s + 1 ) % 4;
194     if ($l) {
195         if ( $l == 1 ) {
196             # warn "Error: Cuecat decode parsing failed!";
197             return;
198         }
199         $l = 4 - $l;
200         $#s += $l;
201     }
202     my $r = '';
203     while ( $#s >= 0 ) {
204         my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
205         $r .=
206             chr( ( $n >> 16 ) ^ 67 )
207          .chr( ( $n >> 8 & 255 ) ^ 67 )
208          .chr( ( $n & 255 ) ^ 67 );
209         @s = @s[ 4 .. $#s ];
210     }
211     $r = substr( $r, 0, length($r) - $l );
212     return $r;
213 }
214
215 =head2 transferbook
216
217   ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch, 
218                                             $barcode, $ignore_reserves);
219
220 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
221
222 C<$newbranch> is the code for the branch to which the item should be transferred.
223
224 C<$barcode> is the barcode of the item to be transferred.
225
226 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
227 Otherwise, if an item is reserved, the transfer fails.
228
229 Returns three values:
230
231 =over
232
233 =item $dotransfer 
234
235 is true if the transfer was successful.
236
237 =item $messages
238
239 is a reference-to-hash which may have any of the following keys:
240
241 =over
242
243 =item C<BadBarcode>
244
245 There is no item in the catalog with the given barcode. The value is C<$barcode>.
246
247 =item C<IsPermanent>
248
249 The item's home branch is permanent. This doesn't prevent the item from being transferred, though. The value is the code of the item's home branch.
250
251 =item C<DestinationEqualsHolding>
252
253 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.
254
255 =item C<WasReturned>
256
257 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.
258
259 =item C<ResFound>
260
261 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>.
262
263 =item C<WasTransferred>
264
265 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
266
267 =back
268
269 =back
270
271 =cut
272
273 sub transferbook {
274     my ( $tbr, $barcode, $ignoreRs ) = @_;
275     my $messages;
276     my $dotransfer      = 1;
277     my $branches        = GetBranches();
278     my $itemnumber = GetItemnumberFromBarcode( $barcode );
279     my $issue      = GetItemIssue($itemnumber);
280     my $biblio = GetBiblioFromItemNumber($itemnumber);
281
282     # bad barcode..
283     if ( not $itemnumber ) {
284         $messages->{'BadBarcode'} = $barcode;
285         $dotransfer = 0;
286     }
287
288     # get branches of book...
289     my $hbr = $biblio->{'homebranch'};
290     my $fbr = $biblio->{'holdingbranch'};
291
292     # if using Branch Transfer Limits
293     if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
294         if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
295             if ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{'itype'} ) ) {
296                 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{'itype'};
297                 $dotransfer = 0;
298             }
299         } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{ C4::Context->preference("BranchTransferLimitsType") } ) ) {
300             $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{ C4::Context->preference("BranchTransferLimitsType") };
301             $dotransfer = 0;
302         }
303     }
304
305     # if is permanent...
306     if ( $hbr && $branches->{$hbr}->{'PE'} ) {
307         $messages->{'IsPermanent'} = $hbr;
308         $dotransfer = 0;
309     }
310
311     # can't transfer book if is already there....
312     if ( $fbr eq $tbr ) {
313         $messages->{'DestinationEqualsHolding'} = 1;
314         $dotransfer = 0;
315     }
316
317     # check if it is still issued to someone, return it...
318     if ($issue->{borrowernumber}) {
319         AddReturn( $barcode, $fbr );
320         $messages->{'WasReturned'} = $issue->{borrowernumber};
321     }
322
323     # find reserves.....
324     # That'll save a database query.
325     my ( $resfound, $resrec, undef ) =
326       CheckReserves( $itemnumber );
327     if ( $resfound and not $ignoreRs ) {
328         $resrec->{'ResFound'} = $resfound;
329
330         #         $messages->{'ResFound'} = $resrec;
331         $dotransfer = 1;
332     }
333
334     #actually do the transfer....
335     if ($dotransfer) {
336         ModItemTransfer( $itemnumber, $fbr, $tbr );
337
338         # don't need to update MARC anymore, we do it in batch now
339         $messages->{'WasTransfered'} = 1;
340
341     }
342     ModDateLastSeen( $itemnumber );
343     return ( $dotransfer, $messages, $biblio );
344 }
345
346
347 sub TooMany {
348     my $borrower        = shift;
349     my $biblionumber = shift;
350         my $item                = shift;
351     my $cat_borrower    = $borrower->{'categorycode'};
352     my $dbh             = C4::Context->dbh;
353         my $branch;
354         # Get which branchcode we need
355         $branch = _GetCircControlBranch($item,$borrower);
356         my $type = (C4::Context->preference('item-level_itypes')) 
357                         ? $item->{'itype'}         # item-level
358                         : $item->{'itemtype'};     # biblio-level
359  
360     # given branch, patron category, and item type, determine
361     # applicable issuing rule
362     my $issuing_rule = GetIssuingRule($cat_borrower, $type, $branch);
363
364     # if a rule is found and has a loan limit set, count
365     # how many loans the patron already has that meet that
366     # rule
367     if (defined($issuing_rule) and defined($issuing_rule->{'maxissueqty'})) {
368         my @bind_params;
369         my $count_query = "SELECT COUNT(*) FROM issues
370                            JOIN items USING (itemnumber) ";
371
372         my $rule_itemtype = $issuing_rule->{itemtype};
373         if ($rule_itemtype eq "*") {
374             # matching rule has the default item type, so count only
375             # those existing loans that don't fall under a more
376             # specific rule
377             if (C4::Context->preference('item-level_itypes')) {
378                 $count_query .= " WHERE items.itype NOT IN (
379                                     SELECT itemtype FROM issuingrules
380                                     WHERE branchcode = ?
381                                     AND   (categorycode = ? OR categorycode = ?)
382                                     AND   itemtype <> '*'
383                                   ) ";
384             } else { 
385                 $count_query .= " JOIN  biblioitems USING (biblionumber) 
386                                   WHERE biblioitems.itemtype NOT IN (
387                                     SELECT itemtype FROM issuingrules
388                                     WHERE branchcode = ?
389                                     AND   (categorycode = ? OR categorycode = ?)
390                                     AND   itemtype <> '*'
391                                   ) ";
392             }
393             push @bind_params, $issuing_rule->{branchcode};
394             push @bind_params, $issuing_rule->{categorycode};
395             push @bind_params, $cat_borrower;
396         } else {
397             # rule has specific item type, so count loans of that
398             # specific item type
399             if (C4::Context->preference('item-level_itypes')) {
400                 $count_query .= " WHERE items.itype = ? ";
401             } else { 
402                 $count_query .= " JOIN  biblioitems USING (biblionumber) 
403                                   WHERE biblioitems.itemtype= ? ";
404             }
405             push @bind_params, $type;
406         }
407
408         $count_query .= " AND borrowernumber = ? ";
409         push @bind_params, $borrower->{'borrowernumber'};
410         my $rule_branch = $issuing_rule->{branchcode};
411         if ($rule_branch ne "*") {
412             if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
413                 $count_query .= " AND issues.branchcode = ? ";
414                 push @bind_params, $branch;
415             } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
416                 ; # if branch is the patron's home branch, then count all loans by patron
417             } else {
418                 $count_query .= " AND items.homebranch = ? ";
419                 push @bind_params, $branch;
420             }
421         }
422
423         my $count_sth = $dbh->prepare($count_query);
424         $count_sth->execute(@bind_params);
425         my ($current_loan_count) = $count_sth->fetchrow_array;
426
427         my $max_loans_allowed = $issuing_rule->{'maxissueqty'};
428         if ($current_loan_count >= $max_loans_allowed) {
429             return ($current_loan_count, $max_loans_allowed);
430         }
431     }
432
433     # Now count total loans against the limit for the branch
434     my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
435     if (defined($branch_borrower_circ_rule->{maxissueqty})) {
436         my @bind_params = ();
437         my $branch_count_query = "SELECT COUNT(*) FROM issues
438                                   JOIN items USING (itemnumber)
439                                   WHERE borrowernumber = ? ";
440         push @bind_params, $borrower->{borrowernumber};
441
442         if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
443             $branch_count_query .= " AND issues.branchcode = ? ";
444             push @bind_params, $branch;
445         } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
446             ; # if branch is the patron's home branch, then count all loans by patron
447         } else {
448             $branch_count_query .= " AND items.homebranch = ? ";
449             push @bind_params, $branch;
450         }
451         my $branch_count_sth = $dbh->prepare($branch_count_query);
452         $branch_count_sth->execute(@bind_params);
453         my ($current_loan_count) = $branch_count_sth->fetchrow_array;
454
455         my $max_loans_allowed = $branch_borrower_circ_rule->{maxissueqty};
456         if ($current_loan_count >= $max_loans_allowed) {
457             return ($current_loan_count, $max_loans_allowed);
458         }
459     }
460
461     # OK, the patron can issue !!!
462     return;
463 }
464
465 =head2 itemissues
466
467   @issues = &itemissues($biblioitemnumber, $biblio);
468
469 Looks up information about who has borrowed the bookZ<>(s) with the
470 given biblioitemnumber.
471
472 C<$biblio> is ignored.
473
474 C<&itemissues> returns an array of references-to-hash. The keys
475 include the fields from the C<items> table in the Koha database.
476 Additional keys include:
477
478 =over 4
479
480 =item C<date_due>
481
482 If the item is currently on loan, this gives the due date.
483
484 If the item is not on loan, then this is either "Available" or
485 "Cancelled", if the item has been withdrawn.
486
487 =item C<card>
488
489 If the item is currently on loan, this gives the card number of the
490 patron who currently has the item.
491
492 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
493
494 These give the timestamp for the last three times the item was
495 borrowed.
496
497 =item C<card0>, C<card1>, C<card2>
498
499 The card number of the last three patrons who borrowed this item.
500
501 =item C<borrower0>, C<borrower1>, C<borrower2>
502
503 The borrower number of the last three patrons who borrowed this item.
504
505 =back
506
507 =cut
508
509 #'
510 sub itemissues {
511     my ( $bibitem, $biblio ) = @_;
512     my $dbh = C4::Context->dbh;
513     my $sth =
514       $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
515       || die $dbh->errstr;
516     my $i = 0;
517     my @results;
518
519     $sth->execute($bibitem) || die $sth->errstr;
520
521     while ( my $data = $sth->fetchrow_hashref ) {
522
523         # Find out who currently has this item.
524         # FIXME - Wouldn't it be better to do this as a left join of
525         # some sort? Currently, this code assumes that if
526         # fetchrow_hashref() fails, then the book is on the shelf.
527         # fetchrow_hashref() can fail for any number of reasons (e.g.,
528         # database server crash), not just because no items match the
529         # search criteria.
530         my $sth2 = $dbh->prepare(
531             "SELECT * FROM issues
532                 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
533                 WHERE itemnumber = ?
534             "
535         );
536
537         $sth2->execute( $data->{'itemnumber'} );
538         if ( my $data2 = $sth2->fetchrow_hashref ) {
539             $data->{'date_due'} = $data2->{'date_due'};
540             $data->{'card'}     = $data2->{'cardnumber'};
541             $data->{'borrower'} = $data2->{'borrowernumber'};
542         }
543         else {
544             $data->{'date_due'} = ($data->{'wthdrawn'} eq '1') ? 'Cancelled' : 'Available';
545         }
546
547
548         # Find the last 3 people who borrowed this item.
549         $sth2 = $dbh->prepare(
550             "SELECT * FROM old_issues
551                 LEFT JOIN borrowers ON  issues.borrowernumber = borrowers.borrowernumber
552                 WHERE itemnumber = ?
553                 ORDER BY returndate DESC,timestamp DESC"
554         );
555
556         $sth2->execute( $data->{'itemnumber'} );
557         for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
558         {    # FIXME : error if there is less than 3 pple borrowing this item
559             if ( my $data2 = $sth2->fetchrow_hashref ) {
560                 $data->{"timestamp$i2"} = $data2->{'timestamp'};
561                 $data->{"card$i2"}      = $data2->{'cardnumber'};
562                 $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
563             }    # if
564         }    # for
565
566         $results[$i] = $data;
567         $i++;
568     }
569
570     return (@results);
571 }
572
573 =head2 CanBookBeIssued
574
575   ( $issuingimpossible, $needsconfirmation ) =  CanBookBeIssued( $borrower, 
576                       $barcode, $duedatespec, $inprocess, $ignore_reserves );
577
578 Check if a book can be issued.
579
580 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
581
582 =over 4
583
584 =item C<$borrower> hash with borrower informations (from GetMember or GetMemberDetails)
585
586 =item C<$barcode> is the bar code of the book being issued.
587
588 =item C<$duedatespec> is a C4::Dates object.
589
590 =item C<$inprocess> boolean switch
591 =item C<$ignore_reserves> boolean switch
592
593 =back
594
595 Returns :
596
597 =over 4
598
599 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
600 Possible values are :
601
602 =back
603
604 =head3 INVALID_DATE 
605
606 sticky due date is invalid
607
608 =head3 GNA
609
610 borrower gone with no address
611
612 =head3 CARD_LOST
613
614 borrower declared it's card lost
615
616 =head3 DEBARRED
617
618 borrower debarred
619
620 =head3 UNKNOWN_BARCODE
621
622 barcode unknown
623
624 =head3 NOT_FOR_LOAN
625
626 item is not for loan
627
628 =head3 WTHDRAWN
629
630 item withdrawn.
631
632 =head3 RESTRICTED
633
634 item is restricted (set by ??)
635
636 C<$needsconfirmation> a reference to a hash. It contains reasons why the loan 
637 could be prevented, but ones that can be overriden by the operator.
638
639 Possible values are :
640
641 =head3 DEBT
642
643 borrower has debts.
644
645 =head3 RENEW_ISSUE
646
647 renewing, not issuing
648
649 =head3 ISSUED_TO_ANOTHER
650
651 issued to someone else.
652
653 =head3 RESERVED
654
655 reserved for someone else.
656
657 =head3 INVALID_DATE
658
659 sticky due date is invalid or due date in the past
660
661 =head3 TOO_MANY
662
663 if the borrower borrows to much things
664
665 =cut
666
667 sub CanBookBeIssued {
668     my ( $borrower, $barcode, $duedate, $inprocess, $ignore_reserves ) = @_;
669     my %needsconfirmation;    # filled with problems that needs confirmations
670     my %issuingimpossible;    # filled with problems that causes the issue to be IMPOSSIBLE
671     my %alerts;               # filled with messages that shouldn't stop issuing, but the librarian should be aware of.
672
673     my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
674     my $issue = GetItemIssue($item->{itemnumber});
675         my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
676         $item->{'itemtype'}=$item->{'itype'}; 
677     my $dbh             = C4::Context->dbh;
678
679     # MANDATORY CHECKS - unless item exists, nothing else matters
680     unless ( $item->{barcode} ) {
681         $issuingimpossible{UNKNOWN_BARCODE} = 1;
682     }
683         return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible;
684
685     #
686     # DUE DATE is OK ? -- should already have checked.
687     #
688     if ($duedate && ref $duedate ne 'DateTime') {
689         $duedate = dt_from_string($duedate);
690     }
691     my $now = DateTime->now( time_zone => C4::Context->tz() );
692     unless ( $duedate ) {
693         my $issuedate = $now->clone();
694
695         my $branch = _GetCircControlBranch($item,$borrower);
696         my $itype = ( C4::Context->preference('item-level_itypes') ) ? $item->{'itype'} : $biblioitem->{'itemtype'};
697         $duedate = CalcDateDue( $issuedate, $itype, $branch, $borrower );
698
699         # Offline circ calls AddIssue directly, doesn't run through here
700         #  So issuingimpossible should be ok.
701     }
702     if ($duedate) {
703         my $today = $now->clone();
704         $today->truncate( to => 'minute');
705         if (DateTime->compare($duedate,$today) == -1 ) { # duedate cannot be before now
706             $needsconfirmation{INVALID_DATE} = output_pref($duedate);
707         }
708     } else {
709             $issuingimpossible{INVALID_DATE} = output_pref($duedate);
710     }
711
712     #
713     # BORROWER STATUS
714     #
715     if ( $borrower->{'category_type'} eq 'X' && (  $item->{barcode}  )) { 
716         # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1  .
717         &UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'});
718         ModDateLastSeen( $item->{'itemnumber'} );
719         return( { STATS => 1 }, {});
720     }
721     if ( $borrower->{flags}->{GNA} ) {
722         $issuingimpossible{GNA} = 1;
723     }
724     if ( $borrower->{flags}->{'LOST'} ) {
725         $issuingimpossible{CARD_LOST} = 1;
726     }
727     if ( $borrower->{flags}->{'DBARRED'} ) {
728         $issuingimpossible{DEBARRED} = 1;
729     }
730     if ( !defined $borrower->{dateexpiry} || $borrower->{'dateexpiry'} eq '0000-00-00') {
731         $issuingimpossible{EXPIRED} = 1;
732     } else {
733         my ($y, $m, $d) =  split /-/,$borrower->{'dateexpiry'};
734         if ($y && $m && $d) { # are we really writing oinvalid dates to borrs
735             my $expiry_dt = DateTime->new(
736                 year => $y,
737                 month => $m,
738                 day   => $d,
739                 time_zone => C4::Context->tz,
740             );
741             $expiry_dt->truncate( to => 'day');
742             my $today = $now->clone()->truncate(to => 'day');
743             if (DateTime->compare($today, $expiry_dt) == 1) {
744                 $issuingimpossible{EXPIRED} = 1;
745             }
746         } else {
747             carp("Invalid expity date in borr");
748             $issuingimpossible{EXPIRED} = 1;
749         }
750     }
751     #
752     # BORROWER STATUS
753     #
754
755     # DEBTS
756     my ($amount) =
757       C4::Members::GetMemberAccountRecords( $borrower->{'borrowernumber'}, '' && $duedate->ymd() );
758     my $amountlimit = C4::Context->preference("noissuescharge");
759     my $allowfineoverride = C4::Context->preference("AllowFineOverride");
760     my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride");
761     if ( C4::Context->preference("IssuingInProcess") ) {
762         if ( $amount > $amountlimit && !$inprocess && !$allowfineoverride) {
763             $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
764         } elsif ( $amount > $amountlimit && !$inprocess && $allowfineoverride) {
765             $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
766         } elsif ( $allfinesneedoverride && $amount > 0 && $amount <= $amountlimit && !$inprocess ) {
767             $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
768         }
769     }
770     else {
771         if ( $amount > $amountlimit && $allowfineoverride ) {
772             $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
773         } elsif ( $amount > $amountlimit && !$allowfineoverride) {
774             $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
775         } elsif ( $amount > 0 && $allfinesneedoverride ) {
776             $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
777         }
778     }
779
780     my ($blocktype, $count) = C4::Members::IsMemberBlocked($borrower->{'borrowernumber'});
781     if ($blocktype == -1) {
782         ## patron has outstanding overdue loans
783             if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){
784                 $issuingimpossible{USERBLOCKEDOVERDUE} = $count;
785             }
786             elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){
787                 $needsconfirmation{USERBLOCKEDOVERDUE} = $count;
788             }
789     } elsif($blocktype == 1) {
790         # patron has accrued fine days
791         $issuingimpossible{USERBLOCKEDREMAINING} = $count;
792     }
793
794 #
795     # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
796     #
797         my ($current_loan_count, $max_loans_allowed) = TooMany( $borrower, $item->{biblionumber}, $item );
798     # if TooMany max_loans_allowed returns 0 the user doesn't have permission to check out this book
799     if (defined $max_loans_allowed && $max_loans_allowed == 0) {
800         $needsconfirmation{PATRON_CANT} = 1;
801     } else {
802         if($max_loans_allowed){
803             $needsconfirmation{TOO_MANY} = 1;
804             $needsconfirmation{current_loan_count} = $current_loan_count;
805             $needsconfirmation{max_loans_allowed} = $max_loans_allowed;
806         }
807     }
808
809     #
810     # ITEM CHECKING
811     #
812     if (   $item->{'notforloan'}
813         && $item->{'notforloan'} > 0 )
814     {
815         if(!C4::Context->preference("AllowNotForLoanOverride")){
816             $issuingimpossible{NOT_FOR_LOAN} = 1;
817         }else{
818             $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
819         }
820     }
821     elsif ( !$item->{'notforloan'} ){
822         # we have to check itemtypes.notforloan also
823         if (C4::Context->preference('item-level_itypes')){
824             # this should probably be a subroutine
825             my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
826             $sth->execute($item->{'itemtype'});
827             my $notforloan=$sth->fetchrow_hashref();
828             $sth->finish();
829             if ($notforloan->{'notforloan'}) {
830                 if (!C4::Context->preference("AllowNotForLoanOverride")) {
831                     $issuingimpossible{NOT_FOR_LOAN} = 1;
832                 } else {
833                     $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
834                 }
835             }
836         }
837         elsif ($biblioitem->{'notforloan'} == 1){
838             if (!C4::Context->preference("AllowNotForLoanOverride")) {
839                 $issuingimpossible{NOT_FOR_LOAN} = 1;
840             } else {
841                 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
842             }
843         }
844     }
845     if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} > 0 )
846     {
847         $issuingimpossible{WTHDRAWN} = 1;
848     }
849     if (   $item->{'restricted'}
850         && $item->{'restricted'} == 1 )
851     {
852         $issuingimpossible{RESTRICTED} = 1;
853     }
854     if ( $item->{'itemlost'} && C4::Context->preference("IssueLostItem") ne 'nothing' ) {
855         my $code = GetAuthorisedValueByCode( 'LOST', $item->{'itemlost'} );
856         $needsconfirmation{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'confirm' );
857         $alerts{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'alert' );
858     }
859     if ( C4::Context->preference("IndependantBranches") ) {
860         my $userenv = C4::Context->userenv;
861         if ( ($userenv) && ( $userenv->{flags} % 2 != 1 ) ) {
862             $issuingimpossible{ITEMNOTSAMEBRANCH} = 1
863               if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} );
864             $needsconfirmation{BORRNOTSAMEBRANCH} = GetBranchName( $borrower->{'branchcode'} )
865               if ( $borrower->{'branchcode'} ne $userenv->{branch} );
866         }
867     }
868
869     #
870     # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
871     #
872     if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} )
873     {
874
875         # Already issued to current borrower. Ask whether the loan should
876         # be renewed.
877         my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
878             $borrower->{'borrowernumber'},
879             $item->{'itemnumber'}
880         );
881         if ( $CanBookBeRenewed == 0 ) {    # no more renewals allowed
882             $issuingimpossible{NO_MORE_RENEWALS} = 1;
883         }
884         else {
885             $needsconfirmation{RENEW_ISSUE} = 1;
886         }
887     }
888     elsif ($issue->{borrowernumber}) {
889
890         # issued to someone else
891         my $currborinfo =    C4::Members::GetMember( borrowernumber => $issue->{borrowernumber} );
892
893 #        warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
894         $needsconfirmation{ISSUED_TO_ANOTHER} = 1;
895         $needsconfirmation{issued_firstname} = $currborinfo->{'firstname'};
896         $needsconfirmation{issued_surname} = $currborinfo->{'surname'};
897         $needsconfirmation{issued_cardnumber} = $currborinfo->{'cardnumber'};
898         $needsconfirmation{issued_borrowernumber} = $currborinfo->{'borrowernumber'};
899     }
900
901     unless ( $ignore_reserves ) {
902         # See if the item is on reserve.
903         my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
904         if ($restype) {
905             my $resbor = $res->{'borrowernumber'};
906             if ( $resbor ne $borrower->{'borrowernumber'} ) {
907                 my ( $resborrower ) = C4::Members::GetMember( borrowernumber => $resbor );
908                 my $branchname = GetBranchName( $res->{'branchcode'} );
909                 if ( $restype eq "Waiting" )
910                 {
911                     # The item is on reserve and waiting, but has been
912                     # reserved by some other patron.
913                     $needsconfirmation{RESERVE_WAITING} = 1;
914                     $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
915                     $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
916                     $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
917                     $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
918                     $needsconfirmation{'resbranchname'} = $branchname;
919                     $needsconfirmation{'reswaitingdate'} = format_date($res->{'waitingdate'});
920                 }
921                 elsif ( $restype eq "Reserved" ) {
922                     # The item is on reserve for someone else.
923                     $needsconfirmation{RESERVED} = 1;
924                     $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
925                     $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
926                     $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
927                     $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
928                     $needsconfirmation{'resbranchname'} = $branchname;
929                     $needsconfirmation{'resreservedate'} = format_date($res->{'reservedate'});
930                 }
931             }
932         }
933     }
934     return ( \%issuingimpossible, \%needsconfirmation, \%alerts );
935 }
936
937 =head2 AddIssue
938
939   &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
940
941 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
942
943 =over 4
944
945 =item C<$borrower> is a hash with borrower informations (from GetMember or GetMemberDetails).
946
947 =item C<$barcode> is the barcode of the item being issued.
948
949 =item C<$datedue> is a C4::Dates object for the max date of return, i.e. the date due (optional).
950 Calculated if empty.
951
952 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
953
954 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
955 Defaults to today.  Unlike C<$datedue>, NOT a C4::Dates object, unfortunately.
956
957 AddIssue does the following things :
958
959   - step 01: check that there is a borrowernumber & a barcode provided
960   - check for RENEWAL (book issued & being issued to the same patron)
961       - renewal YES = Calculate Charge & renew
962       - renewal NO  =
963           * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
964           * RESERVE PLACED ?
965               - fill reserve if reserve to this patron
966               - cancel reserve or not, otherwise
967           * TRANSFERT PENDING ?
968               - complete the transfert
969           * ISSUE THE BOOK
970
971 =back
972
973 =cut
974
975 sub AddIssue {
976     my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode) = @_;
977     my $dbh = C4::Context->dbh;
978         my $barcodecheck=CheckValidBarcode($barcode);
979     if ($datedue && ref $datedue ne 'DateTime') {
980         $datedue = dt_from_string($datedue);
981     }
982     # $issuedate defaults to today.
983     if ( ! defined $issuedate ) {
984         $issuedate = DateTime->now(time_zone => C4::Context->tz());
985     }
986     else {
987         if ( ref $issuedate ne 'DateTime') {
988             $issuedate = dt_from_string($issuedate);
989
990         }
991     }
992         if ($borrower and $barcode and $barcodecheck ne '0'){#??? wtf
993                 # find which item we issue
994                 my $item = GetItem('', $barcode) or return undef;       # if we don't get an Item, abort.
995                 my $branch = _GetCircControlBranch($item,$borrower);
996                 
997                 # get actual issuing if there is one
998                 my $actualissue = GetItemIssue( $item->{itemnumber});
999                 
1000                 # get biblioinformation for this item
1001                 my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
1002                 
1003                 #
1004                 # check if we just renew the issue.
1005                 #
1006                 if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) {
1007                     $datedue = AddRenewal(
1008                         $borrower->{'borrowernumber'},
1009                         $item->{'itemnumber'},
1010                         $branch,
1011                         $datedue,
1012                         $issuedate, # here interpreted as the renewal date
1013                         );
1014                 }
1015                 else {
1016         # it's NOT a renewal
1017                         if ( $actualissue->{borrowernumber}) {
1018                                 # This book is currently on loan, but not to the person
1019                                 # who wants to borrow it now. mark it returned before issuing to the new borrower
1020                                 AddReturn(
1021                                         $item->{'barcode'},
1022                                         C4::Context->userenv->{'branch'}
1023                                 );
1024                         }
1025
1026             MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve );
1027                         # Starting process for transfer job (checking transfert and validate it if we have one)
1028             my ($datesent) = GetTransfers($item->{'itemnumber'});
1029             if ($datesent) {
1030         #       updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
1031                 my $sth =
1032                     $dbh->prepare(
1033                     "UPDATE branchtransfers 
1034                         SET datearrived = now(),
1035                         tobranch = ?,
1036                         comments = 'Forced branchtransfer'
1037                     WHERE itemnumber= ? AND datearrived IS NULL"
1038                     );
1039                 $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
1040             }
1041
1042         # Record in the database the fact that the book was issued.
1043         my $sth =
1044           $dbh->prepare(
1045                 "INSERT INTO issues
1046                     (borrowernumber, itemnumber,issuedate, date_due, branchcode)
1047                 VALUES (?,?,?,?,?)"
1048           );
1049         unless ($datedue) {
1050             my $itype = ( C4::Context->preference('item-level_itypes') ) ? $biblio->{'itype'} : $biblio->{'itemtype'};
1051             $datedue = CalcDateDue( $issuedate, $itype, $branch, $borrower );
1052
1053         }
1054         $datedue->truncate( to => 'minute');
1055         $sth->execute(
1056             $borrower->{'borrowernumber'},      # borrowernumber
1057             $item->{'itemnumber'},              # itemnumber
1058             $issuedate->strftime('%Y-%m-%d %H:%M:00'), # issuedate
1059             $datedue->strftime('%Y-%m-%d %H:%M:00'),   # date_due
1060             C4::Context->userenv->{'branch'}    # branchcode
1061         );
1062         if ( C4::Context->preference('ReturnToShelvingCart') ) { ## ReturnToShelvingCart is on, anything issued should be taken off the cart.
1063           CartToShelf( $item->{'itemnumber'} );
1064         }
1065         $item->{'issues'}++;
1066         if ( C4::Context->preference('UpdateTotalIssuesOnCirc') ) {
1067             UpdateTotalIssues($item->{'biblionumber'}, 1);
1068         }
1069
1070         ## If item was lost, it has now been found, reverse any list item charges if neccessary.
1071         if ( $item->{'itemlost'} ) {
1072             _FixAccountForLostAndReturned( $item->{'itemnumber'}, undef, $item->{'barcode'} );
1073         }
1074
1075         ModItem({ issues           => $item->{'issues'},
1076                   holdingbranch    => C4::Context->userenv->{'branch'},
1077                   itemlost         => 0,
1078                   datelastborrowed => DateTime->now(time_zone => C4::Context->tz())->ymd(),
1079                   onloan           => $datedue->ymd(),
1080                 }, $item->{'biblionumber'}, $item->{'itemnumber'});
1081         ModDateLastSeen( $item->{'itemnumber'} );
1082
1083         # If it costs to borrow this book, charge it to the patron's account.
1084         my ( $charge, $itemtype ) = GetIssuingCharges(
1085             $item->{'itemnumber'},
1086             $borrower->{'borrowernumber'}
1087         );
1088         if ( $charge > 0 ) {
1089             AddIssuingCharge(
1090                 $item->{'itemnumber'},
1091                 $borrower->{'borrowernumber'}, $charge
1092             );
1093             $item->{'charge'} = $charge;
1094         }
1095
1096         # Record the fact that this book was issued.
1097         &UpdateStats(
1098             C4::Context->userenv->{'branch'},
1099             'issue', $charge,
1100             ($sipmode ? "SIP-$sipmode" : ''), $item->{'itemnumber'},
1101             $item->{'itype'}, $borrower->{'borrowernumber'}
1102         );
1103
1104         # Send a checkout slip.
1105         my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1106         my %conditions = (
1107             branchcode   => $branch,
1108             categorycode => $borrower->{categorycode},
1109             item_type    => $item->{itype},
1110             notification => 'CHECKOUT',
1111         );
1112         if ($circulation_alert->is_enabled_for(\%conditions)) {
1113             SendCirculationAlert({
1114                 type     => 'CHECKOUT',
1115                 item     => $item,
1116                 borrower => $borrower,
1117                 branch   => $branch,
1118             });
1119         }
1120     }
1121
1122     logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'biblionumber'})
1123         if C4::Context->preference("IssueLog");
1124   }
1125   return ($datedue);    # not necessarily the same as when it came in!
1126 }
1127
1128 =head2 GetLoanLength
1129
1130   my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1131
1132 Get loan length for an itemtype, a borrower type and a branch
1133
1134 =cut
1135
1136 sub GetLoanLength {
1137     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1138     my $dbh = C4::Context->dbh;
1139     my $sth =
1140       $dbh->prepare(
1141 'select issuelength, lengthunit from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null'
1142       );
1143 # warn "in get loan lenght $borrowertype $itemtype $branchcode ";
1144 # try to find issuelength & return the 1st available.
1145 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1146     $sth->execute( $borrowertype, $itemtype, $branchcode );
1147     my $loanlength = $sth->fetchrow_hashref;
1148     return $loanlength
1149       if defined($loanlength) && $loanlength->{issuelength};
1150
1151     $sth->execute( $borrowertype, '*', $branchcode );
1152     $loanlength = $sth->fetchrow_hashref;
1153     return $loanlength
1154       if defined($loanlength) && $loanlength->{issuelength};
1155
1156     $sth->execute( '*', $itemtype, $branchcode );
1157     $loanlength = $sth->fetchrow_hashref;
1158     return $loanlength
1159       if defined($loanlength) && $loanlength->{issuelength};
1160
1161     $sth->execute( '*', '*', $branchcode );
1162     $loanlength = $sth->fetchrow_hashref;
1163     return $loanlength
1164       if defined($loanlength) && $loanlength->{issuelength};
1165
1166     $sth->execute( $borrowertype, $itemtype, '*' );
1167     $loanlength = $sth->fetchrow_hashref;
1168     return $loanlength
1169       if defined($loanlength) && $loanlength->{issuelength};
1170
1171     $sth->execute( $borrowertype, '*', '*' );
1172     $loanlength = $sth->fetchrow_hashref;
1173     return $loanlength
1174       if defined($loanlength) && $loanlength->{issuelength};
1175
1176     $sth->execute( '*', $itemtype, '*' );
1177     $loanlength = $sth->fetchrow_hashref;
1178     return $loanlength
1179       if defined($loanlength) && $loanlength->{issuelength};
1180
1181     $sth->execute( '*', '*', '*' );
1182     $loanlength = $sth->fetchrow_hashref;
1183     return $loanlength
1184       if defined($loanlength) && $loanlength->{issuelength};
1185
1186     # if no rule is set => 21 days (hardcoded)
1187     return {
1188         issuelength => 21,
1189         lengthunit => 'days',
1190     };
1191
1192 }
1193
1194
1195 =head2 GetHardDueDate
1196
1197   my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode)
1198
1199 Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch
1200
1201 =cut
1202
1203 sub GetHardDueDate {
1204     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1205     my $dbh = C4::Context->dbh;
1206     my $sth =
1207       $dbh->prepare(
1208 "select hardduedate, hardduedatecompare from issuingrules where categorycode=? and itemtype=? and branchcode=?"
1209       );
1210     $sth->execute( $borrowertype, $itemtype, $branchcode );
1211     my $results = $sth->fetchrow_hashref;
1212     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1213       if defined($results) && $results->{hardduedate};
1214
1215     $sth->execute( $borrowertype, "*", $branchcode );
1216     $results = $sth->fetchrow_hashref;
1217     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1218       if defined($results) && $results->{hardduedate};
1219
1220     $sth->execute( "*", $itemtype, $branchcode );
1221     $results = $sth->fetchrow_hashref;
1222     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1223       if defined($results) && $results->{hardduedate};
1224
1225     $sth->execute( "*", "*", $branchcode );
1226     $results = $sth->fetchrow_hashref;
1227     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1228       if defined($results) && $results->{hardduedate};
1229
1230     $sth->execute( $borrowertype, $itemtype, "*" );
1231     $results = $sth->fetchrow_hashref;
1232     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1233       if defined($results) && $results->{hardduedate};
1234
1235     $sth->execute( $borrowertype, "*", "*" );
1236     $results = $sth->fetchrow_hashref;
1237     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1238       if defined($results) && $results->{hardduedate};
1239
1240     $sth->execute( "*", $itemtype, "*" );
1241     $results = $sth->fetchrow_hashref;
1242     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1243       if defined($results) && $results->{hardduedate};
1244
1245     $sth->execute( "*", "*", "*" );
1246     $results = $sth->fetchrow_hashref;
1247     return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1248       if defined($results) && $results->{hardduedate};
1249
1250     # if no rule is set => return undefined
1251     return (undef, undef);
1252 }
1253
1254 =head2 GetIssuingRule
1255
1256   my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1257
1258 FIXME - This is a copy-paste of GetLoanLength
1259 as a stop-gap.  Do not wish to change API for GetLoanLength 
1260 this close to release, however, Overdues::GetIssuingRules is broken.
1261
1262 Get the issuing rule for an itemtype, a borrower type and a branch
1263 Returns a hashref from the issuingrules table.
1264
1265 =cut
1266
1267 sub GetIssuingRule {
1268     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1269     my $dbh = C4::Context->dbh;
1270     my $sth =  $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"  );
1271     my $irule;
1272
1273         $sth->execute( $borrowertype, $itemtype, $branchcode );
1274     $irule = $sth->fetchrow_hashref;
1275     return $irule if defined($irule) ;
1276
1277     $sth->execute( $borrowertype, "*", $branchcode );
1278     $irule = $sth->fetchrow_hashref;
1279     return $irule if defined($irule) ;
1280
1281     $sth->execute( "*", $itemtype, $branchcode );
1282     $irule = $sth->fetchrow_hashref;
1283     return $irule if defined($irule) ;
1284
1285     $sth->execute( "*", "*", $branchcode );
1286     $irule = $sth->fetchrow_hashref;
1287     return $irule if defined($irule) ;
1288
1289     $sth->execute( $borrowertype, $itemtype, "*" );
1290     $irule = $sth->fetchrow_hashref;
1291     return $irule if defined($irule) ;
1292
1293     $sth->execute( $borrowertype, "*", "*" );
1294     $irule = $sth->fetchrow_hashref;
1295     return $irule if defined($irule) ;
1296
1297     $sth->execute( "*", $itemtype, "*" );
1298     $irule = $sth->fetchrow_hashref;
1299     return $irule if defined($irule) ;
1300
1301     $sth->execute( "*", "*", "*" );
1302     $irule = $sth->fetchrow_hashref;
1303     return $irule if defined($irule) ;
1304
1305     # if no rule matches,
1306     return undef;
1307 }
1308
1309 =head2 GetBranchBorrowerCircRule
1310
1311   my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1312
1313 Retrieves circulation rule attributes that apply to the given
1314 branch and patron category, regardless of item type.  
1315 The return value is a hashref containing the following key:
1316
1317 maxissueqty - maximum number of loans that a
1318 patron of the given category can have at the given
1319 branch.  If the value is undef, no limit.
1320
1321 This will first check for a specific branch and
1322 category match from branch_borrower_circ_rules. 
1323
1324 If no rule is found, it will then check default_branch_circ_rules
1325 (same branch, default category).  If no rule is found,
1326 it will then check default_borrower_circ_rules (default 
1327 branch, same category), then failing that, default_circ_rules
1328 (default branch, default category).
1329
1330 If no rule has been found in the database, it will default to
1331 the buillt in rule:
1332
1333 maxissueqty - undef
1334
1335 C<$branchcode> and C<$categorycode> should contain the
1336 literal branch code and patron category code, respectively - no
1337 wildcards.
1338
1339 =cut
1340
1341 sub GetBranchBorrowerCircRule {
1342     my $branchcode = shift;
1343     my $categorycode = shift;
1344
1345     my $branch_cat_query = "SELECT maxissueqty
1346                             FROM branch_borrower_circ_rules
1347                             WHERE branchcode = ?
1348                             AND   categorycode = ?";
1349     my $dbh = C4::Context->dbh();
1350     my $sth = $dbh->prepare($branch_cat_query);
1351     $sth->execute($branchcode, $categorycode);
1352     my $result;
1353     if ($result = $sth->fetchrow_hashref()) {
1354         return $result;
1355     }
1356
1357     # try same branch, default borrower category
1358     my $branch_query = "SELECT maxissueqty
1359                         FROM default_branch_circ_rules
1360                         WHERE branchcode = ?";
1361     $sth = $dbh->prepare($branch_query);
1362     $sth->execute($branchcode);
1363     if ($result = $sth->fetchrow_hashref()) {
1364         return $result;
1365     }
1366
1367     # try default branch, same borrower category
1368     my $category_query = "SELECT maxissueqty
1369                           FROM default_borrower_circ_rules
1370                           WHERE categorycode = ?";
1371     $sth = $dbh->prepare($category_query);
1372     $sth->execute($categorycode);
1373     if ($result = $sth->fetchrow_hashref()) {
1374         return $result;
1375     }
1376   
1377     # try default branch, default borrower category
1378     my $default_query = "SELECT maxissueqty
1379                           FROM default_circ_rules";
1380     $sth = $dbh->prepare($default_query);
1381     $sth->execute();
1382     if ($result = $sth->fetchrow_hashref()) {
1383         return $result;
1384     }
1385     
1386     # built-in default circulation rule
1387     return {
1388         maxissueqty => undef,
1389     };
1390 }
1391
1392 =head2 GetBranchItemRule
1393
1394   my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1395
1396 Retrieves circulation rule attributes that apply to the given
1397 branch and item type, regardless of patron category.
1398
1399 The return value is a hashref containing the following keys:
1400
1401 holdallowed => Hold policy for this branch and itemtype. Possible values:
1402   0: No holds allowed.
1403   1: Holds allowed only by patrons that have the same homebranch as the item.
1404   2: Holds allowed from any patron.
1405
1406 returnbranch => branch to which to return item.  Possible values:
1407   noreturn: do not return, let item remain where checked in (floating collections)
1408   homebranch: return to item's home branch
1409
1410 This searches branchitemrules in the following order:
1411
1412   * Same branchcode and itemtype
1413   * Same branchcode, itemtype '*'
1414   * branchcode '*', same itemtype
1415   * branchcode and itemtype '*'
1416
1417 Neither C<$branchcode> nor C<$itemtype> should be '*'.
1418
1419 =cut
1420
1421 sub GetBranchItemRule {
1422     my ( $branchcode, $itemtype ) = @_;
1423     my $dbh = C4::Context->dbh();
1424     my $result = {};
1425
1426     my @attempts = (
1427         ['SELECT holdallowed, returnbranch
1428             FROM branch_item_rules
1429             WHERE branchcode = ?
1430               AND itemtype = ?', $branchcode, $itemtype],
1431         ['SELECT holdallowed, returnbranch
1432             FROM default_branch_circ_rules
1433             WHERE branchcode = ?', $branchcode],
1434         ['SELECT holdallowed, returnbranch
1435             FROM default_branch_item_rules
1436             WHERE itemtype = ?', $itemtype],
1437         ['SELECT holdallowed, returnbranch
1438             FROM default_circ_rules'],
1439     );
1440
1441     foreach my $attempt (@attempts) {
1442         my ($query, @bind_params) = @{$attempt};
1443         my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params );
1444
1445         # Since branch/category and branch/itemtype use the same per-branch
1446         # defaults tables, we have to check that the key we want is set, not
1447         # just that a row was returned
1448         $result->{'holdallowed'}  = $search_result->{'holdallowed'}  unless ( defined $result->{'holdallowed'} );
1449         $result->{'returnbranch'} = $search_result->{'returnbranch'} unless ( defined $result->{'returnbranch'} );
1450     }
1451     
1452     # built-in default circulation rule
1453     $result->{'holdallowed'} = 2 unless ( defined $result->{'holdallowed'} );
1454     $result->{'returnbranch'} = 'homebranch' unless ( defined $result->{'returnbranch'} );
1455
1456     return $result;
1457 }
1458
1459 =head2 AddReturn
1460
1461   ($doreturn, $messages, $iteminformation, $borrower) =
1462       &AddReturn($barcode, $branch, $exemptfine, $dropbox);
1463
1464 Returns a book.
1465
1466 =over 4
1467
1468 =item C<$barcode> is the bar code of the book being returned.
1469
1470 =item C<$branch> is the code of the branch where the book is being returned.
1471
1472 =item C<$exemptfine> indicates that overdue charges for the item will be
1473 removed.
1474
1475 =item C<$dropbox> indicates that the check-in date is assumed to be
1476 yesterday, or the last non-holiday as defined in C4::Calendar .  If
1477 overdue charges are applied and C<$dropbox> is true, the last charge
1478 will be removed.  This assumes that the fines accrual script has run
1479 for _today_.
1480
1481 =back
1482
1483 C<&AddReturn> returns a list of four items:
1484
1485 C<$doreturn> is true iff the return succeeded.
1486
1487 C<$messages> is a reference-to-hash giving feedback on the operation.
1488 The keys of the hash are:
1489
1490 =over 4
1491
1492 =item C<BadBarcode>
1493
1494 No item with this barcode exists. The value is C<$barcode>.
1495
1496 =item C<NotIssued>
1497
1498 The book is not currently on loan. The value is C<$barcode>.
1499
1500 =item C<IsPermanent>
1501
1502 The book's home branch is a permanent collection. If you have borrowed
1503 this book, you are not allowed to return it. The value is the code for
1504 the book's home branch.
1505
1506 =item C<wthdrawn>
1507
1508 This book has been withdrawn/cancelled. The value should be ignored.
1509
1510 =item C<Wrongbranch>
1511
1512 This book has was returned to the wrong branch.  The value is a hashref
1513 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1514 contain the branchcode of the incorrect and correct return library, respectively.
1515
1516 =item C<ResFound>
1517
1518 The item was reserved. The value is a reference-to-hash whose keys are
1519 fields from the reserves table of the Koha database, and
1520 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1521 either C<Waiting>, C<Reserved>, or 0.
1522
1523 =back
1524
1525 C<$iteminformation> is a reference-to-hash, giving information about the
1526 returned item from the issues table.
1527
1528 C<$borrower> is a reference-to-hash, giving information about the
1529 patron who last borrowed the book.
1530
1531 =cut
1532
1533 sub AddReturn {
1534     my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
1535
1536     if ($branch and not GetBranchDetail($branch)) {
1537         warn "AddReturn error: branch '$branch' not found.  Reverting to " . C4::Context->userenv->{'branch'};
1538         undef $branch;
1539     }
1540     $branch = C4::Context->userenv->{'branch'} unless $branch;  # we trust userenv to be a safe fallback/default
1541     my $messages;
1542     my $borrower;
1543     my $biblio;
1544     my $doreturn       = 1;
1545     my $validTransfert = 0;
1546     my $stat_type = 'return';    
1547
1548     # get information on item
1549     my $itemnumber = GetItemnumberFromBarcode( $barcode );
1550     unless ($itemnumber) {
1551         return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower.  bail out.
1552     }
1553     my $issue  = GetItemIssue($itemnumber);
1554 #   warn Dumper($iteminformation);
1555     if ($issue and $issue->{borrowernumber}) {
1556         $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
1557             or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existant borrowernumber '$issue->{borrowernumber}'\n"
1558                 . Dumper($issue) . "\n";
1559     } else {
1560         $messages->{'NotIssued'} = $barcode;
1561         # even though item is not on loan, it may still be transferred;  therefore, get current branch info
1562         $doreturn = 0;
1563         # No issue, no borrowernumber.  ONLY if $doreturn, *might* you have a $borrower later.
1564         # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
1565         if (C4::Context->preference("RecordLocalUseOnReturn")) {
1566            $messages->{'LocalUse'} = 1;
1567            $stat_type = 'localuse';
1568         }
1569     }
1570
1571     my $item = GetItem($itemnumber) or die "GetItem($itemnumber) failed";
1572         # full item data, but no borrowernumber or checkout info (no issue)
1573         # we know GetItem should work because GetItemnumberFromBarcode worked
1574     my $hbr      = GetBranchItemRule($item->{'homebranch'}, $item->{'itype'})->{'returnbranch'} || "homebranch";
1575         # get the proper branch to which to return the item
1576     $hbr = $item->{$hbr} || $branch ;
1577         # if $hbr was "noreturn" or any other non-item table value, then it should 'float' (i.e. stay at this branch)
1578
1579     my $borrowernumber = $borrower->{'borrowernumber'} || undef;    # we don't know if we had a borrower or not
1580
1581     # check if the book is in a permanent collection....
1582     # FIXME -- This 'PE' attribute is largely undocumented.  afaict, there's no user interface that reflects this functionality.
1583     if ( $hbr ) {
1584         my $branches = GetBranches();    # a potentially expensive call for a non-feature.
1585         $branches->{$hbr}->{PE} and $messages->{'IsPermanent'} = $hbr;
1586     }
1587
1588     # if indy branches and returning to different branch, refuse the return unless canreservefromotherbranches is turned on
1589     if ($hbr ne $branch && C4::Context->preference("IndependantBranches") && !(C4::Context->preference("canreservefromotherbranches"))){
1590         $messages->{'Wrongbranch'} = {
1591             Wrongbranch => $branch,
1592             Rightbranch => $hbr,
1593         };
1594         $doreturn = 0;
1595         # bailing out here - in this case, current desired behavior
1596         # is to act as if no return ever happened at all.
1597         # FIXME - even in an indy branches situation, there should
1598         # still be an option for the library to accept the item
1599         # and transfer it to its owning library.
1600         return ( $doreturn, $messages, $issue, $borrower );
1601     }
1602
1603     if ( $item->{'wthdrawn'} ) { # book has been cancelled
1604         $messages->{'wthdrawn'} = 1;
1605         $doreturn = 0;
1606     }
1607
1608     # case of a return of document (deal with issues and holdingbranch)
1609     if ($doreturn) {
1610     my $today = DateTime->now( time_zone => C4::Context->tz() );
1611     my $datedue = $issue->{date_due};
1612         $borrower or warn "AddReturn without current borrower";
1613                 my $circControlBranch;
1614         if ($dropbox) {
1615             # define circControlBranch only if dropbox mode is set
1616             # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
1617             # FIXME: check issuedate > returndate, factoring in holidays
1618             #$circControlBranch = _GetCircControlBranch($item,$borrower) unless ( $item->{'issuedate'} eq C4::Dates->today('iso') );;
1619             $circControlBranch = _GetCircControlBranch($item,$borrower);
1620         my $datedue = $issue->{date_due};
1621         $issue->{'overdue'} = DateTime->compare($issue->{'date_due'}, $today ) == -1 ? 1 : 0;
1622         }
1623
1624         if ($borrowernumber) {
1625         if($issue->{'overdue'}){
1626                 my ( $amount, $type, $daycounttotal ) = C4::Overdues::CalcFine( $item, $borrower->{categorycode},$branch, $datedue, $today );
1627                 $type ||= q{};
1628         if ( $amount > 0 && ( C4::Context->preference('finesMode') eq 'production' )) {
1629           C4::Overdues::UpdateFine(
1630               $issue->{itemnumber},
1631               $issue->{borrowernumber},
1632                       $amount, $type, output_pref($datedue)
1633               );
1634         }
1635             }
1636             MarkIssueReturned($borrowernumber, $item->{'itemnumber'}, $circControlBranch, '', $borrower->{'privacy'});
1637             $messages->{'WasReturned'} = 1;    # FIXME is the "= 1" right?  This could be the borrower hash.
1638         }
1639
1640         ModItem({ onloan => undef }, $issue->{'biblionumber'}, $item->{'itemnumber'});
1641     }
1642
1643     # the holdingbranch is updated if the document is returned to another location.
1644     # this is always done regardless of whether the item was on loan or not
1645     if ($item->{'holdingbranch'} ne $branch) {
1646         UpdateHoldingbranch($branch, $item->{'itemnumber'});
1647         $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
1648     }
1649     ModDateLastSeen( $item->{'itemnumber'} );
1650
1651     # check if we have a transfer for this document
1652     my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
1653
1654     # if we have a transfer to do, we update the line of transfers with the datearrived
1655     if ($datesent) {
1656         if ( $tobranch eq $branch ) {
1657             my $sth = C4::Context->dbh->prepare(
1658                 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1659             );
1660             $sth->execute( $item->{'itemnumber'} );
1661             # if we have a reservation with valid transfer, we can set it's status to 'W'
1662             C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
1663         } else {
1664             $messages->{'WrongTransfer'}     = $tobranch;
1665             $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
1666         }
1667         $validTransfert = 1;
1668     }
1669
1670     # fix up the accounts.....
1671     if ($item->{'itemlost'}) {
1672         _FixAccountForLostAndReturned($item->{'itemnumber'}, $borrowernumber, $barcode);    # can tolerate undef $borrowernumber
1673         $messages->{'WasLost'} = 1;
1674     }
1675
1676     # fix up the overdues in accounts...
1677     if ($borrowernumber) {
1678         my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
1679         defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!";  # zero is OK, check defined
1680         
1681         # fix fine days
1682         my $debardate = _FixFineDaysOnReturn( $borrower, $item, $issue->{date_due} );
1683         $messages->{'Debarred'} = $debardate if ($debardate);
1684     }
1685
1686     # find reserves.....
1687     # if we don't have a reserve with the status W, we launch the Checkreserves routine
1688     my ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
1689     if ($resfound) {
1690           $resrec->{'ResFound'} = $resfound;
1691         $messages->{'ResFound'} = $resrec;
1692     }
1693
1694     # update stats?
1695     # Record the fact that this book was returned.
1696     UpdateStats(
1697         $branch, $stat_type, '0', '',
1698         $item->{'itemnumber'},
1699         $biblio->{'itemtype'},
1700         $borrowernumber
1701     );
1702
1703     # Send a check-in slip. # NOTE: borrower may be undef.  probably shouldn't try to send messages then.
1704     my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1705     my %conditions = (
1706         branchcode   => $branch,
1707         categorycode => $borrower->{categorycode},
1708         item_type    => $item->{itype},
1709         notification => 'CHECKIN',
1710     );
1711     if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
1712         SendCirculationAlert({
1713             type     => 'CHECKIN',
1714             item     => $item,
1715             borrower => $borrower,
1716             branch   => $branch,
1717         });
1718     }
1719     
1720     logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'biblionumber'})
1721         if C4::Context->preference("ReturnLog");
1722     
1723     # FIXME: make this comment intelligible.
1724     #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1725     #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1726
1727     if (($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $hbr) and not $messages->{'WrongTransfer'}){
1728         if ( C4::Context->preference("AutomaticItemReturn"    ) or
1729             (C4::Context->preference("UseBranchTransferLimits") and
1730              ! IsBranchTransferAllowed($branch, $hbr, $item->{C4::Context->preference("BranchTransferLimitsType")} )
1731            )) {
1732             $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $hbr;
1733             $debug and warn "item: " . Dumper($item);
1734             ModItemTransfer($item->{'itemnumber'}, $branch, $hbr);
1735             $messages->{'WasTransfered'} = 1;
1736         } else {
1737             $messages->{'NeedsTransfer'} = 1;   # TODO: instead of 1, specify branchcode that the transfer SHOULD go to, $item->{homebranch}
1738         }
1739     }
1740     return ( $doreturn, $messages, $issue, $borrower );
1741 }
1742
1743 =head2 MarkIssueReturned
1744
1745   MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy);
1746
1747 Unconditionally marks an issue as being returned by
1748 moving the C<issues> row to C<old_issues> and
1749 setting C<returndate> to the current date, or
1750 the last non-holiday date of the branccode specified in
1751 C<dropbox_branch> .  Assumes you've already checked that 
1752 it's safe to do this, i.e. last non-holiday > issuedate.
1753
1754 if C<$returndate> is specified (in iso format), it is used as the date
1755 of the return. It is ignored when a dropbox_branch is passed in.
1756
1757 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
1758 the old_issue is immediately anonymised
1759
1760 Ideally, this function would be internal to C<C4::Circulation>,
1761 not exported, but it is currently needed by one 
1762 routine in C<C4::Accounts>.
1763
1764 =cut
1765
1766 sub MarkIssueReturned {
1767     my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
1768
1769     my $dbh   = C4::Context->dbh;
1770     my $query = 'UPDATE issues SET returndate=';
1771     my @bind;
1772     if ($dropbox_branch) {
1773         my $calendar = Koha::Calendar->new( branchcode => $dropbox_branch );
1774         my $dropboxdate = $calendar->addDate( DateTime->now( time_zone => C4::Context->tz), -1 );
1775         $query .= ' ? ';
1776         push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
1777     } elsif ($returndate) {
1778         $query .= ' ? ';
1779         push @bind, $returndate;
1780     } else {
1781         $query .= ' now() ';
1782     }
1783     $query .= ' WHERE  borrowernumber = ?  AND itemnumber = ?';
1784     push @bind, $borrowernumber, $itemnumber;
1785     # FIXME transaction
1786     my $sth_upd  = $dbh->prepare($query);
1787     $sth_upd->execute(@bind);
1788     my $sth_copy = $dbh->prepare('INSERT INTO old_issues SELECT * FROM issues
1789                                   WHERE borrowernumber = ?
1790                                   AND itemnumber = ?');
1791     $sth_copy->execute($borrowernumber, $itemnumber);
1792     # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
1793     if ( $privacy == 2) {
1794         # The default of 0 does not work due to foreign key constraints
1795         # The anonymisation will fail quietly if AnonymousPatron is not a valid entry
1796         my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0;
1797         my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=?
1798                                   WHERE borrowernumber = ?
1799                                   AND itemnumber = ?");
1800        $sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber);
1801     }
1802     my $sth_del  = $dbh->prepare("DELETE FROM issues
1803                                   WHERE borrowernumber = ?
1804                                   AND itemnumber = ?");
1805     $sth_del->execute($borrowernumber, $itemnumber);
1806 }
1807
1808 =head2 _FixFineDaysOnReturn
1809
1810     &_FixFineDaysOnReturn($borrower, $item, $datedue);
1811
1812 C<$borrower> borrower hashref
1813
1814 C<$item> item hashref
1815
1816 C<$datedue> date due
1817
1818 Internal function, called only by AddReturn that calculate and update the user fine days, and debars him
1819
1820 =cut
1821
1822 sub _FixFineDaysOnReturn {
1823     my ( $borrower, $item, $datedue ) = @_;
1824     return unless ($datedue);
1825     
1826     my $dt_due =  dt_from_string( $datedue );
1827     my $dt_today = DateTime->now( time_zone => C4::Context->tz() );
1828
1829     my $branchcode = _GetCircControlBranch( $item, $borrower );
1830     my $calendar = Koha::Calendar->new( branchcode => $branchcode );
1831
1832     # $deltadays is a DateTime::Duration object
1833     my $deltadays = $calendar->days_between( $dt_due, $dt_today );
1834
1835     my $circcontrol = C4::Context::preference('CircControl');
1836     my $issuingrule = GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
1837     my $finedays    = $issuingrule->{finedays};
1838     my $unit        = $issuingrule->{lengthunit};
1839
1840     # exit if no finedays defined
1841     return unless $finedays;
1842     # finedays is in days, so hourly loans must multiply by 24
1843     # thus 1 hour late equals 1 day suspension * finedays rate
1844     $finedays       = $finedays * 24 if ($unit eq 'hours');
1845
1846     # grace period is measured in the same units as the loan
1847     my $grace = DateTime::Duration->new( $unit => $issuingrule->{firstremind} );
1848
1849     if ( ( $deltadays - $grace )->is_positive ) { # you can't compare DateTime::Durations with logical operators
1850         my $new_debar_dt = $dt_today->clone()->add_duration( $deltadays * $finedays );
1851         my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
1852         # check to see if the current debar date is a valid date
1853         if ( $borrower->{debarred} && $borrower_debar_dt ) {
1854         # if so, is it before the new date?  update only if true
1855             if ( DateTime->compare( $borrower_debar_dt, $new_debar_dt ) == -1 ) {
1856                 C4::Members::DebarMember( $borrower->{borrowernumber}, $new_debar_dt->ymd() );
1857                 return $new_debar_dt->ymd();
1858             }
1859         # if the borrower's debar date is not set or valid, debar them
1860         } else {
1861             C4::Members::DebarMember( $borrower->{borrowernumber}, $new_debar_dt->ymd() );
1862             return $new_debar_dt->ymd();
1863         }
1864     }
1865 }
1866
1867 =head2 _FixOverduesOnReturn
1868
1869    &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
1870
1871 C<$brn> borrowernumber
1872
1873 C<$itm> itemnumber
1874
1875 C<$exemptfine> BOOL -- remove overdue charge associated with this issue. 
1876 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
1877
1878 Internal function, called only by AddReturn
1879
1880 =cut
1881
1882 sub _FixOverduesOnReturn {
1883     my ($borrowernumber, $item);
1884     unless ($borrowernumber = shift) {
1885         warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
1886         return;
1887     }
1888     unless ($item = shift) {
1889         warn "_FixOverduesOnReturn() not supplied valid itemnumber";
1890         return;
1891     }
1892     my ($exemptfine, $dropbox) = @_;
1893     my $dbh = C4::Context->dbh;
1894
1895     # check for overdue fine
1896     my $sth = $dbh->prepare(
1897 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1898     );
1899     $sth->execute( $borrowernumber, $item );
1900
1901     # alter fine to show that the book has been returned
1902     my $data = $sth->fetchrow_hashref;
1903     return 0 unless $data;    # no warning, there's just nothing to fix
1904
1905     my $uquery;
1906     my @bind = ($borrowernumber, $item, $data->{'accountno'});
1907     if ($exemptfine) {
1908         $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
1909         if (C4::Context->preference("FinesLog")) {
1910             &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
1911         }
1912     } elsif ($dropbox && $data->{lastincrement}) {
1913         my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
1914         my $amt = $data->{amount} - $data->{lastincrement} ;
1915         if (C4::Context->preference("FinesLog")) {
1916             &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
1917         }
1918          $uquery = "update accountlines set accounttype='F' ";
1919          if($outstanding  >= 0 && $amt >=0) {
1920             $uquery .= ", amount = ? , amountoutstanding=? ";
1921             unshift @bind, ($amt, $outstanding) ;
1922         }
1923     } else {
1924         $uquery = "update accountlines set accounttype='F' ";
1925     }
1926     $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1927     my $usth = $dbh->prepare($uquery);
1928     return $usth->execute(@bind);
1929 }
1930
1931 =head2 _FixAccountForLostAndReturned
1932
1933   &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
1934
1935 Calculates the charge for a book lost and returned.
1936
1937 Internal function, not exported, called only by AddReturn.
1938
1939 FIXME: This function reflects how inscrutable fines logic is.  Fix both.
1940 FIXME: Give a positive return value on success.  It might be the $borrowernumber who received credit, or the amount forgiven.
1941
1942 =cut
1943
1944 sub _FixAccountForLostAndReturned {
1945     my $itemnumber     = shift or return;
1946     my $borrowernumber = @_ ? shift : undef;
1947     my $item_id        = @_ ? shift : $itemnumber;  # Send the barcode if you want that logged in the description
1948     my $dbh = C4::Context->dbh;
1949     # check for charge made for lost book
1950     my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE itemnumber = ? AND accounttype IN ('L', 'Rep', 'W') ORDER BY date DESC, accountno DESC");
1951     $sth->execute($itemnumber);
1952     my $data = $sth->fetchrow_hashref;
1953     $data or return;    # bail if there is nothing to do
1954     $data->{accounttype} eq 'W' and return;    # Written off
1955
1956     # writeoff this amount
1957     my $offset;
1958     my $amount = $data->{'amount'};
1959     my $acctno = $data->{'accountno'};
1960     my $amountleft;                                             # Starts off undef/zero.
1961     if ($data->{'amountoutstanding'} == $amount) {
1962         $offset     = $data->{'amount'};
1963         $amountleft = 0;                                        # Hey, it's zero here, too.
1964     } else {
1965         $offset     = $amount - $data->{'amountoutstanding'};   # Um, isn't this the same as ZERO?  We just tested those two things are ==
1966         $amountleft = $data->{'amountoutstanding'} - $amount;   # Um, isn't this the same as ZERO?  We just tested those two things are ==
1967     }
1968     my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1969         WHERE (borrowernumber = ?)
1970         AND (itemnumber = ?) AND (accountno = ?) ");
1971     $usth->execute($data->{'borrowernumber'},$itemnumber,$acctno);      # We might be adjusting an account for some OTHER borrowernumber now.  Not the one we passed in.  
1972     #check if any credit is left if so writeoff other accounts
1973     my $nextaccntno = getnextacctno($data->{'borrowernumber'});
1974     $amountleft *= -1 if ($amountleft < 0);
1975     if ($amountleft > 0) {
1976         my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1977                             AND (amountoutstanding >0) ORDER BY date");     # might want to order by amountoustanding ASC (pay smallest first)
1978         $msth->execute($data->{'borrowernumber'});
1979         # offset transactions
1980         my $newamtos;
1981         my $accdata;
1982         while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1983             if ($accdata->{'amountoutstanding'} < $amountleft) {
1984                 $newamtos = 0;
1985                 $amountleft -= $accdata->{'amountoutstanding'};
1986             }  else {
1987                 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1988                 $amountleft = 0;
1989             }
1990             my $thisacct = $accdata->{'accountno'};
1991             # FIXME: move prepares outside while loop!
1992             my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1993                     WHERE (borrowernumber = ?)
1994                     AND (accountno=?)");
1995             $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');    # FIXME: '$thisacct' is a string literal!
1996             $usth = $dbh->prepare("INSERT INTO accountoffsets
1997                 (borrowernumber, accountno, offsetaccount,  offsetamount)
1998                 VALUES
1999                 (?,?,?,?)");
2000             $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
2001         }
2002         $msth->finish;  # $msth might actually have data left
2003     }
2004     $amountleft *= -1 if ($amountleft > 0);
2005     my $desc = "Item Returned " . $item_id;
2006     $usth = $dbh->prepare("INSERT INTO accountlines
2007         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
2008         VALUES (?,?,now(),?,?,'CR',?)");
2009     $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
2010     if ($borrowernumber) {
2011         # FIXME: same as query above.  use 1 sth for both
2012         $usth = $dbh->prepare("INSERT INTO accountoffsets
2013             (borrowernumber, accountno, offsetaccount,  offsetamount)
2014             VALUES (?,?,?,?)");
2015         $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
2016     }
2017     ModItem({ paidfor => '' }, undef, $itemnumber);
2018     return;
2019 }
2020
2021 =head2 _GetCircControlBranch
2022
2023    my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2024
2025 Internal function : 
2026
2027 Return the library code to be used to determine which circulation
2028 policy applies to a transaction.  Looks up the CircControl and
2029 HomeOrHoldingBranch system preferences.
2030
2031 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2032
2033 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2034
2035 =cut
2036
2037 sub _GetCircControlBranch {
2038     my ($item, $borrower) = @_;
2039     my $circcontrol = C4::Context->preference('CircControl');
2040     my $branch;
2041
2042     if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2043         $branch= C4::Context->userenv->{'branch'};
2044     } elsif ($circcontrol eq 'PatronLibrary') {
2045         $branch=$borrower->{branchcode};
2046     } else {
2047         my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2048         $branch = $item->{$branchfield};
2049         # default to item home branch if holdingbranch is used
2050         # and is not defined
2051         if (!defined($branch) && $branchfield eq 'holdingbranch') {
2052             $branch = $item->{homebranch};
2053         }
2054     }
2055     return $branch;
2056 }
2057
2058
2059
2060
2061
2062
2063 =head2 GetItemIssue
2064
2065   $issue = &GetItemIssue($itemnumber);
2066
2067 Returns patron currently having a book, or undef if not checked out.
2068
2069 C<$itemnumber> is the itemnumber.
2070
2071 C<$issue> is a hashref of the row from the issues table.
2072
2073 =cut
2074
2075 sub GetItemIssue {
2076     my ($itemnumber) = @_;
2077     return unless $itemnumber;
2078     my $sth = C4::Context->dbh->prepare(
2079         "SELECT *
2080         FROM issues
2081         LEFT JOIN items ON issues.itemnumber=items.itemnumber
2082         WHERE issues.itemnumber=?");
2083     $sth->execute($itemnumber);
2084     my $data = $sth->fetchrow_hashref;
2085     return unless $data;
2086     $data->{issuedate} = dt_from_string($data->{issuedate}, 'sql');
2087     $data->{issuedate}->truncate(to => 'minute');
2088     $data->{date_due} = dt_from_string($data->{date_due}, 'sql');
2089     $data->{date_due}->truncate(to => 'minute');
2090     my $dt = DateTime->now( time_zone => C4::Context->tz)->truncate( to => 'minute');
2091     $data->{'overdue'} = DateTime->compare($data->{'date_due'}, $dt ) == -1 ? 1 : 0;
2092     return $data;
2093 }
2094
2095 =head2 GetOpenIssue
2096
2097   $issue = GetOpenIssue( $itemnumber );
2098
2099 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2100
2101 C<$itemnumber> is the item's itemnumber
2102
2103 Returns a hashref
2104
2105 =cut
2106
2107 sub GetOpenIssue {
2108   my ( $itemnumber ) = @_;
2109
2110   my $dbh = C4::Context->dbh;  
2111   my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2112   $sth->execute( $itemnumber );
2113   my $issue = $sth->fetchrow_hashref();
2114   return $issue;
2115 }
2116
2117 =head2 GetItemIssues
2118
2119   $issues = &GetItemIssues($itemnumber, $history);
2120
2121 Returns patrons that have issued a book
2122
2123 C<$itemnumber> is the itemnumber
2124 C<$history> is false if you just want the current "issuer" (if any)
2125 and true if you want issues history from old_issues also.
2126
2127 Returns reference to an array of hashes
2128
2129 =cut
2130
2131 sub GetItemIssues {
2132     my ( $itemnumber, $history ) = @_;
2133     
2134     my $today = DateTime->now( time_zome => C4::Context->tz);  # get today date
2135     $today->truncate( to => 'minute' );
2136     my $sql = "SELECT * FROM issues
2137               JOIN borrowers USING (borrowernumber)
2138               JOIN items     USING (itemnumber)
2139               WHERE issues.itemnumber = ? ";
2140     if ($history) {
2141         $sql .= "UNION ALL
2142                  SELECT * FROM old_issues
2143                  LEFT JOIN borrowers USING (borrowernumber)
2144                  JOIN items USING (itemnumber)
2145                  WHERE old_issues.itemnumber = ? ";
2146     }
2147     $sql .= "ORDER BY date_due DESC";
2148     my $sth = C4::Context->dbh->prepare($sql);
2149     if ($history) {
2150         $sth->execute($itemnumber, $itemnumber);
2151     } else {
2152         $sth->execute($itemnumber);
2153     }
2154     my $results = $sth->fetchall_arrayref({});
2155     foreach (@$results) {
2156         my $date_due = dt_from_string($_->{date_due},'sql');
2157         $date_due->truncate( to => 'minute' );
2158
2159         $_->{overdue} = (DateTime->compare($date_due, $today) == -1) ? 1 : 0;
2160     }
2161     return $results;
2162 }
2163
2164 =head2 GetBiblioIssues
2165
2166   $issues = GetBiblioIssues($biblionumber);
2167
2168 this function get all issues from a biblionumber.
2169
2170 Return:
2171 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
2172 tables issues and the firstname,surname & cardnumber from borrowers.
2173
2174 =cut
2175
2176 sub GetBiblioIssues {
2177     my $biblionumber = shift;
2178     return undef unless $biblionumber;
2179     my $dbh   = C4::Context->dbh;
2180     my $query = "
2181         SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2182         FROM issues
2183             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2184             LEFT JOIN items ON issues.itemnumber = items.itemnumber
2185             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2186             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2187         WHERE biblio.biblionumber = ?
2188         UNION ALL
2189         SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2190         FROM old_issues
2191             LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2192             LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2193             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2194             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2195         WHERE biblio.biblionumber = ?
2196         ORDER BY timestamp
2197     ";
2198     my $sth = $dbh->prepare($query);
2199     $sth->execute($biblionumber, $biblionumber);
2200
2201     my @issues;
2202     while ( my $data = $sth->fetchrow_hashref ) {
2203         push @issues, $data;
2204     }
2205     return \@issues;
2206 }
2207
2208 =head2 GetUpcomingDueIssues
2209
2210   my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2211
2212 =cut
2213
2214 sub GetUpcomingDueIssues {
2215     my $params = shift;
2216
2217     $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2218     my $dbh = C4::Context->dbh;
2219
2220     my $statement = <<END_SQL;
2221 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2222 FROM issues 
2223 LEFT JOIN items USING (itemnumber)
2224 LEFT OUTER JOIN branches USING (branchcode)
2225 WhERE returndate is NULL
2226 AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ?
2227 END_SQL
2228
2229     my @bind_parameters = ( $params->{'days_in_advance'} );
2230     
2231     my $sth = $dbh->prepare( $statement );
2232     $sth->execute( @bind_parameters );
2233     my $upcoming_dues = $sth->fetchall_arrayref({});
2234     $sth->finish;
2235
2236     return $upcoming_dues;
2237 }
2238
2239 =head2 CanBookBeRenewed
2240
2241   ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2242
2243 Find out whether a borrowed item may be renewed.
2244
2245 C<$dbh> is a DBI handle to the Koha database.
2246
2247 C<$borrowernumber> is the borrower number of the patron who currently
2248 has the item on loan.
2249
2250 C<$itemnumber> is the number of the item to renew.
2251
2252 C<$override_limit>, if supplied with a true value, causes
2253 the limit on the number of times that the loan can be renewed
2254 (as controlled by the item type) to be ignored.
2255
2256 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
2257 item must currently be on loan to the specified borrower; renewals
2258 must be allowed for the item's type; and the borrower must not have
2259 already renewed the loan. $error will contain the reason the renewal can not proceed
2260
2261 =cut
2262
2263 sub CanBookBeRenewed {
2264
2265     # check renewal status
2266     my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2267     my $dbh       = C4::Context->dbh;
2268     my $renews    = 1;
2269     my $renewokay = 0;
2270         my $error;
2271
2272     # Look in the issues table for this item, lent to this borrower,
2273     # and not yet returned.
2274
2275     # Look in the issues table for this item, lent to this borrower,
2276     # and not yet returned.
2277     my %branch = (
2278             'ItemHomeLibrary' => 'items.homebranch',
2279             'PickupLibrary'   => 'items.holdingbranch',
2280             'PatronLibrary'   => 'borrowers.branchcode'
2281             );
2282     my $controlbranch = $branch{C4::Context->preference('CircControl')};
2283     my $itype         = C4::Context->preference('item-level_itypes') ? 'items.itype' : 'biblioitems.itemtype';
2284     
2285     my $sthcount = $dbh->prepare("
2286                    SELECT 
2287                     borrowers.categorycode, biblioitems.itemtype, issues.renewals, renewalsallowed, $controlbranch
2288                    FROM  issuingrules, 
2289                    issues
2290                    LEFT JOIN items USING (itemnumber) 
2291                    LEFT JOIN borrowers USING (borrowernumber) 
2292                    LEFT JOIN biblioitems USING (biblioitemnumber)
2293                    
2294                    WHERE
2295                     (issuingrules.categorycode = borrowers.categorycode OR issuingrules.categorycode = '*')
2296                    AND
2297                     (issuingrules.itemtype = $itype OR issuingrules.itemtype = '*')
2298                    AND
2299                     (issuingrules.branchcode = $controlbranch OR issuingrules.branchcode = '*') 
2300                    AND 
2301                     borrowernumber = ? 
2302                    AND
2303                     itemnumber = ?
2304                    ORDER BY
2305                     issuingrules.categorycode desc,
2306                     issuingrules.itemtype desc,
2307                     issuingrules.branchcode desc
2308                    LIMIT 1;
2309                   ");
2310
2311     $sthcount->execute( $borrowernumber, $itemnumber );
2312     if ( my $data1 = $sthcount->fetchrow_hashref ) {
2313         
2314         if ( ( $data1->{renewalsallowed} && $data1->{renewalsallowed} > $data1->{renewals} ) || $override_limit ) {
2315             $renewokay = 1;
2316         }
2317         else {
2318                         $error="too_many";
2319                 }
2320                 
2321         my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2322         if ($resfound) {
2323             $renewokay = 0;
2324                         $error="on_reserve"
2325         }
2326
2327     }
2328     return ($renewokay,$error);
2329 }
2330
2331 =head2 AddRenewal
2332
2333   &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2334
2335 Renews a loan.
2336
2337 C<$borrowernumber> is the borrower number of the patron who currently
2338 has the item.
2339
2340 C<$itemnumber> is the number of the item to renew.
2341
2342 C<$branch> is the library where the renewal took place (if any).
2343            The library that controls the circ policies for the renewal is retrieved from the issues record.
2344
2345 C<$datedue> can be a C4::Dates object used to set the due date.
2346
2347 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate.  If
2348 this parameter is not supplied, lastreneweddate is set to the current date.
2349
2350 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2351 from the book's item type.
2352
2353 =cut
2354
2355 sub AddRenewal {
2356     my $borrowernumber  = shift or return undef;
2357     my $itemnumber      = shift or return undef;
2358     my $branch          = shift;
2359     my $datedue         = shift;
2360     my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
2361     my $item   = GetItem($itemnumber) or return undef;
2362     my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
2363
2364     my $dbh = C4::Context->dbh;
2365     # Find the issues record for this book
2366     my $sth =
2367       $dbh->prepare("SELECT * FROM issues
2368                         WHERE borrowernumber=? 
2369                         AND itemnumber=?"
2370       );
2371     $sth->execute( $borrowernumber, $itemnumber );
2372     my $issuedata = $sth->fetchrow_hashref;
2373     $sth->finish;
2374     if(defined $datedue && ref $datedue ne 'DateTime' ) {
2375         carp 'Invalid date passed to AddRenewal.';
2376         return;
2377     }
2378     # If the due date wasn't specified, calculate it by adding the
2379     # book's loan length to today's date or the current due date
2380     # based on the value of the RenewalPeriodBase syspref.
2381     unless ($datedue) {
2382
2383         my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return undef;
2384         my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'};
2385
2386         $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2387                                         $issuedata->{date_due} :
2388                                         DateTime->now( time_zone => C4::Context->tz());
2389         $datedue =  CalcDateDue($datedue,$itemtype,$issuedata->{'branchcode'},$borrower);
2390     }
2391
2392     # Update the issues record to have the new due date, and a new count
2393     # of how many times it has been renewed.
2394     my $renews = $issuedata->{'renewals'} + 1;
2395     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2396                             WHERE borrowernumber=? 
2397                             AND itemnumber=?"
2398     );
2399
2400     $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2401     $sth->finish;
2402
2403     # Update the renewal count on the item, and tell zebra to reindex
2404     $renews = $biblio->{'renewals'} + 1;
2405     ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $biblio->{'biblionumber'}, $itemnumber);
2406
2407     # Charge a new rental fee, if applicable?
2408     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2409     if ( $charge > 0 ) {
2410         my $accountno = getnextacctno( $borrowernumber );
2411         my $item = GetBiblioFromItemNumber($itemnumber);
2412         my $manager_id = 0;
2413         $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; 
2414         $sth = $dbh->prepare(
2415                 "INSERT INTO accountlines
2416                     (date, borrowernumber, accountno, amount, manager_id,
2417                     description,accounttype, amountoutstanding, itemnumber)
2418                     VALUES (now(),?,?,?,?,?,?,?,?)"
2419         );
2420         $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
2421             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2422             'Rent', $charge, $itemnumber );
2423     }
2424     # Log the renewal
2425     UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
2426         return $datedue;
2427 }
2428
2429 sub GetRenewCount {
2430     # check renewal status
2431     my ( $bornum, $itemno ) = @_;
2432     my $dbh           = C4::Context->dbh;
2433     my $renewcount    = 0;
2434     my $renewsallowed = 0;
2435     my $renewsleft    = 0;
2436
2437     my $borrower = C4::Members::GetMember( borrowernumber => $bornum);
2438     my $item     = GetItem($itemno); 
2439
2440     # Look in the issues table for this item, lent to this borrower,
2441     # and not yet returned.
2442
2443     # FIXME - I think this function could be redone to use only one SQL call.
2444     my $sth = $dbh->prepare(
2445         "select * from issues
2446                                 where (borrowernumber = ?)
2447                                 and (itemnumber = ?)"
2448     );
2449     $sth->execute( $bornum, $itemno );
2450     my $data = $sth->fetchrow_hashref;
2451     $renewcount = $data->{'renewals'} if $data->{'renewals'};
2452     $sth->finish;
2453     # $item and $borrower should be calculated
2454     my $branchcode = _GetCircControlBranch($item, $borrower);
2455     
2456     my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
2457     
2458     $renewsallowed = $issuingrule->{'renewalsallowed'};
2459     $renewsleft    = $renewsallowed - $renewcount;
2460     if($renewsleft < 0){ $renewsleft = 0; }
2461     return ( $renewcount, $renewsallowed, $renewsleft );
2462 }
2463
2464 =head2 GetIssuingCharges
2465
2466   ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
2467
2468 Calculate how much it would cost for a given patron to borrow a given
2469 item, including any applicable discounts.
2470
2471 C<$itemnumber> is the item number of item the patron wishes to borrow.
2472
2473 C<$borrowernumber> is the patron's borrower number.
2474
2475 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
2476 and C<$item_type> is the code for the item's item type (e.g., C<VID>
2477 if it's a video).
2478
2479 =cut
2480
2481 sub GetIssuingCharges {
2482
2483     # calculate charges due
2484     my ( $itemnumber, $borrowernumber ) = @_;
2485     my $charge = 0;
2486     my $dbh    = C4::Context->dbh;
2487     my $item_type;
2488
2489     # Get the book's item type and rental charge (via its biblioitem).
2490     my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
2491         LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
2492     $charge_query .= (C4::Context->preference('item-level_itypes'))
2493         ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
2494         : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
2495
2496     $charge_query .= ' WHERE items.itemnumber =?';
2497
2498     my $sth = $dbh->prepare($charge_query);
2499     $sth->execute($itemnumber);
2500     if ( my $item_data = $sth->fetchrow_hashref ) {
2501         $item_type = $item_data->{itemtype};
2502         $charge    = $item_data->{rentalcharge};
2503         my $branch = C4::Branch::mybranch();
2504         my $discount_query = q|SELECT rentaldiscount,
2505             issuingrules.itemtype, issuingrules.branchcode
2506             FROM borrowers
2507             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2508             WHERE borrowers.borrowernumber = ?
2509             AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
2510             AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
2511         my $discount_sth = $dbh->prepare($discount_query);
2512         $discount_sth->execute( $borrowernumber, $item_type, $branch );
2513         my $discount_rules = $discount_sth->fetchall_arrayref({});
2514         if (@{$discount_rules}) {
2515             # We may have multiple rules so get the most specific
2516             my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
2517             $charge = ( $charge * ( 100 - $discount ) ) / 100;
2518         }
2519     }
2520
2521     $sth->finish; # we havent _explicitly_ fetched all rows
2522     return ( $charge, $item_type );
2523 }
2524
2525 # Select most appropriate discount rule from those returned
2526 sub _get_discount_from_rule {
2527     my ($rules_ref, $branch, $itemtype) = @_;
2528     my $discount;
2529
2530     if (@{$rules_ref} == 1) { # only 1 applicable rule use it
2531         $discount = $rules_ref->[0]->{rentaldiscount};
2532         return (defined $discount) ? $discount : 0;
2533     }
2534     # could have up to 4 does one match $branch and $itemtype
2535     my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
2536     if (@d) {
2537         $discount = $d[0]->{rentaldiscount};
2538         return (defined $discount) ? $discount : 0;
2539     }
2540     # do we have item type + all branches
2541     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
2542     if (@d) {
2543         $discount = $d[0]->{rentaldiscount};
2544         return (defined $discount) ? $discount : 0;
2545     }
2546     # do we all item types + this branch
2547     @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
2548     if (@d) {
2549         $discount = $d[0]->{rentaldiscount};
2550         return (defined $discount) ? $discount : 0;
2551     }
2552     # so all and all (surely we wont get here)
2553     @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
2554     if (@d) {
2555         $discount = $d[0]->{rentaldiscount};
2556         return (defined $discount) ? $discount : 0;
2557     }
2558     # none of the above
2559     return 0;
2560 }
2561
2562 =head2 AddIssuingCharge
2563
2564   &AddIssuingCharge( $itemno, $borrowernumber, $charge )
2565
2566 =cut
2567
2568 sub AddIssuingCharge {
2569     my ( $itemnumber, $borrowernumber, $charge ) = @_;
2570     my $dbh = C4::Context->dbh;
2571     my $nextaccntno = getnextacctno( $borrowernumber );
2572     my $manager_id = 0;
2573     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2574     my $query ="
2575         INSERT INTO accountlines
2576             (borrowernumber, itemnumber, accountno,
2577             date, amount, description, accounttype,
2578             amountoutstanding, manager_id)
2579         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
2580     ";
2581     my $sth = $dbh->prepare($query);
2582     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
2583     $sth->finish;
2584 }
2585
2586 =head2 GetTransfers
2587
2588   GetTransfers($itemnumber);
2589
2590 =cut
2591
2592 sub GetTransfers {
2593     my ($itemnumber) = @_;
2594
2595     my $dbh = C4::Context->dbh;
2596
2597     my $query = '
2598         SELECT datesent,
2599                frombranch,
2600                tobranch
2601         FROM branchtransfers
2602         WHERE itemnumber = ?
2603           AND datearrived IS NULL
2604         ';
2605     my $sth = $dbh->prepare($query);
2606     $sth->execute($itemnumber);
2607     my @row = $sth->fetchrow_array();
2608     $sth->finish;
2609     return @row;
2610 }
2611
2612 =head2 GetTransfersFromTo
2613
2614   @results = GetTransfersFromTo($frombranch,$tobranch);
2615
2616 Returns the list of pending transfers between $from and $to branch
2617
2618 =cut
2619
2620 sub GetTransfersFromTo {
2621     my ( $frombranch, $tobranch ) = @_;
2622     return unless ( $frombranch && $tobranch );
2623     my $dbh   = C4::Context->dbh;
2624     my $query = "
2625         SELECT itemnumber,datesent,frombranch
2626         FROM   branchtransfers
2627         WHERE  frombranch=?
2628           AND  tobranch=?
2629           AND datearrived IS NULL
2630     ";
2631     my $sth = $dbh->prepare($query);
2632     $sth->execute( $frombranch, $tobranch );
2633     my @gettransfers;
2634
2635     while ( my $data = $sth->fetchrow_hashref ) {
2636         push @gettransfers, $data;
2637     }
2638     $sth->finish;
2639     return (@gettransfers);
2640 }
2641
2642 =head2 DeleteTransfer
2643
2644   &DeleteTransfer($itemnumber);
2645
2646 =cut
2647
2648 sub DeleteTransfer {
2649     my ($itemnumber) = @_;
2650     my $dbh          = C4::Context->dbh;
2651     my $sth          = $dbh->prepare(
2652         "DELETE FROM branchtransfers
2653          WHERE itemnumber=?
2654          AND datearrived IS NULL "
2655     );
2656     $sth->execute($itemnumber);
2657     $sth->finish;
2658 }
2659
2660 =head2 AnonymiseIssueHistory
2661
2662   $rows = AnonymiseIssueHistory($date,$borrowernumber)
2663
2664 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
2665 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
2666
2667 If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
2668 setting (force delete).
2669
2670 return the number of affected rows.
2671
2672 =cut
2673
2674 sub AnonymiseIssueHistory {
2675     my $date           = shift;
2676     my $borrowernumber = shift;
2677     my $dbh            = C4::Context->dbh;
2678     my $query          = "
2679         UPDATE old_issues
2680         SET    borrowernumber = ?
2681         WHERE  returndate < ?
2682           AND borrowernumber IS NOT NULL
2683     ";
2684
2685     # The default of 0 does not work due to foreign key constraints
2686     # The anonymisation will fail quietly if AnonymousPatron is not a valid entry
2687     my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0;
2688     my @bind_params = ($anonymouspatron, $date);
2689     if (defined $borrowernumber) {
2690        $query .= " AND borrowernumber = ?";
2691        push @bind_params, $borrowernumber;
2692     } else {
2693        $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
2694     }
2695     my $sth = $dbh->prepare($query);
2696     $sth->execute(@bind_params);
2697     my $rows_affected = $sth->rows;  ### doublecheck row count return function
2698     return $rows_affected;
2699 }
2700
2701 =head2 SendCirculationAlert
2702
2703 Send out a C<check-in> or C<checkout> alert using the messaging system.
2704
2705 B<Parameters>:
2706
2707 =over 4
2708
2709 =item type
2710
2711 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
2712
2713 =item item
2714
2715 Hashref of information about the item being checked in or out.
2716
2717 =item borrower
2718
2719 Hashref of information about the borrower of the item.
2720
2721 =item branch
2722
2723 The branchcode from where the checkout or check-in took place.
2724
2725 =back
2726
2727 B<Example>:
2728
2729     SendCirculationAlert({
2730         type     => 'CHECKOUT',
2731         item     => $item,
2732         borrower => $borrower,
2733         branch   => $branch,
2734     });
2735
2736 =cut
2737
2738 sub SendCirculationAlert {
2739     my ($opts) = @_;
2740     my ($type, $item, $borrower, $branch) =
2741         ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
2742     my %message_name = (
2743         CHECKIN  => 'Item_Check_in',
2744         CHECKOUT => 'Item_Checkout',
2745     );
2746     my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
2747         borrowernumber => $borrower->{borrowernumber},
2748         message_name   => $message_name{$type},
2749     });
2750     my $issues_table = ( $type eq 'CHECKOUT' ) ? 'issues' : 'old_issues';
2751     my $letter =  C4::Letters::GetPreparedLetter (
2752         module => 'circulation',
2753         letter_code => $type,
2754         branchcode => $branch,
2755         tables => {
2756             $issues_table => $item->{itemnumber},
2757             'items'       => $item->{itemnumber},
2758             'biblio'      => $item->{biblionumber},
2759             'biblioitems' => $item->{biblionumber},
2760             'borrowers'   => $borrower,
2761             'branches'    => $branch,
2762         }
2763     ) or return;
2764
2765     my @transports = keys %{ $borrower_preferences->{transports} };
2766     # warn "no transports" unless @transports;
2767     for (@transports) {
2768         # warn "transport: $_";
2769         my $message = C4::Message->find_last_message($borrower, $type, $_);
2770         if (!$message) {
2771             #warn "create new message";
2772             C4::Message->enqueue($letter, $borrower, $_);
2773         } else {
2774             #warn "append to old message";
2775             $message->append($letter);
2776             $message->update;
2777         }
2778     }
2779
2780     return $letter;
2781 }
2782
2783 =head2 updateWrongTransfer
2784
2785   $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
2786
2787 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 
2788
2789 =cut
2790
2791 sub updateWrongTransfer {
2792         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2793         my $dbh = C4::Context->dbh;     
2794 # first step validate the actual line of transfert .
2795         my $sth =
2796                 $dbh->prepare(
2797                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2798                 );
2799                 $sth->execute($FromLibrary,$itemNumber);
2800                 $sth->finish;
2801
2802 # second step create a new line of branchtransfer to the right location .
2803         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2804
2805 #third step changing holdingbranch of item
2806         UpdateHoldingbranch($FromLibrary,$itemNumber);
2807 }
2808
2809 =head2 UpdateHoldingbranch
2810
2811   $items = UpdateHoldingbranch($branch,$itmenumber);
2812
2813 Simple methode for updating hodlingbranch in items BDD line
2814
2815 =cut
2816
2817 sub UpdateHoldingbranch {
2818         my ( $branch,$itemnumber ) = @_;
2819     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2820 }
2821
2822 =head2 CalcDateDue
2823
2824 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
2825
2826 this function calculates the due date given the start date and configured circulation rules,
2827 checking against the holidays calendar as per the 'useDaysMode' syspref.
2828 C<$startdate>   = C4::Dates object representing start date of loan period (assumed to be today)
2829 C<$itemtype>  = itemtype code of item in question
2830 C<$branch>  = location whose calendar to use
2831 C<$borrower> = Borrower object
2832
2833 =cut
2834
2835 sub CalcDateDue {
2836     my ( $startdate, $itemtype, $branch, $borrower ) = @_;
2837
2838     # loanlength now a href
2839     my $loanlength =
2840       GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
2841
2842     my $datedue;
2843
2844     # if globalDueDate ON the datedue is set to that date
2845     if (C4::Context->preference('globalDueDate')
2846         && ( C4::Context->preference('globalDueDate') =~
2847             C4::Dates->regexp('syspref') )
2848       ) {
2849         $datedue = dt_from_string(
2850             C4::Context->preference('globalDueDate'),
2851             C4::Context->preference('dateformat')
2852         );
2853     } else {
2854
2855         # otherwise, calculate the datedue as normal
2856         if ( C4::Context->preference('useDaysMode') eq 'Days' )
2857         {    # ignoring calendar
2858             my $dt =
2859               DateTime->now( time_zone => C4::Context->tz() )
2860               ->truncate( to => 'minute' );
2861             if ( $loanlength->{lengthunit} eq 'hours' ) {
2862                 $dt->add( hours => $loanlength->{issuelength} );
2863                 return $dt;
2864             } else {    # days
2865                 $dt->add( days => $loanlength->{issuelength} );
2866                 $dt->set_hour(23);
2867                 $dt->set_minute(59);
2868                 return $dt;
2869             }
2870         } else {
2871             my $dur;
2872             if ($loanlength->{lengthunit} eq 'hours') {
2873                 $dur = DateTime::Duration->new( hours => $loanlength->{issuelength});
2874             }
2875             else { # days
2876                 $dur = DateTime::Duration->new( days => $loanlength->{issuelength});
2877             }
2878             if (ref $startdate ne 'DateTime' ) {
2879                 $startdate = dt_from_string($startdate);
2880             }
2881             my $calendar = Koha::Calendar->new( branchcode => $branch );
2882             $datedue = $calendar->addDate( $startdate, $dur, $loanlength->{lengthunit} );
2883             if ($loanlength->{lengthunit} eq 'days') {
2884                 $datedue->set_hour(23);
2885                 $datedue->set_minute(59);
2886             }
2887         }
2888     }
2889
2890     # if Hard Due Dates are used, retreive them and apply as necessary
2891     my ( $hardduedate, $hardduedatecompare ) =
2892       GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
2893     if ($hardduedate) {    # hardduedates are currently dates
2894         $hardduedate->truncate( to => 'minute' );
2895         $hardduedate->set_hour(23);
2896         $hardduedate->set_minute(59);
2897         my $cmp = DateTime->compare( $hardduedate, $datedue );
2898
2899 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
2900 # if the calculated date is before the 'after' Hard Due Date (floor), override
2901 # if the hard due date is set to 'exactly', overrride
2902         if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
2903             $datedue = $hardduedate->clone;
2904         }
2905
2906         # in all other cases, keep the date due as it is
2907     }
2908
2909     # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
2910     if ( C4::Context->preference('ReturnBeforeExpiry') ) {
2911         my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso' );
2912         if ( DateTime->compare( $datedue, $expiry_dt ) == 1 ) {
2913             $datedue = $expiry_dt->clone;
2914         }
2915     }
2916
2917     return $datedue;
2918 }
2919
2920
2921 =head2 CheckRepeatableHolidays
2922
2923   $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2924
2925 This function checks if the date due is a repeatable holiday
2926
2927 C<$date_due>   = returndate calculate with no day check
2928 C<$itemnumber>  = itemnumber
2929 C<$branchcode>  = localisation of issue 
2930
2931 =cut
2932
2933 sub CheckRepeatableHolidays{
2934 my($itemnumber,$week_day,$branchcode)=@_;
2935 my $dbh = C4::Context->dbh;
2936 my $query = qq|SELECT count(*)  
2937         FROM repeatable_holidays 
2938         WHERE branchcode=?
2939         AND weekday=?|;
2940 my $sth = $dbh->prepare($query);
2941 $sth->execute($branchcode,$week_day);
2942 my $result=$sth->fetchrow;
2943 $sth->finish;
2944 return $result;
2945 }
2946
2947
2948 =head2 CheckSpecialHolidays
2949
2950   $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2951
2952 This function check if the date is a special holiday
2953
2954 C<$years>   = the years of datedue
2955 C<$month>   = the month of datedue
2956 C<$day>     = the day of datedue
2957 C<$itemnumber>  = itemnumber
2958 C<$branchcode>  = localisation of issue 
2959
2960 =cut
2961
2962 sub CheckSpecialHolidays{
2963 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2964 my $dbh = C4::Context->dbh;
2965 my $query=qq|SELECT count(*) 
2966              FROM `special_holidays`
2967              WHERE year=?
2968              AND month=?
2969              AND day=?
2970              AND branchcode=?
2971             |;
2972 my $sth = $dbh->prepare($query);
2973 $sth->execute($years,$month,$day,$branchcode);
2974 my $countspecial=$sth->fetchrow ;
2975 $sth->finish;
2976 return $countspecial;
2977 }
2978
2979 =head2 CheckRepeatableSpecialHolidays
2980
2981   $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2982
2983 This function check if the date is a repeatble special holidays
2984
2985 C<$month>   = the month of datedue
2986 C<$day>     = the day of datedue
2987 C<$itemnumber>  = itemnumber
2988 C<$branchcode>  = localisation of issue 
2989
2990 =cut
2991
2992 sub CheckRepeatableSpecialHolidays{
2993 my ($month,$day,$itemnumber,$branchcode) = @_;
2994 my $dbh = C4::Context->dbh;
2995 my $query=qq|SELECT count(*) 
2996              FROM `repeatable_holidays`
2997              WHERE month=?
2998              AND day=?
2999              AND branchcode=?
3000             |;
3001 my $sth = $dbh->prepare($query);
3002 $sth->execute($month,$day,$branchcode);
3003 my $countspecial=$sth->fetchrow ;
3004 $sth->finish;
3005 return $countspecial;
3006 }
3007
3008
3009
3010 sub CheckValidBarcode{
3011 my ($barcode) = @_;
3012 my $dbh = C4::Context->dbh;
3013 my $query=qq|SELECT count(*) 
3014              FROM items 
3015              WHERE barcode=?
3016             |;
3017 my $sth = $dbh->prepare($query);
3018 $sth->execute($barcode);
3019 my $exist=$sth->fetchrow ;
3020 $sth->finish;
3021 return $exist;
3022 }
3023
3024 =head2 IsBranchTransferAllowed
3025
3026   $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3027
3028 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3029
3030 =cut
3031
3032 sub IsBranchTransferAllowed {
3033         my ( $toBranch, $fromBranch, $code ) = @_;
3034
3035         if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3036         
3037         my $limitType = C4::Context->preference("BranchTransferLimitsType");   
3038         my $dbh = C4::Context->dbh;
3039             
3040         my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3041         $sth->execute( $toBranch, $fromBranch, $code );
3042         my $limit = $sth->fetchrow_hashref();
3043                         
3044         ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3045         if ( $limit->{'limitId'} ) {
3046                 return 0;
3047         } else {
3048                 return 1;
3049         }
3050 }                                                        
3051
3052 =head2 CreateBranchTransferLimit
3053
3054   CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3055
3056 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3057
3058 =cut
3059
3060 sub CreateBranchTransferLimit {
3061    my ( $toBranch, $fromBranch, $code ) = @_;
3062
3063    my $limitType = C4::Context->preference("BranchTransferLimitsType");
3064    
3065    my $dbh = C4::Context->dbh;
3066    
3067    my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3068    $sth->execute( $code, $toBranch, $fromBranch );
3069 }
3070
3071 =head2 DeleteBranchTransferLimits
3072
3073 DeleteBranchTransferLimits($frombranch);
3074
3075 Deletes all the branch transfer limits for one branch
3076
3077 =cut
3078
3079 sub DeleteBranchTransferLimits {
3080     my $branch = shift;
3081     my $dbh    = C4::Context->dbh;
3082     my $sth    = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3083     $sth->execute($branch);
3084 }
3085
3086 sub ReturnLostItem{
3087     my ( $borrowernumber, $itemnum ) = @_;
3088
3089     MarkIssueReturned( $borrowernumber, $itemnum );
3090     my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
3091     my @datearr = localtime(time);
3092     my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3093     my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
3094     ModItem({ paidfor =>  "Paid for by $bor $date" }, undef, $itemnum);
3095 }
3096
3097
3098 sub LostItem{
3099     my ($itemnumber, $mark_returned, $charge_fee) = @_;
3100
3101     my $dbh = C4::Context->dbh();
3102     my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title 
3103                            FROM issues 
3104                            JOIN items USING (itemnumber) 
3105                            JOIN biblio USING (biblionumber)
3106                            WHERE issues.itemnumber=?");
3107     $sth->execute($itemnumber);
3108     my $issues=$sth->fetchrow_hashref();
3109     $sth->finish;
3110
3111     # if a borrower lost the item, add a replacement cost to the their record
3112     if ( my $borrowernumber = $issues->{borrowernumber} ){
3113         my $borrower = C4::Members::GetMemberDetails( $borrowernumber );
3114
3115         C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}")
3116           if $charge_fee;
3117         #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3118         #warn " $issues->{'borrowernumber'}  /  $itemnumber ";
3119         MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$borrower->{'privacy'}) if $mark_returned;
3120     }
3121 }
3122
3123 sub GetOfflineOperations {
3124     my $dbh = C4::Context->dbh;
3125     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3126     $sth->execute(C4::Context->userenv->{'branch'});
3127     my $results = $sth->fetchall_arrayref({});
3128     $sth->finish;
3129     return $results;
3130 }
3131
3132 sub GetOfflineOperation {
3133     my $dbh = C4::Context->dbh;
3134     my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3135     $sth->execute( shift );
3136     my $result = $sth->fetchrow_hashref;
3137     $sth->finish;
3138     return $result;
3139 }
3140
3141 sub AddOfflineOperation {
3142     my $dbh = C4::Context->dbh;
3143     my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber) VALUES(?,?,?,?,?,?)");
3144     $sth->execute( @_ );
3145     return "Added.";
3146 }
3147
3148 sub DeleteOfflineOperation {
3149     my $dbh = C4::Context->dbh;
3150     my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3151     $sth->execute( shift );
3152     return "Deleted.";
3153 }
3154
3155 sub ProcessOfflineOperation {
3156     my $operation = shift;
3157
3158     my $report;
3159     if ( $operation->{action} eq 'return' ) {
3160         $report = ProcessOfflineReturn( $operation );
3161     } elsif ( $operation->{action} eq 'issue' ) {
3162         $report = ProcessOfflineIssue( $operation );
3163     }
3164
3165     DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3166
3167     return $report;
3168 }
3169
3170 sub ProcessOfflineReturn {
3171     my $operation = shift;
3172
3173     my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3174
3175     if ( $itemnumber ) {
3176         my $issue = GetOpenIssue( $itemnumber );
3177         if ( $issue ) {
3178             MarkIssueReturned(
3179                 $issue->{borrowernumber},
3180                 $itemnumber,
3181                 undef,
3182                 $operation->{timestamp},
3183             );
3184             ModItem(
3185                 { renewals => 0, onloan => undef },
3186                 $issue->{'biblionumber'},
3187                 $itemnumber
3188             );
3189             return "Success.";
3190         } else {
3191             return "Item not issued.";
3192         }
3193     } else {
3194         return "Item not found.";
3195     }
3196 }
3197
3198 sub ProcessOfflineIssue {
3199     my $operation = shift;
3200
3201     my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3202
3203     if ( $borrower->{borrowernumber} ) {
3204         my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3205         unless ($itemnumber) {
3206             return "Barcode not found.";
3207         }
3208         my $issue = GetOpenIssue( $itemnumber );
3209
3210         if ( $issue and ( $issue->{borrowernumber} ne $borrower->{borrowernumber} ) ) { # Item already issued to another borrower, mark it returned
3211             MarkIssueReturned(
3212                 $issue->{borrowernumber},
3213                 $itemnumber,
3214                 undef,
3215                 $operation->{timestamp},
3216             );
3217         }
3218         AddIssue(
3219             $borrower,
3220             $operation->{'barcode'},
3221             undef,
3222             1,
3223             $operation->{timestamp},
3224             undef,
3225         );
3226         return "Success.";
3227     } else {
3228         return "Borrower not found.";
3229     }
3230 }
3231
3232
3233
3234 =head2 TransferSlip
3235
3236   TransferSlip($user_branch, $itemnumber, $to_branch)
3237
3238   Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3239
3240 =cut
3241
3242 sub TransferSlip {
3243     my ($branch, $itemnumber, $to_branch) = @_;
3244
3245     my $item =  GetItem( $itemnumber )
3246       or return;
3247
3248     my $pulldate = C4::Dates->new();
3249
3250     return C4::Letters::GetPreparedLetter (
3251         module => 'circulation',
3252         letter_code => 'TRANSFERSLIP',
3253         branchcode => $branch,
3254         tables => {
3255             'branches'    => $to_branch,
3256             'biblio'      => $item->{biblionumber},
3257             'items'       => $item,
3258         },
3259     );
3260 }
3261
3262
3263 1;
3264
3265 __END__
3266
3267 =head1 AUTHOR
3268
3269 Koha Development Team <http://koha-community.org/>
3270
3271 =cut
3272