bug 2000 - add C4::Circulation::GetBranchBorrowerCircRule
[koha.git] / C4 / Circulation.pm
1 package C4::Circulation;
2
3 # Copyright 2000-2002 Katipo Communications
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
10 # version.
11 #
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA  02111-1307 USA
19
20
21 use strict;
22 require Exporter;
23 use C4::Context;
24 use C4::Stats;
25 use C4::Reserves;
26 use C4::Koha;
27 use C4::Biblio;
28 use C4::Items;
29 use C4::Members;
30 use C4::Dates;
31 use C4::Calendar;
32 use C4::Accounts;
33 use Date::Calc qw(
34   Today
35   Today_and_Now
36   Add_Delta_YM
37   Add_Delta_DHMS
38   Date_to_Days
39   Day_of_Week
40   Add_Delta_Days        
41 );
42 use POSIX qw(strftime);
43 use C4::Branch; # GetBranches
44 use C4::Log; # logaction
45
46 use Data::Dumper;
47
48 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
49
50 BEGIN {
51         # set the version for version checking
52         $VERSION = 3.01;
53         @ISA    = qw(Exporter);
54
55         # FIXME subs that should probably be elsewhere
56         push @EXPORT, qw(
57                 &FixOverduesOnReturn
58                 &barcodedecode
59         );
60
61         # subs to deal with issuing a book
62         push @EXPORT, qw(
63                 &CanBookBeIssued
64                 &CanBookBeRenewed
65                 &AddIssue
66                 &AddRenewal
67                 &GetRenewCount
68                 &GetItemIssue
69                 &GetItemIssues
70                 &GetBorrowerIssues
71                 &GetIssuingCharges
72                 &GetIssuingRule
73         &GetBranchBorrowerCircRule
74                 &GetBiblioIssues
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         );
92 }
93
94 =head1 NAME
95
96 C4::Circulation - Koha circulation module
97
98 =head1 SYNOPSIS
99
100 use C4::Circulation;
101
102 =head1 DESCRIPTION
103
104 The functions in this module deal with circulation, issues, and
105 returns, as well as general information about the library.
106 Also deals with stocktaking.
107
108 =head1 FUNCTIONS
109
110 =head2 barcodedecode
111
112 =head3 $str = &barcodedecode($barcode);
113
114 =over 4
115
116 =item Generic filter function for barcode string.
117 Called on every circ if the System Pref itemBarcodeInputFilter is set.
118 Will do some manipulation of the barcode for systems that deliver a barcode
119 to circulation.pl that differs from the barcode stored for the item.
120 For proper functioning of this filter, calling the function on the 
121 correct barcode string (items.barcode) should return an unaltered barcode.
122
123 =back
124
125 =cut
126
127 # FIXME -- the &decode fcn below should be wrapped into this one.
128 # FIXME -- these plugins should be moved out of Circulation.pm
129 #
130 sub barcodedecode {
131     my ($barcode) = @_;
132     my $filter = C4::Context->preference('itemBarcodeInputFilter');
133         if($filter eq 'whitespace') {
134                 $barcode =~ s/\s//g;
135                 return $barcode;
136         } elsif($filter eq 'cuecat') {
137                 chomp($barcode);
138             my @fields = split( /\./, $barcode );
139             my @results = map( decode($_), @fields[ 1 .. $#fields ] );
140             if ( $#results == 2 ) {
141                 return $results[2];
142             }
143             else {
144                 return $barcode;
145             }
146         } elsif($filter eq 'T-prefix') {
147                 if ( $barcode =~ /^[Tt]/) {
148                         if (substr($barcode,1,1) eq '0') {
149                                 return $barcode;
150                         } else {
151                                 $barcode = substr($barcode,2) + 0 ;
152                         }
153                 }
154                 return sprintf( "T%07d",$barcode);
155         }
156 }
157
158 =head2 decode
159
160 =head3 $str = &decode($chunk);
161
162 =over 4
163
164 =item Decodes a segment of a string emitted by a CueCat barcode scanner and
165 returns it.
166
167 =back
168
169 =cut
170
171 sub decode {
172     my ($encoded) = @_;
173     my $seq =
174       'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
175     my @s = map { index( $seq, $_ ); } split( //, $encoded );
176     my $l = ( $#s + 1 ) % 4;
177     if ($l) {
178         if ( $l == 1 ) {
179             warn "Error!";
180             return;
181         }
182         $l = 4 - $l;
183         $#s += $l;
184     }
185     my $r = '';
186     while ( $#s >= 0 ) {
187         my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
188         $r .=
189             chr( ( $n >> 16 ) ^ 67 )
190          .chr( ( $n >> 8 & 255 ) ^ 67 )
191          .chr( ( $n & 255 ) ^ 67 );
192         @s = @s[ 4 .. $#s ];
193     }
194     $r = substr( $r, 0, length($r) - $l );
195     return $r;
196 }
197
198 =head2 transferbook
199
200 ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch, $barcode, $ignore_reserves);
201
202 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
203
204 C<$newbranch> is the code for the branch to which the item should be transferred.
205
206 C<$barcode> is the barcode of the item to be transferred.
207
208 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
209 Otherwise, if an item is reserved, the transfer fails.
210
211 Returns three values:
212
213 =head3 $dotransfer 
214
215 is true if the transfer was successful.
216
217 =head3 $messages
218
219 is a reference-to-hash which may have any of the following keys:
220
221 =over 4
222
223 =item C<BadBarcode>
224
225 There is no item in the catalog with the given barcode. The value is C<$barcode>.
226
227 =item C<IsPermanent>
228
229 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.
230
231 =item C<DestinationEqualsHolding>
232
233 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.
234
235 =item C<WasReturned>
236
237 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.
238
239 =item C<ResFound>
240
241 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>.
242
243 =item C<WasTransferred>
244
245 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
246
247 =back
248
249 =cut
250
251 sub transferbook {
252     my ( $tbr, $barcode, $ignoreRs ) = @_;
253     my $messages;
254     my $dotransfer      = 1;
255     my $branches        = GetBranches();
256     my $itemnumber = GetItemnumberFromBarcode( $barcode );
257     my $issue      = GetItemIssue($itemnumber);
258     my $biblio = GetBiblioFromItemNumber($itemnumber);
259
260     # bad barcode..
261     if ( not $itemnumber ) {
262         $messages->{'BadBarcode'} = $barcode;
263         $dotransfer = 0;
264     }
265
266     # get branches of book...
267     my $hbr = $biblio->{'homebranch'};
268     my $fbr = $biblio->{'holdingbranch'};
269
270     # if is permanent...
271     if ( $hbr && $branches->{$hbr}->{'PE'} ) {
272         $messages->{'IsPermanent'} = $hbr;
273     }
274
275     # can't transfer book if is already there....
276     if ( $fbr eq $tbr ) {
277         $messages->{'DestinationEqualsHolding'} = 1;
278         $dotransfer = 0;
279     }
280
281     # check if it is still issued to someone, return it...
282     if ($issue->{borrowernumber}) {
283         AddReturn( $barcode, $fbr );
284         $messages->{'WasReturned'} = $issue->{borrowernumber};
285     }
286
287     # find reserves.....
288     # That'll save a database query.
289     my ( $resfound, $resrec ) =
290       CheckReserves( $itemnumber );
291     if ( $resfound and not $ignoreRs ) {
292         $resrec->{'ResFound'} = $resfound;
293
294         #         $messages->{'ResFound'} = $resrec;
295         $dotransfer = 1;
296     }
297
298     #actually do the transfer....
299     if ($dotransfer) {
300         ModItemTransfer( $itemnumber, $fbr, $tbr );
301
302         # don't need to update MARC anymore, we do it in batch now
303         $messages->{'WasTransfered'} = 1;
304                 ModDateLastSeen( $itemnumber );
305     }
306     return ( $dotransfer, $messages, $biblio );
307 }
308
309 =head2 CanBookBeIssued
310
311 Check if a book can be issued.
312
313 my ($issuingimpossible,$needsconfirmation) = CanBookBeIssued($borrower,$barcode,$year,$month,$day);
314
315 =over 4
316
317 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
318
319 =item C<$barcode> is the bar code of the book being issued.
320
321 =item C<$year> C<$month> C<$day> contains the date of the return (in case it's forced by "stickyduedate".
322
323 =back
324
325 Returns :
326
327 =over 4
328
329 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
330 Possible values are :
331
332 =back
333
334 =head3 INVALID_DATE 
335
336 sticky due date is invalid
337
338 =head3 GNA
339
340 borrower gone with no address
341
342 =head3 CARD_LOST
343
344 borrower declared it's card lost
345
346 =head3 DEBARRED
347
348 borrower debarred
349
350 =head3 UNKNOWN_BARCODE
351
352 barcode unknown
353
354 =head3 NOT_FOR_LOAN
355
356 item is not for loan
357
358 =head3 WTHDRAWN
359
360 item withdrawn.
361
362 =head3 RESTRICTED
363
364 item is restricted (set by ??)
365
366 C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
367 Possible values are :
368
369 =head3 DEBT
370
371 borrower has debts.
372
373 =head3 RENEW_ISSUE
374
375 renewing, not issuing
376
377 =head3 ISSUED_TO_ANOTHER
378
379 issued to someone else.
380
381 =head3 RESERVED
382
383 reserved for someone else.
384
385 =head3 INVALID_DATE
386
387 sticky due date is invalid
388
389 =head3 TOO_MANY
390
391 if the borrower borrows to much things
392
393 =cut
394
395 # check if a book can be issued.
396
397
398 sub TooMany {
399     my $borrower        = shift;
400     my $biblionumber = shift;
401         my $item                = shift;
402     my $cat_borrower    = $borrower->{'categorycode'};
403     my $dbh             = C4::Context->dbh;
404         my $branch;
405         # Get which branchcode we need
406         if (C4::Context->preference('CircControl') eq 'PickupLibrary'){
407                 $branch = C4::Context->userenv->{'branch'}; 
408         }
409         elsif (C4::Context->preference('CircControl') eq 'PatronLibrary'){
410         $branch = $borrower->{'branchcode'}; 
411         }
412         else {
413                 # items home library
414                 $branch = $item->{'homebranch'};
415         }
416         my $type = (C4::Context->preference('item-level_itypes')) 
417                         ? $item->{'itype'}         # item-level
418                         : $item->{'itemtype'};     # biblio-level
419   
420         my $sth =
421       $dbh->prepare(
422                 'SELECT * FROM issuingrules 
423                         WHERE categorycode = ? 
424                             AND itemtype = ? 
425                             AND branchcode = ?'
426       );
427
428     my $query2 = "SELECT  COUNT(*) FROM issues i, biblioitems s1, items s2 
429                 WHERE i.borrowernumber = ? 
430                     AND i.itemnumber = s2.itemnumber 
431                     AND s1.biblioitemnumber = s2.biblioitemnumber";
432     if (C4::Context->preference('item-level_itypes')){
433            $query2.=" AND s2.itype=? ";
434     } else { 
435            $query2.=" AND s1.itemtype= ? ";
436     }
437     my $sth2=  $dbh->prepare($query2);
438     my $sth3 =
439       $dbh->prepare(
440             'SELECT COUNT(*) FROM issues
441                 WHERE borrowernumber = ?'
442             );
443     my $alreadyissued;
444
445     # check the 3 parameters (branch / itemtype / category code
446     $sth->execute( $cat_borrower, $type, $branch );
447     my $result = $sth->fetchrow_hashref;
448 #     warn "$cat_borrower, $type, $branch = ".Data::Dumper::Dumper($result);
449     if ( $result->{maxissueqty} ne '' ) {
450 #         warn "checking on everything set";
451         $sth2->execute( $borrower->{'borrowernumber'}, $type );
452         my $alreadyissued = $sth2->fetchrow;
453         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
454             return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch/category/itemtype failed)" );
455         }
456         # now checking for total
457         $sth->execute( $cat_borrower, '*', $branch );
458         my $result = $sth->fetchrow_hashref;
459         if ( $result->{maxissueqty} ne '' ) {
460             $sth3->execute( $borrower->{'borrowernumber'} );
461             my $alreadyissued = $sth3->fetchrow;
462             if ( $result->{'maxissueqty'} <= $alreadyissued ) {
463                 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch/category/total failed)"  );
464             }
465         }
466     }
467
468     # check the 2 parameters (branch / itemtype / default categorycode
469     $sth->execute( '*', $type, $branch );
470     $result = $sth->fetchrow_hashref;
471 #     warn "*, $type, $branch = ".Data::Dumper::Dumper($result);
472
473     if ( $result->{maxissueqty} ne '' ) {
474 #         warn "checking on 2 parameters (default categorycode)";
475         $sth2->execute( $borrower->{'borrowernumber'}, $type );
476         my $alreadyissued = $sth2->fetchrow;
477         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
478             return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch / default category / itemtype failed)"  );
479         }
480         # now checking for total
481         $sth->execute( '*', '*', $branch );
482         my $result = $sth->fetchrow_hashref;
483         if ( $result->{maxissueqty} ne '' ) {
484             $sth3->execute( $borrower->{'borrowernumber'} );
485             my $alreadyissued = $sth3->fetchrow;
486             if ( $result->{'maxissueqty'} <= $alreadyissued ) {
487                 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch / default category / total failed)" );
488             }
489         }
490     }
491     
492     # check the 1 parameters (default branch / itemtype / categorycode
493     $sth->execute( $cat_borrower, $type, '*' );
494     $result = $sth->fetchrow_hashref;
495 #     warn "$cat_borrower, $type, * = ".Data::Dumper::Dumper($result);
496     
497     if ( $result->{maxissueqty} ne '' ) {
498 #         warn "checking on 1 parameter (default branch + categorycode)";
499         $sth2->execute( $borrower->{'borrowernumber'}, $type );
500         my $alreadyissued = $sth2->fetchrow;
501         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
502             return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch/category/itemtype failed)"  );
503         }
504         # now checking for total
505         $sth->execute( $cat_borrower, '*', '*' );
506         my $result = $sth->fetchrow_hashref;
507         if ( $result->{maxissueqty} ne '' ) {
508             $sth3->execute( $borrower->{'borrowernumber'} );
509             my $alreadyissued = $sth3->fetchrow;
510             if ( $result->{'maxissueqty'} <= $alreadyissued ) {
511                 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / category / total failed)"  );
512             }
513         }
514     }
515
516     # check the 0 parameters (default branch / itemtype / default categorycode
517     $sth->execute( '*', $type, '*' );
518     $result = $sth->fetchrow_hashref;
519 #     warn "*, $type, * = ".Data::Dumper::Dumper($result);
520
521     if ( $result->{maxissueqty} ne '' ) {
522 #         warn "checking on default branch and default categorycode";
523         $sth2->execute( $borrower->{'borrowernumber'}, $type );
524         my $alreadyissued = $sth2->fetchrow;
525         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
526             return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / default category / itemtype failed)"  );
527         }
528         }
529     # now checking for total
530     $sth->execute( '*', '*', '*' );
531     $result = $sth->fetchrow_hashref;
532     if ( $result->{maxissueqty} ne '' ) {
533                 warn "checking total";
534                 $sth2->execute( $borrower->{'borrowernumber'}, $type );
535                 my $alreadyissued = $sth2->fetchrow;
536                 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
537                         return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / default category / total failed)"  );
538                 }
539         }
540
541     # OK, the patron can issue !!!
542     return;
543 }
544
545 =head2 itemissues
546
547   @issues = &itemissues($biblioitemnumber, $biblio);
548
549 Looks up information about who has borrowed the bookZ<>(s) with the
550 given biblioitemnumber.
551
552 C<$biblio> is ignored.
553
554 C<&itemissues> returns an array of references-to-hash. The keys
555 include the fields from the C<items> table in the Koha database.
556 Additional keys include:
557
558 =over 4
559
560 =item C<date_due>
561
562 If the item is currently on loan, this gives the due date.
563
564 If the item is not on loan, then this is either "Available" or
565 "Cancelled", if the item has been withdrawn.
566
567 =item C<card>
568
569 If the item is currently on loan, this gives the card number of the
570 patron who currently has the item.
571
572 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
573
574 These give the timestamp for the last three times the item was
575 borrowed.
576
577 =item C<card0>, C<card1>, C<card2>
578
579 The card number of the last three patrons who borrowed this item.
580
581 =item C<borrower0>, C<borrower1>, C<borrower2>
582
583 The borrower number of the last three patrons who borrowed this item.
584
585 =back
586
587 =cut
588
589 #'
590 sub itemissues {
591     my ( $bibitem, $biblio ) = @_;
592     my $dbh = C4::Context->dbh;
593     my $sth =
594       $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
595       || die $dbh->errstr;
596     my $i = 0;
597     my @results;
598
599     $sth->execute($bibitem) || die $sth->errstr;
600
601     while ( my $data = $sth->fetchrow_hashref ) {
602
603         # Find out who currently has this item.
604         # FIXME - Wouldn't it be better to do this as a left join of
605         # some sort? Currently, this code assumes that if
606         # fetchrow_hashref() fails, then the book is on the shelf.
607         # fetchrow_hashref() can fail for any number of reasons (e.g.,
608         # database server crash), not just because no items match the
609         # search criteria.
610         my $sth2 = $dbh->prepare(
611             "SELECT * FROM issues
612                 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
613                 WHERE itemnumber = ?
614             "
615         );
616
617         $sth2->execute( $data->{'itemnumber'} );
618         if ( my $data2 = $sth2->fetchrow_hashref ) {
619             $data->{'date_due'} = $data2->{'date_due'};
620             $data->{'card'}     = $data2->{'cardnumber'};
621             $data->{'borrower'} = $data2->{'borrowernumber'};
622         }
623         else {
624             $data->{'date_due'} = ($data->{'wthdrawn'} eq '1') ? 'Cancelled' : 'Available';
625         }
626
627         $sth2->finish;
628
629         # Find the last 3 people who borrowed this item.
630         $sth2 = $dbh->prepare(
631             "SELECT * FROM old_issues
632                 LEFT JOIN borrowers ON  issues.borrowernumber = borrowers.borrowernumber
633                 WHERE itemnumber = ?
634                 ORDER BY returndate DESC,timestamp DESC"
635         );
636
637         $sth2->execute( $data->{'itemnumber'} );
638         for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
639         {    # FIXME : error if there is less than 3 pple borrowing this item
640             if ( my $data2 = $sth2->fetchrow_hashref ) {
641                 $data->{"timestamp$i2"} = $data2->{'timestamp'};
642                 $data->{"card$i2"}      = $data2->{'cardnumber'};
643                 $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
644             }    # if
645         }    # for
646
647         $sth2->finish;
648         $results[$i] = $data;
649         $i++;
650     }
651
652     $sth->finish;
653     return (@results);
654 }
655
656 =head2 CanBookBeIssued
657
658 ( $issuingimpossible, $needsconfirmation ) = 
659         CanBookBeIssued( $borrower, $barcode, $duedatespec, $inprocess );
660 C<$duedatespec> is a C4::Dates object.
661 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
662
663 =cut
664
665 sub CanBookBeIssued {
666     my ( $borrower, $barcode, $duedate, $inprocess ) = @_;
667     my %needsconfirmation;    # filled with problems that needs confirmations
668     my %issuingimpossible;    # filled with problems that causes the issue to be IMPOSSIBLE
669     my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
670     my $issue = GetItemIssue($item->{itemnumber});
671         my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
672         $item->{'itemtype'}=$item->{'itype'}; 
673     my $dbh             = C4::Context->dbh;
674
675     #
676     # DUE DATE is OK ? -- should already have checked.
677     #
678     #$issuingimpossible{INVALID_DATE} = 1 unless ($duedate);
679
680     #
681     # BORROWER STATUS
682     #
683     if ( $borrower->{'category_type'} eq 'X' && (  $item->{barcode}  )) { 
684         # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1  .
685         &UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'});
686         return( { STATS => 1 }, {});
687     }
688     if ( $borrower->{flags}->{GNA} ) {
689         $issuingimpossible{GNA} = 1;
690     }
691     if ( $borrower->{flags}->{'LOST'} ) {
692         $issuingimpossible{CARD_LOST} = 1;
693     }
694     if ( $borrower->{flags}->{'DBARRED'} ) {
695         $issuingimpossible{DEBARRED} = 1;
696     }
697     if ( $borrower->{'dateexpiry'} eq '0000-00-00') {
698         $issuingimpossible{EXPIRED} = 1;
699     } else {
700         my @expirydate=  split /-/,$borrower->{'dateexpiry'};
701         if($expirydate[0]==0 || $expirydate[1]==0|| $expirydate[2]==0 ||
702             Date_to_Days(Today) > Date_to_Days( @expirydate )) {
703             $issuingimpossible{EXPIRED} = 1;                                   
704         }
705     }
706     #
707     # BORROWER STATUS
708     #
709
710     # DEBTS
711     my ($amount) =
712       C4::Members::GetMemberAccountRecords( $borrower->{'borrowernumber'}, '' && $duedate->output('iso') );
713     if ( C4::Context->preference("IssuingInProcess") ) {
714         my $amountlimit = C4::Context->preference("noissuescharge");
715         if ( $amount > $amountlimit && !$inprocess ) {
716             $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
717         }
718         elsif ( $amount <= $amountlimit && !$inprocess ) {
719             $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
720         }
721     }
722     else {
723         if ( $amount > 0 ) {
724             $needsconfirmation{DEBT} = $amount;
725         }
726     }
727
728     #
729     # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
730     #
731         my $toomany = TooMany( $borrower, $item->{biblionumber}, $item );
732     $needsconfirmation{TOO_MANY} = $toomany if $toomany;
733
734     #
735     # ITEM CHECKING
736     #
737     unless ( $item->{barcode} ) {
738         $issuingimpossible{UNKNOWN_BARCODE} = 1;
739     }
740     if (   $item->{'notforloan'}
741         && $item->{'notforloan'} > 0 )
742     {
743         $issuingimpossible{NOT_FOR_LOAN} = 1;
744     }
745         elsif ( !$item->{'notforloan'} ){
746                 # we have to check itemtypes.notforloan also
747                 if (C4::Context->preference('item-level_itypes')){
748                         # this should probably be a subroutine
749                         my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
750                         $sth->execute($item->{'itemtype'});
751                         my $notforloan=$sth->fetchrow_hashref();
752                         $sth->finish();
753                         if ($notforloan->{'notforloan'} == 1){
754                                 $issuingimpossible{NOT_FOR_LOAN} = 1;                           
755                         }
756                 }
757                 elsif ($biblioitem->{'notforloan'} == 1){
758                         $issuingimpossible{NOT_FOR_LOAN} = 1;
759                 }
760         }
761     if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} == 1 )
762     {
763         $issuingimpossible{WTHDRAWN} = 1;
764     }
765     if (   $item->{'restricted'}
766         && $item->{'restricted'} == 1 )
767     {
768         $issuingimpossible{RESTRICTED} = 1;
769     }
770     if ( C4::Context->preference("IndependantBranches") ) {
771         my $userenv = C4::Context->userenv;
772         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
773             $issuingimpossible{NOTSAMEBRANCH} = 1
774               if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} );
775         }
776     }
777
778     #
779     # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
780     #
781     if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} )
782     {
783
784         # Already issued to current borrower. Ask whether the loan should
785         # be renewed.
786         my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
787             $borrower->{'borrowernumber'},
788             $item->{'itemnumber'}
789         );
790         if ( $CanBookBeRenewed == 0 ) {    # no more renewals allowed
791             $issuingimpossible{NO_MORE_RENEWALS} = 1;
792         }
793         else {
794             $needsconfirmation{RENEW_ISSUE} = 1;
795         }
796     }
797     elsif ($issue->{borrowernumber}) {
798
799         # issued to someone else
800         my $currborinfo = GetMemberDetails( $issue->{borrowernumber} );
801
802 #        warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
803         $needsconfirmation{ISSUED_TO_ANOTHER} =
804 "$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
805     }
806
807     # See if the item is on reserve.
808     my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
809     if ($restype) {
810                 my $resbor = $res->{'borrowernumber'};
811                 my ( $resborrower, $flags ) = GetMemberDetails( $resbor, 0 );
812                 my $branches  = GetBranches();
813                 my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'};
814         if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" )
815         {
816             # The item is on reserve and waiting, but has been
817             # reserved by some other patron.
818             $needsconfirmation{RESERVE_WAITING} =
819 "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)";
820         }
821         elsif ( $restype eq "Reserved" ) {
822             # The item is on reserve for someone else.
823             $needsconfirmation{RESERVED} =
824 "$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})";
825         }
826     }
827     if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" ) {
828         if ( $borrower->{'categorycode'} eq 'W' ) {
829             my %emptyhash;
830             return ( \%emptyhash, \%needsconfirmation );
831         }
832         }
833         return ( \%issuingimpossible, \%needsconfirmation );
834 }
835
836 =head2 AddIssue
837
838 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
839
840 &AddIssue($borrower,$barcode,$date)
841
842 =over 4
843
844 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
845
846 =item C<$barcode> is the bar code of the book being issued.
847
848 =item C<$date> contains the max date of return. calculated if empty.
849
850 AddIssue does the following things :
851 - step 01: check that there is a borrowernumber & a barcode provided
852 - check for RENEWAL (book issued & being issued to the same patron)
853     - renewal YES = Calculate Charge & renew
854     - renewal NO  = 
855         * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
856         * RESERVE PLACED ?
857             - fill reserve if reserve to this patron
858             - cancel reserve or not, otherwise
859         * TRANSFERT PENDING ?
860             - complete the transfert
861         * ISSUE THE BOOK
862
863 =back
864
865 =cut
866
867 sub AddIssue {
868     my ( $borrower, $barcode, $date, $cancelreserve ) = @_;
869     my $dbh = C4::Context->dbh;
870         my $barcodecheck=CheckValidBarcode($barcode);
871         if ($borrower and $barcode and $barcodecheck ne '0'){
872                 # find which item we issue
873                 my $item = GetItem('', $barcode);
874                 my $datedue; 
875                 
876                 my $branch;
877                 # Get which branchcode we need
878                 if (C4::Context->preference('CircControl') eq 'PickupLibrary'){
879                         $branch = C4::Context->userenv->{'branch'}; 
880                 }
881                 elsif (C4::Context->preference('CircControl') eq 'PatronLibrary'){
882                         $branch = $borrower->{'branchcode'}; 
883                 }
884                 else {
885                         # items home library
886                         $branch = $item->{'homebranch'};
887                 }
888                 
889                 # get actual issuing if there is one
890                 my $actualissue = GetItemIssue( $item->{itemnumber});
891                 
892                 # get biblioinformation for this item
893                 my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
894                 
895                 #
896                 # check if we just renew the issue.
897                 #
898                 if ( $actualissue->{borrowernumber} eq $borrower->{'borrowernumber'} ) {
899                         AddRenewal(
900                                 $borrower->{'borrowernumber'},
901                                 $item->{'itemnumber'},
902                                 $branch,
903                                 $date
904                         );
905
906                 }
907                 else {
908         # it's NOT a renewal
909                         if ( $actualissue->{borrowernumber}) {
910                                 # This book is currently on loan, but not to the person
911                                 # who wants to borrow it now. mark it returned before issuing to the new borrower
912                                 AddReturn(
913                                         $item->{'barcode'},
914                                         C4::Context->userenv->{'branch'}
915                                 );
916                         }
917
918                         # See if the item is on reserve.
919                         my ( $restype, $res ) =
920                           C4::Reserves::CheckReserves( $item->{'itemnumber'} );
921                         if ($restype) {
922                                 my $resbor = $res->{'borrowernumber'};
923                                 if ( $resbor eq $borrower->{'borrowernumber'} ) {
924
925                                         # The item is reserved by the current patron
926                                         ModReserveFill($res);
927                                 }
928                                 elsif ( $restype eq "Waiting" ) {
929
930                                         # warn "Waiting";
931                                         # The item is on reserve and waiting, but has been
932                                         # reserved by some other patron.
933                                         my ( $resborrower, $flags ) = GetMemberDetails( $resbor, 0 );
934                                         my $branches   = GetBranches();
935                                         my $branchname =
936                                           $branches->{ $res->{'branchcode'} }->{'branchname'};
937                                 }
938                                 elsif ( $restype eq "Reserved" ) {
939
940                                         # warn "Reserved";
941                                         # The item is reserved by someone else.
942                                         my ( $resborrower, $flags ) =
943                                           GetMemberDetails( $resbor, 0 );
944                                         my $branches   = GetBranches();
945                                         my $branchname =  $branches->{ $res->{'branchcode'} }->{'branchname'};
946                                         if ($cancelreserve) { # cancel reserves on this item
947                                                 CancelReserve( 0, $res->{'itemnumber'},
948                                                         $res->{'borrowernumber'} );
949                                         }
950                                 }
951                                 if ($cancelreserve) {
952                                         CancelReserve( $res->{'biblionumber'}, 0,
953                     $res->{'borrowernumber'} );
954                                 }
955                                 else {
956                                         # set waiting reserve to first in reserve queue as book isn't waiting now
957                                         ModReserve(1,
958                                                 $res->{'biblionumber'},
959                                                 $res->{'borrowernumber'},
960                                                 $res->{'branchcode'}
961                                         );
962                                 }
963                         }
964
965                         # Starting process for transfer job (checking transfert and validate it if we have one)
966             my ($datesent) = GetTransfers($item->{'itemnumber'});
967             if ($datesent) {
968         #       updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for lisibility of this case (maybe for stats ....)
969             my $sth =
970                     $dbh->prepare(
971                     "UPDATE branchtransfers 
972                         SET datearrived = now(),
973                         tobranch = ?,
974                         comments = 'Forced branchtransfer'
975                     WHERE itemnumber= ? AND datearrived IS NULL"
976                     );
977                     $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
978                     $sth->finish;
979             }
980
981         # Record in the database the fact that the book was issued.
982         my $sth =
983           $dbh->prepare(
984                 "INSERT INTO issues 
985                     (borrowernumber, itemnumber,issuedate, date_due, branchcode)
986                 VALUES (?,?,?,?,?)"
987           );
988                 my $dateduef;
989         if ($date) {
990             $dateduef = $date;
991         } else {
992                         my $itype=(C4::Context->preference('item-level_itypes')) ?  $biblio->{'itype'} : $biblio->{'itemtype'} ;
993                 my $loanlength = GetLoanLength(
994                     $borrower->{'categorycode'},
995                     $itype,
996                 $branch
997                 );
998                         $dateduef = CalcDateDue(C4::Dates->new(),$loanlength,$branch);
999                 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
1000                 if ( C4::Context->preference('ReturnBeforeExpiry') && $dateduef->output('iso') gt $borrower->{dateexpiry} ) {
1001                     $dateduef = C4::Dates->new($borrower->{dateexpiry},'iso');
1002                 }
1003         };
1004                 $sth->execute(
1005             $borrower->{'borrowernumber'},
1006             $item->{'itemnumber'},
1007             strftime( "%Y-%m-%d", localtime ),$dateduef->output('iso'), C4::Context->userenv->{'branch'}
1008         );
1009         $sth->finish;
1010         $item->{'issues'}++;
1011         ModItem({ issues           => $item->{'issues'},
1012                   holdingbranch    => C4::Context->userenv->{'branch'},
1013                   itemlost         => 0,
1014                   datelastborrowed => C4::Dates->new()->output('iso'),
1015                   onloan           => $dateduef->output('iso'),
1016                 }, $item->{'biblionumber'}, $item->{'itemnumber'});
1017         ModDateLastSeen( $item->{'itemnumber'} );
1018         
1019         # If it costs to borrow this book, charge it to the patron's account.
1020         my ( $charge, $itemtype ) = GetIssuingCharges(
1021             $item->{'itemnumber'},
1022             $borrower->{'borrowernumber'}
1023         );
1024         if ( $charge > 0 ) {
1025             AddIssuingCharge(
1026                 $item->{'itemnumber'},
1027                 $borrower->{'borrowernumber'}, $charge
1028             );
1029             $item->{'charge'} = $charge;
1030         }
1031
1032         # Record the fact that this book was issued.
1033         &UpdateStats(
1034             C4::Context->userenv->{'branch'},
1035             'issue',                        $charge,
1036             '',                             $item->{'itemnumber'},
1037             $item->{'itype'}, $borrower->{'borrowernumber'}
1038         );
1039     }
1040     
1041     logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'biblionumber'}) 
1042         if C4::Context->preference("IssueLog");
1043     return ($datedue);
1044   }
1045 }
1046
1047 =head2 GetLoanLength
1048
1049 Get loan length for an itemtype, a borrower type and a branch
1050
1051 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1052
1053 =cut
1054
1055 sub GetLoanLength {
1056     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1057     my $dbh = C4::Context->dbh;
1058     my $sth =
1059       $dbh->prepare(
1060 "select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"
1061       );
1062 # warn "in get loan lenght $borrowertype $itemtype $branchcode ";
1063 # try to find issuelength & return the 1st available.
1064 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1065     $sth->execute( $borrowertype, $itemtype, $branchcode );
1066     my $loanlength = $sth->fetchrow_hashref;
1067     return $loanlength->{issuelength}
1068       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1069
1070     $sth->execute( $borrowertype, "*", $branchcode );
1071     $loanlength = $sth->fetchrow_hashref;
1072     return $loanlength->{issuelength}
1073       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1074
1075     $sth->execute( "*", $itemtype, $branchcode );
1076     $loanlength = $sth->fetchrow_hashref;
1077     return $loanlength->{issuelength}
1078       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1079
1080     $sth->execute( "*", "*", $branchcode );
1081     $loanlength = $sth->fetchrow_hashref;
1082     return $loanlength->{issuelength}
1083       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1084
1085     $sth->execute( $borrowertype, $itemtype, "*" );
1086     $loanlength = $sth->fetchrow_hashref;
1087     return $loanlength->{issuelength}
1088       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1089
1090     $sth->execute( $borrowertype, "*", "*" );
1091     $loanlength = $sth->fetchrow_hashref;
1092     return $loanlength->{issuelength}
1093       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1094
1095     $sth->execute( "*", $itemtype, "*" );
1096     $loanlength = $sth->fetchrow_hashref;
1097     return $loanlength->{issuelength}
1098       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1099
1100     $sth->execute( "*", "*", "*" );
1101     $loanlength = $sth->fetchrow_hashref;
1102     return $loanlength->{issuelength}
1103       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1104
1105     # if no rule is set => 21 days (hardcoded)
1106     return 21;
1107 }
1108
1109 =head2 GetIssuingRule
1110
1111 FIXME - This is a copy-paste of GetLoanLength 
1112 as a stop-gap.  Do not wish to change API for GetLoanLength 
1113 this close to release, however, Overdues::GetIssuingRules is broken.
1114
1115 Get the issuing rule for an itemtype, a borrower type and a branch
1116 Returns a hashref from the issuingrules table.
1117
1118 my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1119
1120 =cut
1121
1122 sub GetIssuingRule {
1123     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1124     my $dbh = C4::Context->dbh;
1125     my $sth =  $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"  );
1126     my $irule;
1127
1128         $sth->execute( $borrowertype, $itemtype, $branchcode );
1129     $irule = $sth->fetchrow_hashref;
1130     return $irule if defined($irule) ;
1131
1132     $sth->execute( $borrowertype, "*", $branchcode );
1133     $irule = $sth->fetchrow_hashref;
1134     return $irule if defined($irule) ;
1135
1136     $sth->execute( "*", $itemtype, $branchcode );
1137     $irule = $sth->fetchrow_hashref;
1138     return $irule if defined($irule) ;
1139
1140     $sth->execute( "*", "*", $branchcode );
1141     $irule = $sth->fetchrow_hashref;
1142     return $irule if defined($irule) ;
1143
1144     $sth->execute( $borrowertype, $itemtype, "*" );
1145     $irule = $sth->fetchrow_hashref;
1146     return $irule if defined($irule) ;
1147
1148     $sth->execute( $borrowertype, "*", "*" );
1149     $irule = $sth->fetchrow_hashref;
1150     return $irule if defined($irule) ;
1151
1152     $sth->execute( "*", $itemtype, "*" );
1153     $irule = $sth->fetchrow_hashref;
1154     return $irule if defined($irule) ;
1155
1156     $sth->execute( "*", "*", "*" );
1157     $irule = $sth->fetchrow_hashref;
1158     return $irule if defined($irule) ;
1159
1160     # if no rule matches,
1161     return undef;
1162 }
1163
1164 =head2 GetBranchBorrowerCircRule
1165
1166 =over 4
1167
1168 my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1169
1170 =back
1171
1172 Retrieves circulation rule attributes that apply to the given
1173 branch and patron category, regardless of item type.  
1174 The return value is a hashref containing the following key:
1175
1176 maxissueqty - maximum number of loans that a
1177 patron of the given category can have at the given
1178 branch.  If the value is undef, no limit.
1179
1180 This will first check for a specific branch and
1181 category match from branch_borrower_circ_rules. 
1182
1183 If no rule is found, it will then check default_branch_circ_rules
1184 (same branch, default category).  If no rule is found,
1185 it will then check default_borrower_circ_rules (default 
1186 branch, same category), then failing that, default_circ_rules
1187 (default branch, default category).
1188
1189 If no rule has been found in the database, it will default to
1190 the buillt in rule:
1191
1192 maxissueqty - undef
1193
1194 C<$branchcode> and C<$categorycode> should contain the
1195 literal branch code and patron category code, respectively - no
1196 wildcards.
1197
1198 =cut
1199
1200 sub GetBranchBorrowerCircRule {
1201     my $branchcode = shift;
1202     my $categorycode = shift;
1203
1204     my $branch_cat_query = "SELECT maxissueqty
1205                             FROM branch_borrower_circ_rules
1206                             WHERE branchcode = ?
1207                             AND   categorycode = ?";
1208     my $dbh = C4::Context->dbh();
1209     my $sth = $dbh->prepare($branch_cat_query);
1210     $sth->execute($branchcode, $categorycode);
1211     my $result;
1212     if ($result = $sth->fetchrow_hashref()) {
1213         return $result;
1214     }
1215
1216     # try same branch, default borrower category
1217     my $branch_query = "SELECT maxissueqty
1218                         FROM default_branch_circ_rules
1219                         WHERE branchcode = ?";
1220     $sth = $dbh->prepare($branch_query);
1221     $sth->execute($branchcode);
1222     if ($result = $sth->fetchrow_hashref()) {
1223         return $result;
1224     }
1225
1226     # try default branch, same borrower category
1227     my $category_query = "SELECT maxissueqty
1228                           FROM default_borrower_circ_rules
1229                           WHERE categorycode = ?";
1230     $sth = $dbh->prepare($category_query);
1231     $sth->execute($categorycode);
1232     if ($result = $sth->fetchrow_hashref()) {
1233         return $result;
1234     }
1235   
1236     # try default branch, default borrower category
1237     my $default_query = "SELECT maxissueqty
1238                           FROM default_circ_rules";
1239     $sth = $dbh->prepare($default_query);
1240     $sth->execute();
1241     if ($result = $sth->fetchrow_hashref()) {
1242         return $result;
1243     }
1244     
1245     # built-in default circulation rule
1246     return {
1247         maxissueqty => undef,
1248     };
1249 }
1250
1251 =head2 AddReturn
1252
1253 ($doreturn, $messages, $iteminformation, $borrower) =
1254     &AddReturn($barcode, $branch, $exemptfine, $dropbox);
1255
1256 Returns a book.
1257
1258 C<$barcode> is the bar code of the book being returned. C<$branch> is
1259 the code of the branch where the book is being returned.  C<$exemptfine>
1260 indicates that overdue charges for the item will be removed.  C<$dropbox>
1261 indicates that the check-in date is assumed to be yesterday, or the last
1262 non-holiday as defined in C4::Calendar .  If overdue
1263 charges are applied and C<$dropbox> is true, the last charge will be removed.
1264 This assumes that the fines accrual script has run for _today_.
1265
1266 C<&AddReturn> returns a list of four items:
1267
1268 C<$doreturn> is true iff the return succeeded.
1269
1270 C<$messages> is a reference-to-hash giving the reason for failure:
1271
1272 =over 4
1273
1274 =item C<BadBarcode>
1275
1276 No item with this barcode exists. The value is C<$barcode>.
1277
1278 =item C<NotIssued>
1279
1280 The book is not currently on loan. The value is C<$barcode>.
1281
1282 =item C<IsPermanent>
1283
1284 The book's home branch is a permanent collection. If you have borrowed
1285 this book, you are not allowed to return it. The value is the code for
1286 the book's home branch.
1287
1288 =item C<wthdrawn>
1289
1290 This book has been withdrawn/cancelled. The value should be ignored.
1291
1292 =item C<ResFound>
1293
1294 The item was reserved. The value is a reference-to-hash whose keys are
1295 fields from the reserves table of the Koha database, and
1296 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1297 either C<Waiting>, C<Reserved>, or 0.
1298
1299 =back
1300
1301 C<$borrower> is a reference-to-hash, giving information about the
1302 patron who last borrowed the book.
1303
1304 =cut
1305
1306 sub AddReturn {
1307     my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
1308     my $dbh      = C4::Context->dbh;
1309     my $messages;
1310     my $doreturn = 1;
1311     my $borrower;
1312     my $validTransfert = 0;
1313     my $reserveDone = 0;
1314     
1315     # get information on item
1316     my $iteminformation = GetItemIssue( GetItemnumberFromBarcode($barcode));
1317     my $biblio = GetBiblioItemData($iteminformation->{'biblioitemnumber'});
1318 #     use Data::Dumper;warn Data::Dumper::Dumper($iteminformation);  
1319     unless ($iteminformation->{'itemnumber'} ) {
1320         $messages->{'BadBarcode'} = $barcode;
1321         $doreturn = 0;
1322     } else {
1323         # find the borrower
1324         if ( ( not $iteminformation->{borrowernumber} ) && $doreturn ) {
1325             $messages->{'NotIssued'} = $barcode;
1326             # even though item is not on loan, it may still
1327             # be transferred; therefore, get current branch information
1328             my $curr_iteminfo = GetItem($iteminformation->{'itemnumber'});
1329             $iteminformation->{'homebranch'} = $curr_iteminfo->{'homebranch'};
1330             $iteminformation->{'holdingbranch'} = $curr_iteminfo->{'holdingbranch'};
1331             $doreturn = 0;
1332         }
1333     
1334         # check if the book is in a permanent collection....
1335         my $hbr      = $iteminformation->{C4::Context->preference("HomeOrHoldingBranch")};
1336         my $branches = GetBranches();
1337                 # FIXME -- This 'PE' attribute is largely undocumented.  afaict, there's no user interface that reflects this functionality.
1338         if ( $hbr && $branches->{$hbr}->{'PE'} ) {
1339             $messages->{'IsPermanent'} = $hbr;
1340         }
1341                 
1342                     # if independent branches are on and returning to different branch, refuse the return
1343         if ($hbr ne C4::Context->userenv->{'branch'} && C4::Context->preference("IndependantBranches")){
1344                           $messages->{'Wrongbranch'} = 1;
1345                           $doreturn=0;
1346                     }
1347                         
1348         # check that the book has been cancelled
1349         if ( $iteminformation->{'wthdrawn'} ) {
1350             $messages->{'wthdrawn'} = 1;
1351             $doreturn = 0;
1352         }
1353     
1354     #     new op dev : if the book returned in an other branch update the holding branch
1355     
1356     # update issues, thereby returning book (should push this out into another subroutine
1357         $borrower = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1358     
1359     # case of a return of document (deal with issues and holdingbranch)
1360     
1361         if ($doreturn) {
1362                         my $circControlBranch;
1363                         if($dropbox) {
1364                                 # don't allow dropbox mode to create an invalid entry in issues (issuedate > returndate) FIXME: actually checks eq, not gt
1365                                 undef($dropbox) if ( $iteminformation->{'issuedate'} eq C4::Dates->today('iso') );
1366                                 if (C4::Context->preference('CircControl') eq 'ItemHomeBranch' ) {
1367                                         $circControlBranch = $iteminformation->{homebranch};
1368                                 } elsif ( C4::Context->preference('CircControl') eq 'PatronLibrary') {
1369                                         $circControlBranch = $borrower->{branchcode};
1370                                 } else { # CircControl must be PickupLibrary.
1371                                         $circControlBranch = $iteminformation->{holdingbranch};
1372                                         # FIXME - is this right ? are we sure that the holdingbranch is still the pickup branch?
1373                                 }
1374                         }
1375             MarkIssueReturned($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'},$circControlBranch);
1376             $messages->{'WasReturned'} = 1;    # FIXME is the "= 1" right?
1377         }
1378     
1379     # continue to deal with returns cases, but not only if we have an issue
1380     
1381         # the holdingbranch is updated if the document is returned in an other location .
1382         if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} ) {
1383                         UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'}); 
1384                         #               reload iteminformation holdingbranch with the userenv value
1385                         $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'};
1386         }
1387         ModDateLastSeen( $iteminformation->{'itemnumber'} );
1388         ModItem({ onloan => undef }, $biblio->{'biblionumber'}, $iteminformation->{'itemnumber'});
1389                     
1390                     if ($iteminformation->{borrowernumber}){
1391                           ($borrower) = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1392         }       
1393         # fix up the accounts.....
1394         if ( $iteminformation->{'itemlost'} ) {
1395             $messages->{'WasLost'} = 1;
1396         }
1397     
1398     # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1399     #     check if we have a transfer for this document
1400         my ($datesent,$frombranch,$tobranch) = GetTransfers( $iteminformation->{'itemnumber'} );
1401     
1402     #     if we have a transfer to do, we update the line of transfers with the datearrived
1403         if ($datesent) {
1404             if ( $tobranch eq C4::Context->userenv->{'branch'} ) {
1405                     my $sth =
1406                     $dbh->prepare(
1407                             "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1408                     );
1409                     $sth->execute( $iteminformation->{'itemnumber'} );
1410                     $sth->finish;
1411     #         now we check if there is a reservation with the validate of transfer if we have one, we can         set it with the status 'W'
1412             C4::Reserves::ModReserveStatus( $iteminformation->{'itemnumber'},'W' );
1413             }
1414         else {
1415             $messages->{'WrongTransfer'} = $tobranch;
1416             $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'};
1417         }
1418         $validTransfert = 1;
1419         }
1420     
1421     # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
1422         # fix up the accounts.....
1423         if ($iteminformation->{'itemlost'}) {
1424                 FixAccountForLostAndReturned($iteminformation, $borrower);
1425                 $messages->{'WasLost'} = 1;
1426         }
1427         # fix up the overdues in accounts...
1428         FixOverduesOnReturn( $borrower->{'borrowernumber'},
1429             $iteminformation->{'itemnumber'}, $exemptfine, $dropbox );
1430     
1431     # find reserves.....
1432     #     if we don't have a reserve with the status W, we launch the Checkreserves routine
1433         my ( $resfound, $resrec ) =
1434         C4::Reserves::CheckReserves( $iteminformation->{'itemnumber'} );
1435         if ($resfound) {
1436             $resrec->{'ResFound'}   = $resfound;
1437             $messages->{'ResFound'} = $resrec;
1438             $reserveDone = 1;
1439         }
1440     
1441         # update stats?
1442         # Record the fact that this book was returned.
1443         UpdateStats(
1444             $branch, 'return', '0', '',
1445             $iteminformation->{'itemnumber'},
1446             $biblio->{'itemtype'},
1447             $borrower->{'borrowernumber'}
1448         );
1449         
1450         logaction("CIRCULATION", "RETURN", $iteminformation->{borrowernumber}, $iteminformation->{'biblionumber'}) 
1451             if C4::Context->preference("ReturnLog");
1452         
1453         #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1454         #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1455         
1456         if ( ($iteminformation->{'holdingbranch'} ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){
1457                         if (C4::Context->preference("AutomaticItemReturn") == 1) {
1458                                 ModItemTransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'});
1459                                 $messages->{'WasTransfered'} = 1;
1460                         }
1461                         else {
1462                                 $messages->{'NeedsTransfer'} = 1;
1463                         }
1464         }
1465     }
1466     return ( $doreturn, $messages, $iteminformation, $borrower );
1467 }
1468
1469 =head2 MarkIssueReturned
1470
1471 =over 4
1472
1473 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch);
1474
1475 =back
1476
1477 Unconditionally marks an issue as being returned by
1478 moving the C<issues> row to C<old_issues> and
1479 setting C<returndate> to the current date, or
1480 the last non-holiday date of the branccode specified in
1481 C<dropbox> .  Assumes you've already checked that 
1482 it's safe to do this, i.e. last non-holiday > issuedate.
1483
1484 Ideally, this function would be internal to C<C4::Circulation>,
1485 not exported, but it is currently needed by one 
1486 routine in C<C4::Accounts>.
1487
1488 =cut
1489
1490 sub MarkIssueReturned {
1491     my ($borrowernumber, $itemnumber, $dropbox_branch ) = @_;
1492         my $dbh = C4::Context->dbh;
1493         my $query = "UPDATE issues SET returndate=";
1494         my @bind = ($borrowernumber,$itemnumber);
1495         if($dropbox_branch) {
1496                 my $calendar = C4::Calendar->new(  branchcode => $dropbox_branch );
1497                 my $dropboxdate = $calendar->addDate(C4::Dates->new(), -1 );
1498                 unshift @bind, $dropboxdate->output('iso') ;
1499                 $query .= " ? "
1500         } else {
1501                 $query .= " now() ";
1502         }
1503         $query .=  " WHERE  borrowernumber = ?  AND itemnumber = ?";
1504     # FIXME transaction
1505     my $sth_upd  = $dbh->prepare($query);
1506     $sth_upd->execute(@bind);
1507     my $sth_copy = $dbh->prepare("INSERT INTO old_issues SELECT * FROM issues 
1508                                   WHERE borrowernumber = ?
1509                                   AND itemnumber = ?");
1510     $sth_copy->execute($borrowernumber, $itemnumber);
1511     my $sth_del  = $dbh->prepare("DELETE FROM issues
1512                                   WHERE borrowernumber = ?
1513                                   AND itemnumber = ?");
1514     $sth_del->execute($borrowernumber, $itemnumber);
1515 }
1516
1517 =head2 FixOverduesOnReturn
1518
1519     &FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
1520
1521 C<$brn> borrowernumber
1522
1523 C<$itm> itemnumber
1524
1525 C<$exemptfine> BOOL -- remove overdue charge associated with this issue. 
1526 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
1527
1528 internal function, called only by AddReturn
1529
1530 =cut
1531
1532 sub FixOverduesOnReturn {
1533     my ( $borrowernumber, $item, $exemptfine, $dropbox ) = @_;
1534     my $dbh = C4::Context->dbh;
1535
1536     # check for overdue fine
1537     my $sth =
1538       $dbh->prepare(
1539 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1540       );
1541     $sth->execute( $borrowernumber, $item );
1542
1543     # alter fine to show that the book has been returned
1544    my $data; 
1545         if ($data = $sth->fetchrow_hashref) {
1546         my $uquery;
1547                 my @bind = ($borrowernumber,$item ,$data->{'accountno'});
1548                 if ($exemptfine) {
1549                         $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
1550                         if (C4::Context->preference("FinesLog")) {
1551                         &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
1552                         }
1553                 } elsif ($dropbox && $data->{lastincrement}) {
1554                         my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
1555                         my $amt = $data->{amount} - $data->{lastincrement} ;
1556                         if (C4::Context->preference("FinesLog")) {
1557                         &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
1558                         }
1559                          $uquery = "update accountlines set accounttype='F' ";
1560                          if($outstanding  >= 0 && $amt >=0) {
1561                                 $uquery .= ", amount = ? , amountoutstanding=? ";
1562                                 unshift @bind, ($amt, $outstanding) ;
1563                         }
1564                 } else {
1565                         $uquery = "update accountlines set accounttype='F' ";
1566                 }
1567                 $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1568         my $usth = $dbh->prepare($uquery);
1569         $usth->execute(@bind);
1570         $usth->finish();
1571     }
1572
1573     $sth->finish();
1574     return;
1575 }
1576
1577 =head2 FixAccountForLostAndReturned
1578
1579         &FixAccountForLostAndReturned($iteminfo,$borrower);
1580
1581 Calculates the charge for a book lost and returned (Not exported & used only once)
1582
1583 C<$iteminfo> is a hashref to iteminfo. Only {itemnumber} is used.
1584
1585 C<$borrower> is a hashref to borrower. Only {borrowernumber is used.
1586
1587 Internal function, called by AddReturn
1588
1589 =cut
1590
1591 sub FixAccountForLostAndReturned {
1592         my ($iteminfo, $borrower) = @_;
1593         my $dbh = C4::Context->dbh;
1594         my $itm = $iteminfo->{'itemnumber'};
1595         # check for charge made for lost book
1596         my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
1597         $sth->execute($itm);
1598         if (my $data = $sth->fetchrow_hashref) {
1599         # writeoff this amount
1600                 my $offset;
1601                 my $amount = $data->{'amount'};
1602                 my $acctno = $data->{'accountno'};
1603                 my $amountleft;
1604                 if ($data->{'amountoutstanding'} == $amount) {
1605                 $offset = $data->{'amount'};
1606                 $amountleft = 0;
1607                 } else {
1608                 $offset = $amount - $data->{'amountoutstanding'};
1609                 $amountleft = $data->{'amountoutstanding'} - $amount;
1610                 }
1611                 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1612                         WHERE (borrowernumber = ?)
1613                         AND (itemnumber = ?) AND (accountno = ?) ");
1614                 $usth->execute($data->{'borrowernumber'},$itm,$acctno);
1615                 $usth->finish;
1616         #check if any credit is left if so writeoff other accounts
1617                 my $nextaccntno = getnextacctno($data->{'borrowernumber'});
1618                 if ($amountleft < 0){
1619                 $amountleft*=-1;
1620                 }
1621                 if ($amountleft > 0){
1622                 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1623                                                         AND (amountoutstanding >0) ORDER BY date");
1624                 $msth->execute($data->{'borrowernumber'});
1625         # offset transactions
1626                 my $newamtos;
1627                 my $accdata;
1628                 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1629                         if ($accdata->{'amountoutstanding'} < $amountleft) {
1630                         $newamtos = 0;
1631                         $amountleft -= $accdata->{'amountoutstanding'};
1632                         }  else {
1633                         $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1634                         $amountleft = 0;
1635                         }
1636                         my $thisacct = $accdata->{'accountno'};
1637                         my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1638                                         WHERE (borrowernumber = ?)
1639                                         AND (accountno=?)");
1640                         $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
1641                         $usth->finish;
1642                         $usth = $dbh->prepare("INSERT INTO accountoffsets
1643                                 (borrowernumber, accountno, offsetaccount,  offsetamount)
1644                                 VALUES
1645                                 (?,?,?,?)");
1646                         $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1647                         $usth->finish;
1648                 }
1649                 $msth->finish;
1650                 }
1651                 if ($amountleft > 0){
1652                         $amountleft*=-1;
1653                 }
1654                 my $desc="Item Returned ".$iteminfo->{'barcode'};
1655                 $usth = $dbh->prepare("INSERT INTO accountlines
1656                         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1657                         VALUES (?,?,now(),?,?,'CR',?)");
1658                 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1659                 $usth->finish;
1660                 $usth = $dbh->prepare("INSERT INTO accountoffsets
1661                         (borrowernumber, accountno, offsetaccount,  offsetamount)
1662                         VALUES (?,?,?,?)");
1663                 $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
1664                 $usth->finish;
1665         ModItem({ paidfor => '' }, undef, $itm);
1666         }
1667         $sth->finish;
1668         return;
1669 }
1670
1671 =head2 GetItemIssue
1672
1673 $issues = &GetItemIssue($itemnumber);
1674
1675 Returns patrons currently having a book. nothing if item is not issued atm
1676
1677 C<$itemnumber> is the itemnumber
1678
1679 Returns an array of hashes
1680
1681 =cut
1682
1683 sub GetItemIssue {
1684     my ( $itemnumber) = @_;
1685     return unless $itemnumber;
1686     my $dbh = C4::Context->dbh;
1687     my @GetItemIssues;
1688     
1689     # get today date
1690     my $today = POSIX::strftime("%Y%m%d", localtime);
1691
1692     my $sth = $dbh->prepare(
1693         "SELECT * FROM issues 
1694         LEFT JOIN items ON issues.itemnumber=items.itemnumber
1695     WHERE
1696     issues.itemnumber=?");
1697     $sth->execute($itemnumber);
1698     my $data = $sth->fetchrow_hashref;
1699     my $datedue = $data->{'date_due'};
1700     $datedue =~ s/-//g;
1701     if ( $datedue < $today ) {
1702         $data->{'overdue'} = 1;
1703     }
1704     $data->{'itemnumber'} = $itemnumber; # fill itemnumber, in case item is not on issue
1705     $sth->finish;
1706     return ($data);
1707 }
1708
1709 =head2 GetItemIssues
1710
1711 $issues = &GetItemIssues($itemnumber, $history);
1712
1713 Returns patrons that have issued a book
1714
1715 C<$itemnumber> is the itemnumber
1716 C<$history> is 0 if you want actuel "issuer" (if it exist) and 1 if you want issues history
1717
1718 Returns an array of hashes
1719
1720 =cut
1721
1722 sub GetItemIssues {
1723     my ( $itemnumber,$history ) = @_;
1724     my $dbh = C4::Context->dbh;
1725     my @GetItemIssues;
1726     
1727     # get today date
1728     my $today = POSIX::strftime("%Y%m%d", localtime);
1729
1730     my $sql = "SELECT * FROM issues 
1731               JOIN borrowers USING (borrowernumber)
1732               JOIN items USING (itemnumber)
1733               WHERE issues.itemnumber = ? ";
1734     if ($history) {
1735         $sql .= "UNION ALL
1736                  SELECT * FROM old_issues 
1737                  LEFT JOIN borrowers USING (borrowernumber)
1738                  JOIN items USING (itemnumber)
1739                  WHERE old_issues.itemnumber = ? ";
1740     }
1741     $sql .= "ORDER BY date_due DESC";
1742     my $sth = $dbh->prepare($sql);
1743     if ($history) {
1744         $sth->execute($itemnumber, $itemnumber);
1745     } else {
1746         $sth->execute($itemnumber);
1747     }
1748     while ( my $data = $sth->fetchrow_hashref ) {
1749         my $datedue = $data->{'date_due'};
1750         $datedue =~ s/-//g;
1751         if ( $datedue < $today ) {
1752             $data->{'overdue'} = 1;
1753         }
1754         my $itemnumber = $data->{'itemnumber'};
1755         push @GetItemIssues, $data;
1756     }
1757     $sth->finish;
1758     return ( \@GetItemIssues );
1759 }
1760
1761 =head2 GetBiblioIssues
1762
1763 $issues = GetBiblioIssues($biblionumber);
1764
1765 this function get all issues from a biblionumber.
1766
1767 Return:
1768 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1769 tables issues and the firstname,surname & cardnumber from borrowers.
1770
1771 =cut
1772
1773 sub GetBiblioIssues {
1774     my $biblionumber = shift;
1775     return undef unless $biblionumber;
1776     my $dbh   = C4::Context->dbh;
1777     my $query = "
1778         SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1779         FROM issues
1780             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1781             LEFT JOIN items ON issues.itemnumber = items.itemnumber
1782             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1783             LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1784         WHERE biblio.biblionumber = ?
1785         UNION ALL
1786         SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1787         FROM old_issues
1788             LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
1789             LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
1790             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1791             LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1792         WHERE biblio.biblionumber = ?
1793         ORDER BY timestamp
1794     ";
1795     my $sth = $dbh->prepare($query);
1796     $sth->execute($biblionumber, $biblionumber);
1797
1798     my @issues;
1799     while ( my $data = $sth->fetchrow_hashref ) {
1800         push @issues, $data;
1801     }
1802     return \@issues;
1803 }
1804
1805 =head2 CanBookBeRenewed
1806
1807 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber);
1808
1809 Find out whether a borrowed item may be renewed.
1810
1811 C<$dbh> is a DBI handle to the Koha database.
1812
1813 C<$borrowernumber> is the borrower number of the patron who currently
1814 has the item on loan.
1815
1816 C<$itemnumber> is the number of the item to renew.
1817
1818 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
1819 item must currently be on loan to the specified borrower; renewals
1820 must be allowed for the item's type; and the borrower must not have
1821 already renewed the loan. $error will contain the reason the renewal can not proceed
1822
1823 =cut
1824
1825 sub CanBookBeRenewed {
1826
1827     # check renewal status
1828     my ( $borrowernumber, $itemnumber ) = @_;
1829     my $dbh       = C4::Context->dbh;
1830     my $renews    = 1;
1831     my $renewokay = 0;
1832         my $error;
1833
1834     # Look in the issues table for this item, lent to this borrower,
1835     # and not yet returned.
1836
1837     # FIXME - I think this function could be redone to use only one SQL call.
1838     my $sth1 = $dbh->prepare(
1839         "SELECT * FROM issues
1840             WHERE borrowernumber = ?
1841             AND itemnumber = ?"
1842     );
1843     $sth1->execute( $borrowernumber, $itemnumber );
1844     if ( my $data1 = $sth1->fetchrow_hashref ) {
1845
1846         # Found a matching item
1847
1848         # See if this item may be renewed. This query is convoluted
1849         # because it's a bit messy: given the item number, we need to find
1850         # the biblioitem, which gives us the itemtype, which tells us
1851         # whether it may be renewed.
1852         my $query = "SELECT renewalsallowed FROM items ";
1853         $query .= (C4::Context->preference('item-level_itypes'))
1854                     ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1855                     : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1856                        LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1857         $query .= "WHERE items.itemnumber = ?";
1858         my $sth2 = $dbh->prepare($query);
1859         $sth2->execute($itemnumber);
1860         if ( my $data2 = $sth2->fetchrow_hashref ) {
1861             $renews = $data2->{'renewalsallowed'};
1862         }
1863         if ( $renews && $renews > $data1->{'renewals'} ) {
1864             $renewokay = 1;
1865         }
1866         else {
1867                         $error="too_many";
1868                 }
1869         $sth2->finish;
1870         my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
1871         if ($resfound) {
1872             $renewokay = 0;
1873                         $error="on_reserve"
1874         }
1875
1876     }
1877     $sth1->finish;
1878     return ($renewokay,$error);
1879 }
1880
1881 =head2 AddRenewal
1882
1883 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue]);
1884
1885 Renews a loan.
1886
1887 C<$borrowernumber> is the borrower number of the patron who currently
1888 has the item.
1889
1890 C<$itemnumber> is the number of the item to renew.
1891
1892 C<$branch> is the library branch.  Defaults to the homebranch of the ITEM.
1893
1894 C<$datedue> can be a C4::Dates object used to set the due date.
1895
1896 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
1897 from the book's item type.
1898
1899 =cut
1900
1901 sub AddRenewal {
1902         my $borrowernumber = shift or return undef;
1903         my     $itemnumber = shift or return undef;
1904     my $item   = GetItem($itemnumber) or return undef;
1905     my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
1906     my $branch  = (@_) ? shift : $item->{homebranch};   # opac-renew doesn't send branch
1907     my $datedue;
1908     # If the due date wasn't specified, calculate it by adding the
1909     # book's loan length to today's date.
1910     unless (@_ and $datedue = shift and $datedue->output('iso')) {
1911
1912         my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return undef;
1913         my $loanlength = GetLoanLength(
1914             $borrower->{'categorycode'},
1915              (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ,
1916                         $item->{homebranch}                     # item's homebranch determines loanlength OR do we want the branch specified by the AddRenewal argument?
1917         );
1918                 #FIXME -- use circControl?
1919                 $datedue =  CalcDateDue(C4::Dates->new(),$loanlength,$branch);  # this branch is the transactional branch.
1920                                                                 # The question of whether to use item's homebranch calendar is open.
1921     }
1922
1923     my $dbh = C4::Context->dbh;
1924     # Find the issues record for this book
1925     my $sth =
1926       $dbh->prepare("SELECT * FROM issues
1927                         WHERE borrowernumber=? 
1928                         AND itemnumber=?"
1929       );
1930     $sth->execute( $borrowernumber, $itemnumber );
1931     my $issuedata = $sth->fetchrow_hashref;
1932     $sth->finish;
1933
1934     # Update the issues record to have the new due date, and a new count
1935     # of how many times it has been renewed.
1936     my $renews = $issuedata->{'renewals'} + 1;
1937     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?
1938                             WHERE borrowernumber=? 
1939                             AND itemnumber=?"
1940     );
1941     $sth->execute( $datedue->output('iso'), $renews, $borrowernumber, $itemnumber );
1942     $sth->finish;
1943
1944     # Update the renewal count on the item, and tell zebra to reindex
1945     $renews = $biblio->{'renewals'} + 1;
1946     ModItem({ renewals => $renews }, $biblio->{'biblionumber'}, $itemnumber);
1947
1948     # Charge a new rental fee, if applicable?
1949     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
1950     if ( $charge > 0 ) {
1951         my $accountno = getnextacctno( $borrowernumber );
1952         my $item = GetBiblioFromItemNumber($itemnumber);
1953         $sth = $dbh->prepare(
1954                 "INSERT INTO accountlines
1955                     (date,
1956                                         borrowernumber, accountno, amount,
1957                     description,
1958                                         accounttype, amountoutstanding, itemnumber
1959                                         )
1960                     VALUES (now(),?,?,?,?,?,?,?)"
1961         );
1962         $sth->execute( $borrowernumber, $accountno, $charge,
1963             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
1964             'Rent', $charge, $itemnumber );
1965         $sth->finish;
1966     }
1967     # Log the renewal
1968     UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
1969 }
1970
1971 sub GetRenewCount {
1972     # check renewal status
1973     my ($bornum,$itemno)=@_;
1974     my $dbh = C4::Context->dbh;
1975     my $renewcount = 0;
1976         my $renewsallowed = 0;
1977         my $renewsleft = 0;
1978     # Look in the issues table for this item, lent to this borrower,
1979     # and not yet returned.
1980
1981     # FIXME - I think this function could be redone to use only one SQL call.
1982     my $sth = $dbh->prepare("select * from issues
1983                                 where (borrowernumber = ?)
1984                                 and (itemnumber = ?)");
1985     $sth->execute($bornum,$itemno);
1986     my $data = $sth->fetchrow_hashref;
1987     $renewcount = $data->{'renewals'} if $data->{'renewals'};
1988     $sth->finish;
1989     my $query = "SELECT renewalsallowed FROM items ";
1990     $query .= (C4::Context->preference('item-level_itypes'))
1991                 ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1992                 : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1993                    LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1994     $query .= "WHERE items.itemnumber = ?";
1995     my $sth2 = $dbh->prepare($query);
1996     $sth2->execute($itemno);
1997     my $data2 = $sth2->fetchrow_hashref();
1998     $renewsallowed = $data2->{'renewalsallowed'};
1999     $renewsleft = $renewsallowed - $renewcount;
2000     return ($renewcount,$renewsallowed,$renewsleft);
2001 }
2002
2003 =head2 GetIssuingCharges
2004
2005 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
2006
2007 Calculate how much it would cost for a given patron to borrow a given
2008 item, including any applicable discounts.
2009
2010 C<$itemnumber> is the item number of item the patron wishes to borrow.
2011
2012 C<$borrowernumber> is the patron's borrower number.
2013
2014 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
2015 and C<$item_type> is the code for the item's item type (e.g., C<VID>
2016 if it's a video).
2017
2018 =cut
2019
2020 sub GetIssuingCharges {
2021
2022     # calculate charges due
2023     my ( $itemnumber, $borrowernumber ) = @_;
2024     my $charge = 0;
2025     my $dbh    = C4::Context->dbh;
2026     my $item_type;
2027
2028     # Get the book's item type and rental charge (via its biblioitem).
2029     my $qcharge =     "SELECT itemtypes.itemtype,rentalcharge FROM items
2030             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
2031         $qcharge .= (C4::Context->preference('item-level_itypes'))
2032                 ? " LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
2033                 : " LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
2034         
2035     $qcharge .=      "WHERE items.itemnumber =?";
2036    
2037     my $sth1 = $dbh->prepare($qcharge);
2038     $sth1->execute($itemnumber);
2039     if ( my $data1 = $sth1->fetchrow_hashref ) {
2040         $item_type = $data1->{'itemtype'};
2041         $charge    = $data1->{'rentalcharge'};
2042         my $q2 = "SELECT rentaldiscount FROM borrowers
2043             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2044             WHERE borrowers.borrowernumber = ?
2045             AND issuingrules.itemtype = ?";
2046         my $sth2 = $dbh->prepare($q2);
2047         $sth2->execute( $borrowernumber, $item_type );
2048         if ( my $data2 = $sth2->fetchrow_hashref ) {
2049             my $discount = $data2->{'rentaldiscount'};
2050             if ( $discount eq 'NULL' ) {
2051                 $discount = 0;
2052             }
2053             $charge = ( $charge * ( 100 - $discount ) ) / 100;
2054         }
2055         $sth2->finish;
2056     }
2057
2058     $sth1->finish;
2059     return ( $charge, $item_type );
2060 }
2061
2062 =head2 AddIssuingCharge
2063
2064 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
2065
2066 =cut
2067
2068 sub AddIssuingCharge {
2069     my ( $itemnumber, $borrowernumber, $charge ) = @_;
2070     my $dbh = C4::Context->dbh;
2071     my $nextaccntno = getnextacctno( $borrowernumber );
2072     my $query ="
2073         INSERT INTO accountlines
2074             (borrowernumber, itemnumber, accountno,
2075             date, amount, description, accounttype,
2076             amountoutstanding)
2077         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
2078     ";
2079     my $sth = $dbh->prepare($query);
2080     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
2081     $sth->finish;
2082 }
2083
2084 =head2 GetTransfers
2085
2086 GetTransfers($itemnumber);
2087
2088 =cut
2089
2090 sub GetTransfers {
2091     my ($itemnumber) = @_;
2092
2093     my $dbh = C4::Context->dbh;
2094
2095     my $query = '
2096         SELECT datesent,
2097                frombranch,
2098                tobranch
2099         FROM branchtransfers
2100         WHERE itemnumber = ?
2101           AND datearrived IS NULL
2102         ';
2103     my $sth = $dbh->prepare($query);
2104     $sth->execute($itemnumber);
2105     my @row = $sth->fetchrow_array();
2106     $sth->finish;
2107     return @row;
2108 }
2109
2110
2111 =head2 GetTransfersFromTo
2112
2113 @results = GetTransfersFromTo($frombranch,$tobranch);
2114
2115 Returns the list of pending transfers between $from and $to branch
2116
2117 =cut
2118
2119 sub GetTransfersFromTo {
2120     my ( $frombranch, $tobranch ) = @_;
2121     return unless ( $frombranch && $tobranch );
2122     my $dbh   = C4::Context->dbh;
2123     my $query = "
2124         SELECT itemnumber,datesent,frombranch
2125         FROM   branchtransfers
2126         WHERE  frombranch=?
2127           AND  tobranch=?
2128           AND datearrived IS NULL
2129     ";
2130     my $sth = $dbh->prepare($query);
2131     $sth->execute( $frombranch, $tobranch );
2132     my @gettransfers;
2133
2134     while ( my $data = $sth->fetchrow_hashref ) {
2135         push @gettransfers, $data;
2136     }
2137     $sth->finish;
2138     return (@gettransfers);
2139 }
2140
2141 =head2 DeleteTransfer
2142
2143 &DeleteTransfer($itemnumber);
2144
2145 =cut
2146
2147 sub DeleteTransfer {
2148     my ($itemnumber) = @_;
2149     my $dbh          = C4::Context->dbh;
2150     my $sth          = $dbh->prepare(
2151         "DELETE FROM branchtransfers
2152          WHERE itemnumber=?
2153          AND datearrived IS NULL "
2154     );
2155     $sth->execute($itemnumber);
2156     $sth->finish;
2157 }
2158
2159 =head2 AnonymiseIssueHistory
2160
2161 $rows = AnonymiseIssueHistory($borrowernumber,$date)
2162
2163 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
2164 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
2165
2166 return the number of affected rows.
2167
2168 =cut
2169
2170 sub AnonymiseIssueHistory {
2171     my $date           = shift;
2172     my $borrowernumber = shift;
2173     my $dbh            = C4::Context->dbh;
2174     my $query          = "
2175         UPDATE old_issues
2176         SET    borrowernumber = NULL
2177         WHERE  returndate < '".$date."'
2178           AND borrowernumber IS NOT NULL
2179     ";
2180     $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
2181     my $rows_affected = $dbh->do($query);
2182     return $rows_affected;
2183 }
2184
2185 =head2 updateWrongTransfer
2186
2187 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
2188
2189 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 
2190
2191 =cut
2192
2193 sub updateWrongTransfer {
2194         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2195         my $dbh = C4::Context->dbh;     
2196 # first step validate the actual line of transfert .
2197         my $sth =
2198                 $dbh->prepare(
2199                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2200                 );
2201                 $sth->execute($FromLibrary,$itemNumber);
2202                 $sth->finish;
2203
2204 # second step create a new line of branchtransfer to the right location .
2205         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2206
2207 #third step changing holdingbranch of item
2208         UpdateHoldingbranch($FromLibrary,$itemNumber);
2209 }
2210
2211 =head2 UpdateHoldingbranch
2212
2213 $items = UpdateHoldingbranch($branch,$itmenumber);
2214 Simple methode for updating hodlingbranch in items BDD line
2215
2216 =cut
2217
2218 sub UpdateHoldingbranch {
2219         my ( $branch,$itemnumber ) = @_;
2220     ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2221 }
2222
2223 =head2 CalcDateDue
2224
2225 $newdatedue = CalcDateDue($startdate,$loanlength,$branchcode);
2226 this function calculates the due date given the loan length ,
2227 checking against the holidays calendar as per the 'useDaysMode' syspref.
2228 C<$startdate>   = C4::Dates object representing start date of loan period (assumed to be today)
2229 C<$branch>  = location whose calendar to use
2230 C<$loanlength>  = loan length prior to adjustment
2231 =cut
2232
2233 sub CalcDateDue { 
2234         my ($startdate,$loanlength,$branch) = @_;
2235         if(C4::Context->preference('useDaysMode') eq 'Days') {  # ignoring calendar
2236                 my $datedue = time + ($loanlength) * 86400;
2237         #FIXME - assumes now even though we take a startdate 
2238                 my @datearr  = localtime($datedue);
2239                 return C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso');
2240         } else {
2241                 my $calendar = C4::Calendar->new(  branchcode => $branch );
2242                 my $datedue = $calendar->addDate($startdate, $loanlength);
2243                 return $datedue;
2244         }
2245 }
2246
2247 =head2 CheckValidDatedue
2248        This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref .
2249        To be replaced by CalcDateDue() once C4::Calendar use is tested.
2250
2251 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
2252 this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref.
2253 C<$date_due>   = returndate calculate with no day check
2254 C<$itemnumber>  = itemnumber
2255 C<$branchcode>  = location of issue (affected by 'CircControl' syspref)
2256 C<$loanlength>  = loan length prior to adjustment
2257 =cut
2258
2259 sub CheckValidDatedue {
2260 my ($date_due,$itemnumber,$branchcode)=@_;
2261 my @datedue=split('-',$date_due->output('iso'));
2262 my $years=$datedue[0];
2263 my $month=$datedue[1];
2264 my $day=$datedue[2];
2265 # die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)":
2266 my $dow;
2267 for (my $i=0;$i<2;$i++){
2268     $dow=Day_of_Week($years,$month,$day);
2269     ($dow=0) if ($dow>6);
2270     my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
2271     my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2272     my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2273         if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
2274         $i=0;
2275         (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
2276         }
2277     }
2278     my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso');
2279 return $newdatedue;
2280 }
2281
2282
2283 =head2 CheckRepeatableHolidays
2284
2285 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2286 this function checks if the date due is a repeatable holiday
2287 C<$date_due>   = returndate calculate with no day check
2288 C<$itemnumber>  = itemnumber
2289 C<$branchcode>  = localisation of issue 
2290
2291 =cut
2292
2293 sub CheckRepeatableHolidays{
2294 my($itemnumber,$week_day,$branchcode)=@_;
2295 my $dbh = C4::Context->dbh;
2296 my $query = qq|SELECT count(*)  
2297         FROM repeatable_holidays 
2298         WHERE branchcode=?
2299         AND weekday=?|;
2300 my $sth = $dbh->prepare($query);
2301 $sth->execute($branchcode,$week_day);
2302 my $result=$sth->fetchrow;
2303 $sth->finish;
2304 return $result;
2305 }
2306
2307
2308 =head2 CheckSpecialHolidays
2309
2310 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2311 this function check if the date is a special holiday
2312 C<$years>   = the years of datedue
2313 C<$month>   = the month of datedue
2314 C<$day>     = the day of datedue
2315 C<$itemnumber>  = itemnumber
2316 C<$branchcode>  = localisation of issue 
2317
2318 =cut
2319
2320 sub CheckSpecialHolidays{
2321 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2322 my $dbh = C4::Context->dbh;
2323 my $query=qq|SELECT count(*) 
2324              FROM `special_holidays`
2325              WHERE year=?
2326              AND month=?
2327              AND day=?
2328              AND branchcode=?
2329             |;
2330 my $sth = $dbh->prepare($query);
2331 $sth->execute($years,$month,$day,$branchcode);
2332 my $countspecial=$sth->fetchrow ;
2333 $sth->finish;
2334 return $countspecial;
2335 }
2336
2337 =head2 CheckRepeatableSpecialHolidays
2338
2339 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2340 this function check if the date is a repeatble special holidays
2341 C<$month>   = the month of datedue
2342 C<$day>     = the day of datedue
2343 C<$itemnumber>  = itemnumber
2344 C<$branchcode>  = localisation of issue 
2345
2346 =cut
2347
2348 sub CheckRepeatableSpecialHolidays{
2349 my ($month,$day,$itemnumber,$branchcode) = @_;
2350 my $dbh = C4::Context->dbh;
2351 my $query=qq|SELECT count(*) 
2352              FROM `repeatable_holidays`
2353              WHERE month=?
2354              AND day=?
2355              AND branchcode=?
2356             |;
2357 my $sth = $dbh->prepare($query);
2358 $sth->execute($month,$day,$branchcode);
2359 my $countspecial=$sth->fetchrow ;
2360 $sth->finish;
2361 return $countspecial;
2362 }
2363
2364
2365
2366 sub CheckValidBarcode{
2367 my ($barcode) = @_;
2368 my $dbh = C4::Context->dbh;
2369 my $query=qq|SELECT count(*) 
2370              FROM items 
2371              WHERE barcode=?
2372             |;
2373 my $sth = $dbh->prepare($query);
2374 $sth->execute($barcode);
2375 my $exist=$sth->fetchrow ;
2376 $sth->finish;
2377 return $exist;
2378 }
2379
2380 1;
2381
2382 __END__
2383
2384 =head1 AUTHOR
2385
2386 Koha Developement team <info@koha.org>
2387
2388 =cut
2389