Fixed so datelastseen is updated on the item record for every issue or return
[koha.git] / C4 / Circulation / Circ2.pm
1 package C4::Circulation::Circ2;
2
3 #package to deal with Returns
4 #written 3/11/99 by olwen@katipo.co.nz
5
6 use strict;
7 # use warnings;
8 require Exporter;
9 use DBI;
10 use C4::Database;
11 #use C4::Accounts;
12 #use C4::InterfaceCDK;
13 #use C4::Circulation::Main;
14 #use C4::Format;
15 #use C4::Circulation::Renewals;
16 #use C4::Scan;
17 use C4::Stats;
18 use C4::Reserves2;
19 #use C4::Search;
20 #use C4::Print;
21
22 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
23   
24 # set the version for version checking
25 $VERSION = 0.01;
26     
27 @ISA = qw(Exporter);
28 @EXPORT = qw(&getbranches &getprinters &getpatroninformation &currentissues &getissues &getiteminformation &findborrower &issuebook &returnbook &find_reserves &transferbook &decode
29 calc_charges);
30 %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
31                   
32 # your exported package globals go here,
33 # as well as any optionally exported functions
34
35 @EXPORT_OK   = qw($Var1 %Hashit);
36
37
38 # non-exported package globals go here
39 #use vars qw(@more $stuff);
40         
41 # initalize package globals, first exported ones
42
43 my $Var1   = '';
44 my %Hashit = ();
45                     
46 # then the others (which are still accessible as $Some::Module::stuff)
47 my $stuff  = '';
48 my @more   = ();
49         
50 # all file-scoped lexicals must be created before
51 # the functions below that use them.
52                 
53 # file-private lexicals go here
54 my $priv_var    = '';
55 my %secret_hash = ();
56                             
57 # here's a file-private function as a closure,
58 # callable as &$priv_func;  it cannot be prototyped.
59 my $priv_func = sub {
60   # stuff goes here.
61 };
62                                                     
63 # make all your functions, whether exported or not;
64
65
66 sub getbranches {
67 # returns a reference to a hash of references to branches...
68     my %branches;
69     my $dbh=&C4Connect;  
70     my $sth=$dbh->prepare("select * from branches");
71     $sth->execute;
72     while (my $branch=$sth->fetchrow_hashref) {
73         my $tmp = $branch->{'branchcode'}; my $brc = $dbh->quote($tmp);
74         my $query = "select categorycode from branchrelations where branchcode = $brc";
75         my $nsth = $dbh->prepare($query);
76         $nsth->execute;
77         while (my ($cat) = $nsth->fetchrow_array) {
78             $branch->{$cat} = 1;
79         }
80         $nsth->finish;
81         $branches{$branch->{'branchcode'}}=$branch;
82     }
83     $dbh->disconnect;
84     return (\%branches);
85 }
86
87
88 sub getprinters {
89     my ($env) = @_;
90     my %printers;
91     my $dbh=&C4Connect;  
92     my $sth=$dbh->prepare("select * from printers");
93     $sth->execute;
94     while (my $printer=$sth->fetchrow_hashref) {
95         $printers{$printer->{'printqueue'}}=$printer;
96     }
97     $dbh->disconnect;
98     return (\%printers);
99 }
100
101
102
103 sub getpatroninformation {
104 # returns 
105     my ($env, $borrowernumber,$cardnumber) = @_;
106     my $dbh=&C4Connect;  
107     my $query;
108     my $sth;
109     if ($borrowernumber) {
110         $query = "select * from borrowers where borrowernumber=$borrowernumber";
111     } elsif ($cardnumber) {
112         $query = "select * from borrowers where cardnumber=$cardnumber";
113     } else {
114         $env->{'apierror'} = "invalid borrower information passed to getpatroninformation subroutine";
115         return();
116     }
117     $env->{'mess'} = $query;
118     $sth = $dbh->prepare($query);
119     $sth->execute;
120     my $borrower = $sth->fetchrow_hashref;
121     my $flags = patronflags($env, $borrower, $dbh);
122     $sth->finish;
123     $dbh->disconnect;
124     $borrower->{'flags'}=$flags;
125     return($borrower, $flags);
126 }
127
128 sub decode {
129     my ($encoded) = @_;
130     my $seq = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
131     my @s = map { index($seq,$_); } split(//,$encoded);
132     my $l = ($#s+1) % 4;
133     if ($l)
134     {
135         if ($l == 1)
136         {
137             print "Error!";
138             return;
139         }
140         $l = 4-$l;
141         $#s += $l;
142     }
143     my $r = '';
144     while ($#s >= 0)
145     {
146         my $n = (($s[0] << 6 | $s[1]) << 6 | $s[2]) << 6 | $s[3];
147         $r .=chr(($n >> 16) ^ 67) .
148              chr(($n >> 8 & 255) ^ 67) .
149              chr(($n & 255) ^ 67);
150         @s = @s[4..$#s];
151     }
152     $r = substr($r,0,length($r)-$l);
153     return $r;
154 }
155
156
157
158
159 sub getiteminformation {
160 # returns a hash of item information given either the itemnumber or the barcode
161     my ($env, $itemnumber, $barcode) = @_;
162     my $dbh=&C4Connect;
163     my $sth;
164     if ($itemnumber) {
165         $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.itemnumber=$itemnumber and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
166     } elsif ($barcode) {
167         my $q_barcode=$dbh->quote($barcode);
168         $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.barcode=$q_barcode and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
169     } else {
170         $env->{'apierror'}="getiteminformation() subroutine must be called with either an itemnumber or a barcode";
171         # Error condition.  
172         return();
173     }
174     $sth->execute;
175     my $iteminformation=$sth->fetchrow_hashref;
176     $sth->finish;
177     if ($iteminformation) {
178         $sth=$dbh->prepare("select date_due from issues where itemnumber=$iteminformation->{'itemnumber'} and isnull(returndate)");
179         $sth->execute;
180         my ($date_due) = $sth->fetchrow;
181         $iteminformation->{'date_due'}=$date_due;
182         $sth->finish;
183         #$iteminformation->{'dewey'}=~s/0*$//;
184         ($iteminformation->{'dewey'} == 0) && ($iteminformation->{'dewey'}='');
185         $sth=$dbh->prepare("select * from itemtypes where itemtype='$iteminformation->{'itemtype'}'");
186         $sth->execute;
187         my $itemtype=$sth->fetchrow_hashref;
188         $iteminformation->{'loanlength'}=$itemtype->{'loanlength'};
189         $sth->finish;
190     }
191     $dbh->disconnect;
192     return($iteminformation);
193 }
194
195 sub findborrower {
196 # returns an array of borrower hash references, given a cardnumber or a partial
197 # surname 
198     my ($env, $key) = @_;
199     my $dbh=&C4Connect;
200     my @borrowers;
201     my $q_key=$dbh->quote($key);
202     my $sth=$dbh->prepare("select * from borrowers where cardnumber=$q_key");
203     $sth->execute;
204     if ($sth->rows) {
205         my ($borrower)=$sth->fetchrow_hashref;
206         push (@borrowers, $borrower);
207     } else {
208         $q_key=$dbh->quote("$key%");
209         $sth->finish;
210         $sth=$dbh->prepare("select * from borrowers where surname like $q_key");
211         $sth->execute;
212         while (my $borrower = $sth->fetchrow_hashref) {
213             push (@borrowers, $borrower);
214         }
215     }
216     $sth->finish;
217     $dbh->disconnect;
218     return(\@borrowers);
219 }
220
221
222 sub transferbook {
223 # transfer book code....
224     my ($tbr, $barcode, $ignoreRs) = @_;
225     my $messages;
226     my %env;
227     my $dotransfer = 1;
228     my $branches = getbranches();
229     my $iteminformation = getiteminformation(\%env, 0, $barcode);
230 # bad barcode..
231     if (not $iteminformation) {
232         $messages->{'BadBarcode'} = $barcode;
233         $dotransfer = 0;
234     }
235 # get branches of book...
236     my $hbr = $iteminformation->{'homebranch'};
237     my $fbr = $iteminformation->{'holdingbranch'};
238 # if is permanent...
239     if ($branches->{$hbr}->{'PE'}) {
240         $messages->{'IsPermanent'} = $hbr;
241     }
242 # cant transfer book if is already there....
243     if ($fbr eq $tbr) {
244         $messages->{'DestinationEqualsHolding'} = 1;
245         $dotransfer = 0;
246     }
247 # check if it is still issued to someone, return it...
248     my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
249     if ($currentborrower) {
250         returnbook($barcode, $fbr);
251         $messages->{'WasReturned'} = $currentborrower;
252     }
253 # find reserves.....
254     my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
255     if ($resfound and not $ignoreRs) {
256         $resrec->{'ResFound'} = $resfound;
257         $messages->{'ResFound'} = $resrec;
258         $dotransfer = 0;
259     }
260 #actually do the transfer....
261     if ($dotransfer) {
262         dotransfer($iteminformation->{'itemnumber'}, $fbr, $tbr);
263         $messages->{'WasTransfered'} = 1;
264     } 
265     return ($dotransfer, $messages, $iteminformation);
266 }
267
268 sub dotransfer {
269     my ($itm, $fbr, $tbr) = @_;
270     my $dbh = &C4Connect;
271     $itm = $dbh->quote($itm);
272     $fbr = $dbh->quote($fbr);
273     $tbr = $dbh->quote($tbr);
274     #new entry in branchtransfers....
275     my $query = "insert into branchtransfers (itemnumber, frombranch, datearrived, tobranch) 
276                                       values($itm, $fbr, now(), $tbr)";
277     my $sth = $dbh->prepare($query);
278     $sth->execute; 
279     $sth->finish;
280     #update holdingbranch in items .....
281     $query = "update items set datelastseen = now(), holdingbranch=$tbr where items.itemnumber=$itm";
282     $sth = $dbh->prepare($query);
283     $sth->execute; 
284     $sth->finish;
285     $dbh->disconnect;
286     return;
287 }
288
289
290 sub issuebook {
291     my ($env, $patroninformation, $barcode, $responses, $date) = @_;
292     my $dbh=&C4Connect;
293     my $iteminformation = getiteminformation($env, 0, $barcode);
294     my ($datedue);
295     my ($rejected,$question,$defaultanswer,$questionnumber, $noissue);
296     my $message;
297     SWITCH: {
298         if ($patroninformation->{'gonenoaddress'}) {
299             $rejected="Patron is gone, with no known address.";
300             last SWITCH;
301         }
302         if ($patroninformation->{'lost'}) {
303             $rejected="Patron's card has been reported lost.";
304             last SWITCH;
305         }
306         if ($patroninformation->{'debarred'}) {
307             $rejected="Patron is Debarred";
308             last SWITCH;
309         }
310         my $amount = checkaccount($env,$patroninformation->{'borrowernumber'}, $dbh,$date);
311         if ($amount > 5 && $patroninformation->{'categorycode'} ne 'L' &&
312                          $patroninformation->{'categorycode'} ne 'W' &&
313                          $patroninformation->{'categorycode'} ne 'I' && 
314                          $patroninformation->{'categorycode'} ne 'B' &&
315                          $patroninformation->{'categorycode'} ne 'P') {
316             $rejected = sprintf "Patron owes \$%.02f.", $amount;
317             last SWITCH;
318         }
319         unless ($iteminformation) {
320             $rejected = "$barcode is not a valid barcode.";
321             last SWITCH;
322         }
323         if ($iteminformation->{'notforloan'} == 1) {
324             $rejected="Item not for loan.";
325             last SWITCH;
326         }
327         if ($iteminformation->{'wthdrawn'} == 1) {
328             $rejected="Item withdrawn.";
329             last SWITCH;
330         }
331         if ($iteminformation->{'restricted'} == 1) {
332             $rejected="Restricted item.";
333             last SWITCH;
334         }
335         if ($iteminformation->{'itemtype'} eq 'REF') {
336             $rejected="Reference item:  Not for loan.";
337             last SWITCH;
338         }
339         my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
340         if ($currentborrower eq $patroninformation->{'borrowernumber'}) {
341 # Already issued to current borrower
342             my ($renewstatus) = renewstatus($env,$dbh,$patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
343             if ($renewstatus == 0) {
344                 $rejected="No more renewals allowed for this item.";
345                 last SWITCH;
346             } else {
347                 if ($responses->{4} eq '') {
348                     $questionnumber = 4;
349                     $question = "Book is issued to this borrower.\nRenew?";
350                     $defaultanswer = 'Y';
351                     last SWITCH;
352                 } elsif ($responses->{4} eq 'Y') {
353                     my $charge = calc_charges($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'});
354                     if ($charge > 0) {
355                         createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'}, $charge);
356                         $iteminformation->{'charge'} = $charge;
357                     }
358                     &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'});
359                     renewbook($env,$dbh, $patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
360                     $noissue=1;
361                 } else {
362                     $rejected=-1;
363                     last SWITCH;
364                 }
365             }
366         } elsif ($currentborrower ne '') {
367             my ($currborrower, $cbflags) = getpatroninformation($env,$currentborrower,0);
368             if ($responses->{1} eq '') {
369                 $questionnumber=1;
370                 $question = "Issued to $currborrower->{'firstname'} $currborrower->{'surname'} ($currborrower->{'cardnumber'}).\nMark as returned?";
371                 $defaultanswer='Y';
372                 last SWITCH;
373             } elsif ($responses->{1} eq 'Y') {
374                 returnbook($iteminformation->{'barcode'}, $env->{'branch'});
375             } else {
376                 $rejected=-1;
377                 last SWITCH;
378             }
379         }
380
381         my ($restype, $res) = CheckReserves($iteminformation->{'itemnumber'});
382         if ($restype) {
383             my $resbor = $res->{'borrowernumber'};
384             if ($resbor eq $patroninformation->{'borrowernumber'}) {
385                 FillReserve($res);
386             } elsif ($restype eq "Waiting") {
387                 my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
388                 my $branches = getbranches();
389                 my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
390                 if ($responses->{2} eq '') {
391                     $questionnumber=2;
392                     $question="Waiting for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) at $branchname \nAllow issue?";
393                     $defaultanswer='N';
394                     last SWITCH;
395                 } elsif ($responses->{2} eq 'N') {
396                     $rejected=-1;
397                     last SWITCH;
398                 } else {
399                     if ($responses->{3} eq '') {
400                         $questionnumber=3;
401                         $question="Cancel reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})?";
402                         $defaultanswer='N';
403                         last SWITCH;
404                     } elsif ($responses->{3} eq 'Y') {
405                         CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
406                     }
407                 }
408             } elsif ($restype eq "Reserved") {
409                 my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
410                 my $branches = getbranches();
411                 my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
412                 if ($responses->{5} eq '') {
413                     $questionnumber=5;
414                     $question="Reserved for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) since $res->{'reservedate'} \nAllow issue?";
415                     $defaultanswer='N';
416                     last SWITCH;
417                 } elsif ($responses->{5} eq 'N') {
418                     if ($responses->{6} eq '') {
419                         $questionnumber=6;
420                         $question="Set reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) to waiting and transfer to $branchname?";
421                         $defaultanswer='N';
422                     } elsif ($responses->{6} eq 'Y') {
423                         my $tobrcd = ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'});
424                         transferbook($tobrcd, $barcode, 1);
425                         $message = "Item should now be waiting at $branchname";
426                     }
427                     $rejected=-1;
428                     last SWITCH;
429                 } else {
430                     if ($responses->{7} eq '') {
431                         $questionnumber=7;
432                         $question="Cancel reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})?";
433                         $defaultanswer='N';
434                         last SWITCH;
435                     } elsif ($responses->{7} eq 'Y') {
436                         CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
437                     }
438                 }
439             }
440         }
441     }
442     my $dateduef;
443     unless (($question) || ($rejected) || ($noissue)) {
444         my $loanlength=21;
445         if ($iteminformation->{'loanlength'}) {
446             $loanlength=$iteminformation->{'loanlength'};
447         }
448         my $ti=time;
449         my $datedue=time+($loanlength)*86400;
450         my @datearr = localtime($datedue);
451         $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
452         if ($env->{'datedue'}) {
453             $dateduef=$env->{'datedue'};
454         }
455         $dateduef=~ s/2001\-4\-25/2001\-4\-26/;
456         my $sth=$dbh->prepare("insert into issues (borrowernumber, itemnumber, date_due, branchcode) values ($patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'}, '$dateduef', '$env->{'branchcode'}')");
457         $sth->execute;
458         $sth->finish;
459         $iteminformation->{'issues'}++;
460         $sth=$dbh->prepare("update items set issues=$iteminformation->{'issues'},datelastseen=now() where itemnumber=$iteminformation->{'itemnumber'}");
461         $sth->execute;
462         $sth->finish;
463         my $charge=calc_charges($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'});
464         if ($charge > 0) {
465             createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'}, $charge);
466             $iteminformation->{'charge'}=$charge;
467         }
468         &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'});
469     }
470     if ($iteminformation->{'charge'}) {
471         $message=sprintf "Rental charge of \$%.02f applies.", $iteminformation->{'charge'};
472     }
473     $dbh->disconnect;
474     return ($iteminformation, $dateduef, $rejected, $question, $questionnumber, $defaultanswer, $message);
475 }
476
477
478
479 sub returnbook {
480     my ($barcode, $branch) = @_;
481     my %env;
482     my $messages;
483     my $doreturn = 1;
484 # get information on item
485     my ($iteminformation) = getiteminformation(\%env, 0, $barcode);
486     if (not $iteminformation) {
487         $messages->{'BadBarcode'} = $barcode;
488         $doreturn = 0;
489     }
490 # find the borrower
491     my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
492     if ((not $currentborrower) && $doreturn) {
493         $messages->{'NotIssued'} = $barcode;
494         $doreturn = 0;
495     }
496 # check if the book is in a permanent collection....
497     my $hbr = $iteminformation->{'homebranch'};
498     my $branches = getbranches();
499     if ($branches->{$hbr}->{'PE'}) {
500         $messages->{'IsPermanent'} = $hbr;
501     }
502 # update issues, thereby returning book (should push this out into another subroutine
503     my ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
504     if ($doreturn) {
505         doreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
506         $messages->{'WasReturned'};
507     }
508     ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
509 # transfer book
510     my ($transfered, $mess, $item) = transferbook($branch, $barcode);
511     if ($transfered) {
512         $messages->{'WasTransfered'};
513     }
514 # fix up the accounts.....
515     if ($iteminformation->{'itemlost'}) {
516         updateitemlost($iteminformation->{'itemnumber'});
517         fixaccountforlostandreturned($iteminformation, $borrower);
518         $messages->{'WasLost'};
519     }
520 # fix up the overdues in accounts...
521     fixoverduesonreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
522 # find reserves.....
523     my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
524     if ($resfound) {
525         $resrec->{'ResFound'} = $resfound;
526         $messages->{'ResFound'} = $resrec;
527     }
528 # update stats?
529     UpdateStats(\%env, $branch ,'return','0','',$iteminformation->{'itemnumber'});
530     return ($doreturn, $messages, $iteminformation, $borrower);
531 }
532
533
534 sub doreturn {
535     my ($brn, $itm) = @_;
536     my $dbh=&C4Connect;
537     $brn = $dbh->quote($brn);
538     $itm = $dbh->quote($itm);
539     my $query = "update issues set returndate = now() where (borrowernumber = $brn) 
540         and (itemnumber = $itm) and (returndate is null)";
541     my $sth = $dbh->prepare($query);
542     $sth->execute;
543     $sth->finish;
544     $query="update items set datelastseen=now() where itemnumber=$itm";
545     $sth=$dbh->prepare($query);
546     $sth->execute;
547     $sth->finish;
548     $dbh->disconnect;
549     return;
550 }
551
552 sub updateitemlost{
553   my ($itemno)=@_;
554   my $dbh=&C4Connect;
555   my $query="update items set itemlost=0 where itemnumber=$itemno";
556   my $sth=$dbh->prepare($query);
557   $sth->execute;
558   $sth->finish;
559 }
560
561 sub fixaccountforlostandreturned {
562     my ($iteminfo, $borrower) = @_;
563     my %env;
564     my $dbh=&C4Connect;
565     my $itm = $dbh->quote($iteminfo->{'itemnumber'});
566 # check for charge made for lost book
567     my $query = "select * from accountlines where (itemnumber = $itm) 
568                           and (accounttype='L' or accounttype='Rep') order by date desc";
569     my $sth = $dbh->prepare($query);
570     $sth->execute;
571     if (my $data = $sth->fetchrow_hashref) {
572 # writeoff this amount 
573         my $offset;
574         my $amount = $data->{'amount'};
575         my $acctno = $data->{'accountno'};
576         my $amountleft;
577         if ($data->{'amountoutstanding'} == $amount) {
578             $offset = $data->{'amount'};
579             $amountleft = 0;
580         } else {
581             $offset = $amount - $data->{'amountoutstanding'};
582             $amountleft = $data->{'amountoutstanding'} - $amount;
583         }
584         my $uquery = "update accountlines set accounttype = 'LR',amountoutstanding='0'
585                   where (borrowernumber = '$data->{'borrowernumber'}')
586                   and (itemnumber = $itm) and (accountno = '$acctno') ";
587         my $usth = $dbh->prepare($uquery);
588         $usth->execute;
589         $usth->finish;
590 #check if any credit is left if so writeoff other accounts
591         my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
592         if ($amountleft < 0){
593             $amountleft*=-1;
594         }
595         if ($amountleft > 0){
596             my $query = "select * from accountlines where (borrowernumber = '$data->{'borrowernumber'}') 
597                                                       and (amountoutstanding >0) order by date";
598             my $msth = $dbh->prepare($query);
599             $msth->execute;
600       # offset transactions
601             my $newamtos;
602             my $accdata;
603             while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
604                 if ($accdata->{'amountoutstanding'} < $amountleft) {
605                     $newamtos = 0;
606                     $amountleft = $amountleft - $accdata->{'amountoutstanding'};
607                 }  else {
608                     $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
609                     $amountleft = 0;
610                 }
611                 my $thisacct = $accdata->{'accountno'};
612                 my $updquery = "update accountlines set amountoutstanding= '$newamtos'
613                                  where (borrowernumber = '$data->{'borrowernumber'}') 
614                                    and (accountno='$thisacct')";
615                 my $usth = $dbh->prepare($updquery);
616                 $usth->execute;
617                 $usth->finish;
618                 $updquery = "insert into accountoffsets 
619                           (borrowernumber, accountno, offsetaccount,  offsetamount)
620                           values
621                           ('$data->{'borrowernumber'}','$accdata->{'accountno'}','$nextaccntno','$newamtos')";
622                 $usth = $dbh->prepare($updquery);
623                 $usth->execute;
624                 $usth->finish;
625             }
626             $msth->finish;
627         }
628         if ($amountleft > 0){
629             $amountleft*=-1;
630         }
631         my $desc="Book Returned ".$iteminfo->{'barcode'};
632         $uquery = "insert into accountlines
633                   (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
634                   values ('$data->{'borrowernumber'}','$nextaccntno',now(),0-$amount,'$desc',
635                   'CR',$amountleft)";
636         $usth = $dbh->prepare($uquery);
637         $usth->execute;     
638         $usth->finish;
639         $uquery = "insert into accountoffsets
640                   (borrowernumber, accountno, offsetaccount,  offsetamount)
641                   values ($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset)";
642         $usth = $dbh->prepare($uquery);
643         $usth->execute;
644         $usth->finish;
645         $uquery = "update items set paidfor='' where itemnumber=$itm";
646         $usth = $dbh->prepare($uquery);
647         $usth->execute;
648         $usth->finish;
649     }
650     $sth->finish;
651     return;
652 }
653
654 sub fixoverduesonreturn {
655     my ($brn, $itm) = @_;
656     my $dbh=&C4Connect;
657     $itm = $dbh->quote($itm);
658     $brn = $dbh->quote($brn);
659 # check for overdue fine
660     my $query = "select * from accountlines where (borrowernumber=$brn) 
661                            and (itemnumber = $itm) and (accounttype='FU' or accounttype='O')";
662     my $sth = $dbh->prepare($query);
663     $sth->execute;
664 # alter fine to show that the book has been returned
665     if (my $data = $sth->fetchrow_hashref) {
666         my $query = "update accountlines set accounttype='F' where (borrowernumber = $brn) 
667                            and (itemnumber = $itm) and (acccountno='$data->{'accountno'}')";
668         my $usth=$dbh->prepare($query);
669         $usth->execute();
670         $usth->finish();
671     }
672     $sth->finish;
673     return;
674 }
675
676 sub patronflags {
677 # Original subroutine for Circ2.pm
678     my %flags;
679     my ($env, $patroninformation, $dbh) = @_;
680     my $amount = checkaccount($env, $patroninformation->{'borrowernumber'}, $dbh);
681     if ($amount > 0) { 
682         my %flaginfo;
683         $flaginfo{'message'}= sprintf "Patron owes \$%.02f", $amount; 
684         if ($amount > 5) {
685             $flaginfo{'noissues'} = 1;
686         }
687         $flags{'CHARGES'} = \%flaginfo;
688     } elsif ($amount < 0){
689        my %flaginfo;
690        $amount = $amount*-1;
691        $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", $amount;
692         $flags{'CHARGES'} = \%flaginfo;
693     }
694     if ($patroninformation->{'gonenoaddress'} == 1) {
695         my %flaginfo;
696         $flaginfo{'message'} = 'Borrower has no valid address.'; 
697         $flaginfo{'noissues'} = 1;
698         $flags{'GNA'} = \%flaginfo;
699     }
700     if ($patroninformation->{'lost'} == 1) {
701         my %flaginfo;
702         $flaginfo{'message'} = 'Borrower\'s card reported lost.'; 
703         $flaginfo{'noissues'} = 1;
704         $flags{'LOST'} = \%flaginfo;
705     }
706     if ($patroninformation->{'debarred'} == 1) {
707         my %flaginfo;
708         $flaginfo{'message'} = 'Borrower is Debarred.'; 
709         $flaginfo{'noissues'} = 1;
710         $flags{'DBARRED'} = \%flaginfo;
711     }
712     if ($patroninformation->{'borrowernotes'}) {
713         my %flaginfo;
714         $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
715         $flags{'NOTES'} = \%flaginfo;
716     }
717     my ($odues, $itemsoverdue) 
718                   = checkoverdues($env, $patroninformation->{'borrowernumber'}, $dbh);
719     if ($odues > 0) {
720         my %flaginfo;
721         $flaginfo{'message'} = "Yes";
722         $flaginfo{'itemlist'} = $itemsoverdue;
723         foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) {
724             $flaginfo{'itemlisttext'}.="$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
725         }
726         $flags{'ODUES'} = \%flaginfo;
727     }
728     my ($nowaiting, $itemswaiting) 
729                   = CheckWaiting($patroninformation->{'borrowernumber'});
730     if ($nowaiting > 0) {
731         my %flaginfo;
732         $flaginfo{'message'} = "Reserved items available";
733         $flaginfo{'itemlist'} = $itemswaiting;
734         $flags{'WAITING'} = \%flaginfo;
735     }
736     return(\%flags);
737 }
738
739
740 sub checkoverdues {
741 # From Main.pm, modified to return a list of overdueitems, in addition to a count
742   #checks whether a borrower has overdue items
743   my ($env, $bornum, $dbh)=@_;
744   my @datearr = localtime;
745   my $today = ($datearr[5] + 1900)."-".($datearr[4]+1)."-".$datearr[3];
746   my @overdueitems;
747   my $count = 0;
748   my $query = "SELECT * FROM issues,biblio,biblioitems,items 
749                        WHERE items.biblioitemnumber = biblioitems.biblioitemnumber 
750                          AND items.biblionumber     = biblio.biblionumber 
751                          AND issues.itemnumber      = items.itemnumber 
752                          AND issues.borrowernumber  = $bornum 
753                          AND issues.returndate is NULL 
754                          AND issues.date_due < '$today'";
755   my $sth = $dbh->prepare($query);
756   $sth->execute;
757   while (my $data = $sth->fetchrow_hashref) {
758       push (@overdueitems, $data);
759       $count++;
760   }
761   $sth->finish;
762   return ($count, \@overdueitems);
763 }
764
765 sub currentborrower {
766 # Original subroutine for Circ2.pm
767     my ($itemnumber) = @_;
768     my $dbh = &C4Connect;
769     my $q_itemnumber = $dbh->quote($itemnumber);
770     my $sth=$dbh->prepare("select borrowers.borrowernumber from
771     issues,borrowers where issues.itemnumber=$q_itemnumber and
772     issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
773     NULL");
774     $sth->execute;
775     my ($borrower) = $sth->fetchrow;
776     return($borrower);
777 }
778
779 sub checkreserve {
780 # Stolen from Main.pm
781   # Check for reserves for biblio 
782   my ($env,$dbh,$itemnum)=@_;
783   my $resbor = "";
784   my $query = "select * from reserves,items 
785     where (items.itemnumber = '$itemnum')
786     and (reserves.cancellationdate is NULL)
787     and (items.biblionumber = reserves.biblionumber)
788     and ((reserves.found = 'W')
789     or (reserves.found is null)) 
790     order by priority";
791   my $sth = $dbh->prepare($query);
792   $sth->execute();
793   my $resrec;
794   my $data=$sth->fetchrow_hashref;
795   while ($data && $resbor eq '') {
796     $resrec=$data;
797     my $const = $data->{'constrainttype'};
798     if ($const eq "a") {
799       $resbor = $data->{'borrowernumber'};
800     } else {
801       my $found = 0;
802       my $cquery = "select * from reserveconstraints,items 
803          where (borrowernumber='$data->{'borrowernumber'}') 
804          and reservedate='$data->{'reservedate'}'
805          and reserveconstraints.biblionumber='$data->{'biblionumber'}'
806          and (items.itemnumber=$itemnum and 
807          items.biblioitemnumber = reserveconstraints.biblioitemnumber)";
808       my $csth = $dbh->prepare($cquery);
809       $csth->execute;
810       if (my $cdata=$csth->fetchrow_hashref) {$found = 1;}
811       if ($const eq 'o') {
812         if ($found eq 1) {$resbor = $data->{'borrowernumber'};}
813       } else {
814         if ($found eq 0) {$resbor = $data->{'borrowernumber'};}
815       }
816       $csth->finish();
817     }
818     $data=$sth->fetchrow_hashref;
819   }
820   $sth->finish;
821   return ($resbor,$resrec);
822 }
823
824 sub currentissues {
825 # New subroutine for Circ2.pm
826     my ($env, $borrower) = @_;
827     my $dbh=&C4Connect;
828     my %currentissues;
829     my $counter=1;
830     my $borrowernumber = $borrower->{'borrowernumber'};
831     my $crit='';
832     if ($env->{'todaysissues'}) {
833         my @datearr = localtime(time());
834         my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
835         $crit=" and issues.timestamp like '$today%' ";
836     }
837     if ($env->{'nottodaysissues'}) {
838         my @datearr = localtime(time());
839         my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
840         $crit=" and !(issues.timestamp like '$today%') ";
841     }
842     my $select="select * from issues,items,biblioitems,biblio where
843        borrowernumber='$borrowernumber' and issues.itemnumber=items.itemnumber and
844        items.biblionumber=biblio.biblionumber and
845        items.biblioitemnumber=biblioitems.biblioitemnumber and returndate is null
846        $crit order by issues.timestamp desc";
847 #    print $select;
848     my $sth=$dbh->prepare($select);
849     $sth->execute;
850     while (my $data = $sth->fetchrow_hashref) {
851         $data->{'dewey'}=~s/0*$//;
852         ($data->{'dewey'} == 0) && ($data->{'dewey'}='');
853         my @datearr = localtime(time());
854         my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]
855         +1)).sprintf ("%0.2d", $datearr[3]);
856         my $datedue=$data->{'date_due'};
857         $datedue=~s/-//g;
858         if ($datedue < $todaysdate) {
859             $data->{'overdue'}=1;
860         }
861         my $itemnumber=$data->{'itemnumber'};
862         $currentissues{$counter}=$data;
863         $counter++;
864     }
865     $sth->finish;
866     $dbh->disconnect;
867     return(\%currentissues);
868 }
869 sub getissues {
870 # New subroutine for Circ2.pm
871     my ($borrower) = @_;
872     my $dbh=&C4Connect;
873     my $borrowernumber = $borrower->{'borrowernumber'};
874     my $brn =$dbh->quote($borrowernumber);
875     my %currentissues;
876     my $select = "select issues.timestamp, issues.date_due, items.biblionumber,
877                          items.barcode, biblio.title, biblio.author, biblioitems.dewey, 
878                          biblioitems.subclass 
879                     from issues,items,biblioitems,biblio
880                    where issues.borrowernumber = $brn 
881                      and issues.itemnumber = items.itemnumber 
882                      and items.biblionumber = biblio.biblionumber 
883                      and items.biblioitemnumber = biblioitems.biblioitemnumber 
884                      and issues.returndate is null
885                          order by issues.date_due";
886 #    print $select;
887     my $sth=$dbh->prepare($select);
888     $sth->execute;
889     my $counter = 0;
890     while (my $data = $sth->fetchrow_hashref) {
891         $data->{'dewey'} =~ s/0*$//;
892         ($data->{'dewey'} == 0) && ($data->{'dewey'} = '');
893         my @datearr = localtime(time());
894         my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]);
895         my $datedue = $data->{'date_due'};
896         $datedue =~ s/-//g;
897         if ($datedue < $todaysdate) {
898             $data->{'overdue'} = 1;
899         }
900         $currentissues{$counter} = $data;
901         $counter++;
902     }
903     $sth->finish;
904     $dbh->disconnect;
905     return(\%currentissues);
906 }
907
908 sub checkwaiting {
909 #Stolen from Main.pm
910   # check for reserves waiting
911   my ($env,$dbh,$bornum)=@_;
912   my @itemswaiting;
913   my $query = "select * from reserves
914     where (borrowernumber = '$bornum')
915     and (reserves.found='W') and cancellationdate is NULL";
916   my $sth = $dbh->prepare($query);
917   $sth->execute();
918   my $cnt=0;
919   if (my $data=$sth->fetchrow_hashref) {
920     $itemswaiting[$cnt] =$data;
921     $cnt ++
922   }
923   $sth->finish;
924   return ($cnt,\@itemswaiting);
925 }
926
927
928 sub checkaccount  {
929 # Stolen from Accounts.pm
930   #take borrower number
931   #check accounts and list amounts owing
932   my ($env,$bornumber,$dbh,$date)=@_;
933   my $select="Select sum(amountoutstanding) from accountlines where
934   borrowernumber=$bornumber and amountoutstanding<>0";
935   if ($date ne ''){
936     $select.=" and date < '$date'";
937   }
938 #  print $select;
939   my $sth=$dbh->prepare($select);
940   $sth->execute;
941   my $total=0;
942   while (my $data=$sth->fetchrow_hashref){
943     $total=$total+$data->{'sum(amountoutstanding)'};
944   }
945   $sth->finish;
946   # output(1,2,"borrower owes $total");
947   #if ($total > 0){
948   #  # output(1,2,"borrower owes $total");
949   #  if ($total > 5){
950   #    reconcileaccount($env,$dbh,$bornumber,$total);
951   #  }
952   #}
953   #  pause();
954   return($total);
955 }    
956
957 sub renewstatus {
958 # Stolen from Renewals.pm
959   # check renewal status
960   my ($env,$dbh,$bornum,$itemno)=@_;
961   my $renews = 1;
962   my $renewokay = 0;
963   my $q1 = "select * from issues 
964     where (borrowernumber = '$bornum')
965     and (itemnumber = '$itemno') 
966     and returndate is null";
967   my $sth1 = $dbh->prepare($q1);
968   $sth1->execute;
969   if (my $data1 = $sth1->fetchrow_hashref) {
970     my $q2 = "select renewalsallowed from items,biblioitems,itemtypes
971        where (items.itemnumber = '$itemno')
972        and (items.biblioitemnumber = biblioitems.biblioitemnumber) 
973        and (biblioitems.itemtype = itemtypes.itemtype)";
974     my $sth2 = $dbh->prepare($q2);
975     $sth2->execute;     
976     if (my $data2=$sth2->fetchrow_hashref) {
977       $renews = $data2->{'renewalsallowed'};
978     }
979     if ($renews > $data1->{'renewals'}) {
980       $renewokay = 1;
981     }
982     $sth2->finish;
983   }   
984   $sth1->finish;
985   return($renewokay);    
986 }
987
988 sub renewbook {
989 # Stolen from Renewals.pm
990   # mark book as renewed
991   my ($env,$dbh,$bornum,$itemno,$datedue)=@_;
992   $datedue=$env->{'datedue'};
993   if ($datedue eq "" ) {    
994     my $loanlength=21;
995     my $query= "Select * from biblioitems,items,itemtypes
996        where (items.itemnumber = '$itemno')
997        and (biblioitems.biblioitemnumber = items.biblioitemnumber)
998        and (biblioitems.itemtype = itemtypes.itemtype)";
999     my $sth=$dbh->prepare($query);
1000     $sth->execute;
1001     if (my $data=$sth->fetchrow_hashref) {
1002       $loanlength = $data->{'loanlength'}
1003     }
1004     $sth->finish;
1005     my $ti = time;
1006     my $datedu = time + ($loanlength * 86400);
1007     my @datearr = localtime($datedu);
1008     $datedue = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
1009   }
1010   my @date = split("-",$datedue);
1011   my $odatedue = ($date[2]+0)."-".($date[1]+0)."-".$date[0];
1012   my $issquery = "select * from issues where borrowernumber='$bornum' and
1013     itemnumber='$itemno' and returndate is null";
1014   my $sth=$dbh->prepare($issquery);
1015   $sth->execute;
1016   my $issuedata=$sth->fetchrow_hashref;
1017   $sth->finish;
1018   my $renews = $issuedata->{'renewals'} +1;
1019   my $updquery = "update issues 
1020     set date_due = '$datedue', renewals = '$renews'
1021     where borrowernumber='$bornum' and
1022     itemnumber='$itemno' and returndate is null";
1023   $sth=$dbh->prepare($updquery);
1024   
1025   $sth->execute;
1026   $sth->finish;
1027   return($odatedue);
1028 }
1029
1030 sub calc_charges {
1031 # Stolen from Issues.pm
1032 # calculate charges due
1033     my ($env, $dbh, $itemno, $bornum)=@_;
1034 #    if (!$dbh){
1035 #      $dbh=C4Connect();
1036 #    }
1037     my $charge=0;
1038 #    open (FILE,">>/tmp/charges");
1039     my $item_type;
1040     my $q1 = "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes 
1041     where (items.itemnumber ='$itemno')
1042     and (biblioitems.biblioitemnumber = items.biblioitemnumber) 
1043     and (biblioitems.itemtype = itemtypes.itemtype)";
1044     my $sth1= $dbh->prepare($q1);
1045 #    print FILE "$q1\n";
1046     $sth1->execute;
1047     if (my $data1=$sth1->fetchrow_hashref) {
1048         $item_type = $data1->{'itemtype'};
1049         $charge = $data1->{'rentalcharge'};
1050 #       print FILE "charge is $charge\n";
1051         my $q2 = "select rentaldiscount from borrowers,categoryitem 
1052         where (borrowers.borrowernumber = '$bornum') 
1053         and (borrowers.categorycode = categoryitem.categorycode)
1054         and (categoryitem.itemtype = '$item_type')";
1055         my $sth2=$dbh->prepare($q2);
1056 #       warn $q2;
1057         $sth2->execute;
1058         if (my $data2=$sth2->fetchrow_hashref) {
1059             my $discount = $data2->{'rentaldiscount'};
1060 #           print FILE "discount is $discount";
1061             if ($discount eq 'NULL') {
1062               $discount=0;
1063             }
1064             $charge = ($charge *(100 - $discount)) / 100;
1065         }
1066         $sth2->finish;
1067     }      
1068     $sth1->finish;
1069 #    close FILE;
1070     return ($charge);
1071 }
1072
1073 sub createcharge {
1074 #Stolen from Issues.pm
1075     my ($env,$dbh,$itemno,$bornum,$charge) = @_;
1076     my $nextaccntno = getnextacctno($env,$bornum,$dbh);
1077     my $query = "insert into accountlines (borrowernumber,itemnumber,accountno,date,amount, description,accounttype,amountoutstanding) values ($bornum,$itemno,$nextaccntno,now(),$charge,'Rental','Rent',$charge)";
1078     my $sth = $dbh->prepare($query);
1079     $sth->execute;
1080     $sth->finish;
1081 }
1082
1083
1084 sub getnextacctno {
1085 # Stolen from Accounts.pm
1086     my ($env,$bornumber,$dbh)=@_;
1087     my $nextaccntno = 1;
1088     my $query = "select * from accountlines where (borrowernumber = '$bornumber') order by accountno desc";
1089     my $sth = $dbh->prepare($query);
1090     $sth->execute;
1091     if (my $accdata=$sth->fetchrow_hashref){
1092         $nextaccntno = $accdata->{'accountno'} + 1;
1093     }
1094     $sth->finish;
1095     return($nextaccntno);
1096 }
1097
1098 sub find_reserves {
1099 # Stolen from Returns.pm
1100     my ($itemno) = @_;
1101     my %env;
1102     my $dbh=&C4Connect;
1103     my ($itemdata) = getiteminformation(\%env, $itemno,0);
1104     my $bibno = $dbh->quote($itemdata->{'biblionumber'});
1105     my $bibitm = $dbh->quote($itemdata->{'biblioitemnumber'});
1106     my $query = "select * from reserves where ((found = 'W') or (found is null)) 
1107                        and biblionumber = $bibno and cancellationdate is NULL
1108                        order by priority, reservedate ";
1109     my $sth = $dbh->prepare($query);
1110     $sth->execute;
1111     my $resfound = 0;
1112     my $resrec;
1113     my $lastrec;
1114 # print $query;
1115     while (($resrec = $sth->fetchrow_hashref) && (not $resfound)) {
1116         $lastrec = $resrec;
1117         my $brn = $dbh->quote($resrec->{'borrowernumber'});
1118         my $rdate = $dbh->quote($resrec->{'reservedate'});
1119         my $bibno = $dbh->quote($resrec->{'biblionumber'});
1120         if ($resrec->{'found'} eq "W") {
1121             if ($resrec->{'itemnumber'} eq $itemno) {
1122                 $resfound = 1;
1123             }
1124         } else {
1125             if ($resrec->{'constrainttype'} eq "a") {
1126                 $resfound = 1;
1127             } else {
1128                 my $conquery = "select * from reserveconstraints where borrowernumber = $brn 
1129                      and reservedate = $rdate and biblionumber = $bibno and biblioitemnumber = $bibitm";
1130                 my $consth = $dbh->prepare($conquery);
1131                 $consth->execute;
1132                 if (my $conrec = $consth->fetchrow_hashref) {
1133                     if ($resrec->{'constrainttype'} eq "o") {
1134                         $resfound = 1;
1135                     }
1136                 }
1137                 $consth->finish;
1138             }
1139         }
1140         if ($resfound) {
1141             my $updquery = "update reserves set found = 'W', itemnumber = '$itemno'
1142                   where borrowernumber = $brn and reservedate = $rdate and biblionumber = $bibno";
1143             my $updsth = $dbh->prepare($updquery);
1144             $updsth->execute;
1145             $updsth->finish;
1146         }
1147     }
1148     $sth->finish;
1149     return ($resfound,$lastrec);
1150 }
1151
1152 END { }       # module clean-up code here (global destructor)