*** empty log message ***
[koha.git] / C4 / Accounts.pm
1 package C4::Accounts;
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 # $Id$
21
22 use strict;
23 require Exporter;
24 use C4::Context;
25 use C4::Stats;
26 use C4::Members;
27 #use C4::Circulation::Circ2;
28 use vars qw($VERSION @ISA @EXPORT);
29
30 # set the version for version checking
31 $VERSION = do { my @v = '$Revision$' =~ /\d+/g; 
32 shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
33
34 =head1 NAME
35
36 C4::Accounts - Functions for dealing with Koha accounts
37
38 =head1 SYNOPSIS
39
40 use C4::Accounts;
41
42 =head1 DESCRIPTION
43
44 The functions in this module deal with the monetary aspect of Koha,
45 including looking up and modifying the amount of money owed by a
46 patron.
47
48 =head1 FUNCTIONS
49
50 =cut
51
52 @ISA = qw(Exporter);
53 @EXPORT = qw(&checkaccount &recordpayment &fixaccounts &makepayment &manualinvoice
54 &getnextacctno &reconcileaccount);
55
56 =head2 checkaccount
57
58   $owed = &checkaccount($env, $borrowernumber, $dbh, $date);
59
60 Looks up the total amount of money owed by a borrower (fines, etc.).
61
62 C<$borrowernumber> specifies the borrower to look up.
63
64 C<$dbh> is a DBI::db handle for the Koha database.
65
66 C<$env> is ignored.
67
68 =cut
69
70 #'
71 sub checkaccount  {
72   #take borrower number
73   #check accounts and list amounts owing
74     my ($env,$borrowernumber,$dbh,$date)=@_;
75     my $select="SELECT SUM(amountoutstanding) AS total
76             FROM accountlines
77         WHERE borrowernumber = ?
78             AND amountoutstanding<>0";
79     my @bind = ($borrowernumber);
80     if ($date && $date ne ''){
81     $select.=" AND date < ?";
82     push(@bind,$date);
83     }
84     #  print $select;
85     my $sth=$dbh->prepare($select);
86     $sth->execute(@bind);
87     my $data=$sth->fetchrow_hashref;
88     my $total = $data->{'total'} || 0;
89     $sth->finish;
90     # output(1,2,"borrower owes $total");
91     #if ($total > 0){
92     #  # output(1,2,"borrower owes $total");
93     #  if ($total > 5){
94     #    reconcileaccount($env,$dbh,$borrowernumber,$total);
95     #  }
96     #}
97     #  pause();
98     return($total);
99 }
100
101 =head2 recordpayment
102
103   &recordpayment($env, $borrowernumber, $payment);
104
105 Record payment by a patron. C<$borrowernumber> is the patron's
106 borrower number. C<$payment> is a floating-point number, giving the
107 amount that was paid. C<$env> is a reference-to-hash;
108 C<$env-E<gt>{branchcode}> is the code of the branch where payment was
109 made.
110
111 Amounts owed are paid off oldest first. That is, if the patron has a
112 $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
113 of $1.50, then the oldest fine will be paid off in full, and $0.50
114 will be credited to the next one.
115
116 =cut
117
118 #'
119 sub recordpayment{
120   #here we update both the accountoffsets and the account lines
121   my ($env,$borrowernumber,$data)=@_;
122   my $dbh = C4::Context->dbh;
123   my $newamtos = 0;
124   my $accdata = "";
125   my $branch=$env->{'branchcode'};
126     warn $branch;
127   my $amountleft = $data;
128   # begin transaction
129   my $nextaccntno = getnextacctno($env,$borrowernumber,$dbh);
130   # get lines with outstanding amounts to offset
131   my $sth = $dbh->prepare("select * from accountlines
132   where (borrowernumber = ?) and (amountoutstanding<>0)
133   order by date");
134   $sth->execute($borrowernumber);
135   # offset transactions
136   while (($accdata=$sth->fetchrow_hashref) and ($amountleft>0)){
137      if ($accdata->{'amountoutstanding'} < $amountleft) {
138         $newamtos = 0;
139         $amountleft -= $accdata->{'amountoutstanding'};
140      }  else {
141         $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
142         $amountleft = 0;
143      }
144      my $thisacct = $accdata->{accountno};
145      my $usth = $dbh->prepare("update accountlines set amountoutstanding= ?
146      where (borrowernumber = ?) and (accountno=?)");
147      $usth->execute($newamtos,$borrowernumber,$thisacct);
148      $usth->finish;
149      $usth = $dbh->prepare("insert into accountoffsets
150      (borrowernumber, accountno, offsetaccount,  offsetamount)
151      values (?,?,?,?)");
152      $usth->execute($borrowernumber,$accdata->{'accountno'},$nextaccntno,$newamtos);
153      $usth->finish;
154   }
155   # create new line
156   my $usth = $dbh->prepare("insert into accountlines
157   (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding)
158   values (?,?,now(),?,'Payment,thanks','Pay',?)");
159   $usth->execute($borrowernumber,$nextaccntno,0-$data,0-$amountleft);
160   $usth->finish;
161   UpdateStats($env,$branch,'payment',$data,'','','',$borrowernumber);
162   $sth->finish;
163 }
164
165 =head2 makepayment
166
167   &makepayment($borrowernumber, $acctnumber, $amount, $branchcode);
168
169 Records the fact that a patron has paid off the entire amount he or
170 she owes.
171
172 C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is
173 the account that was credited. C<$amount> is the amount paid (this is
174 only used to record the payment. It is assumed to be equal to the
175 amount owed). C<$branchcode> is the code of the branch where payment
176 was made.
177
178 =cut
179
180 #'
181 # FIXME - I'm not at all sure about the above, because I don't
182 # understand what the acct* tables in the Koha database are for.
183 sub makepayment{
184   #here we update both the accountoffsets and the account lines
185   #updated to check, if they are paying off a lost item, we return the item
186   # from their card, and put a note on the item record
187   my ($borrowernumber,$accountno,$amount,$user,$branch)=@_;
188   my %env;
189   $env{'branchcode'}=$branch;
190   my $dbh = C4::Context->dbh;
191   # begin transaction
192   my $nextaccntno = getnextacctno(\%env,$borrowernumber,$dbh);
193   my $newamtos=0;
194   my $sth=$dbh->prepare("Select * from accountlines where  borrowernumber=? and accountno=?");
195   $sth->execute($borrowernumber,$accountno);
196   my $data=$sth->fetchrow_hashref;
197   $sth->finish;
198
199   $dbh->do(<<EOT);
200         UPDATE  accountlines
201         SET     amountoutstanding = 0
202         WHERE   borrowernumber = $borrowernumber
203           AND   accountno = $accountno
204 EOT
205
206 #  print $updquery;
207   $dbh->do(<<EOT);
208         INSERT INTO     accountoffsets
209                         (borrowernumber, accountno, offsetaccount,
210                          offsetamount)
211         VALUES          ($borrowernumber, $accountno, $nextaccntno, $newamtos)
212 EOT
213
214   # create new line
215   my $payment=0-$amount;
216   $dbh->do(<<EOT);
217         INSERT INTO     accountlines
218                         (borrowernumber, accountno, date, amount,
219                          description, accounttype, amountoutstanding)
220         VALUES          ($borrowernumber, $nextaccntno, now(), $payment,
221                         'Payment,thanks - $user', 'Pay', 0)
222 EOT
223
224   # FIXME - The second argument to &UpdateStats is supposed to be the
225   # branch code.
226   # UpdateStats is now being passed $accountno too. MTJ
227   UpdateStats(\%env,$user,'payment',$amount,'','','',$borrowernumber,$accountno);
228   $sth->finish;
229   #check to see what accounttype
230   if ($data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L'){
231     returnlost($borrowernumber,$data->{'itemnumber'});
232   }
233 }
234
235 =head2 getnextacctno
236
237   $nextacct = &getnextacctno($env, $borrowernumber, $dbh);
238
239 Returns the next unused account number for the patron with the given
240 borrower number.
241
242 C<$dbh> is a DBI::db handle to the Koha database.
243
244 C<$env> is ignored.
245
246 =cut
247
248 #'
249 # FIXME - Okay, so what does the above actually _mean_?
250 sub getnextacctno {
251   my ($env,$borrowernumber,$dbh)=@_;
252   my $nextaccntno = 1;
253   my $sth = $dbh->prepare("select * from accountlines
254   where (borrowernumber = ?)
255   order by accountno desc");
256   $sth->execute($borrowernumber);
257   if (my $accdata=$sth->fetchrow_hashref){
258     $nextaccntno = $accdata->{'accountno'} + 1;
259   }
260   $sth->finish;
261   return($nextaccntno);
262 }
263
264 =head2 fixaccounts
265
266   &fixaccounts($borrowernumber, $accountnumber, $amount);
267
268 =cut
269
270 #'
271 # FIXME - I don't understand what this function does.
272 sub fixaccounts {
273   my ($borrowernumber,$accountno,$amount)=@_;
274   my $dbh = C4::Context->dbh;
275   my $sth=$dbh->prepare("Select * from accountlines where borrowernumber=?
276      and accountno=?");
277   $sth->execute($borrowernumber,$accountno);
278   my $data=$sth->fetchrow_hashref;
279         # FIXME - Error-checking
280   my $diff=$amount-$data->{'amount'};
281   my $outstanding=$data->{'amountoutstanding'}+$diff;
282   $sth->finish;
283
284   $dbh->do(<<EOT);
285         UPDATE  accountlines
286         SET     amount = '$amount',
287                 amountoutstanding = '$outstanding'
288         WHERE   borrowernumber = $borrowernumber
289           AND   accountno = $accountno
290 EOT
291  }
292
293 # FIXME - Never used, but not exported, either.
294 sub returnlost{
295   my ($borrowernumber,$itemnum)=@_;
296   my $dbh = C4::Context->dbh;
297   my $borrower=borrdata('',$borrowernumber);
298   my $sth=$dbh->prepare("Update issues set returndate=now() where
299   borrowernumber=? and itemnumber=? and returndate is null");
300   $sth->execute($borrowernumber,$itemnum);
301   $sth->finish;
302   my @datearr = localtime(time);
303   my $date = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
304   my $bor="$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
305   $sth=$dbh->prepare("Update items set paidfor=? where itemnumber=?");
306   $sth->execute("Paid for by $bor $date",$itemnum);
307   $sth->finish;
308 }
309
310 =head2 manualinvoice
311
312   &manualinvoice($borrowernumber, $itemnumber, $description, $type,
313                  $amount, $user);
314
315 C<$borrowernumber> is the patron's borrower number.
316 C<$description> is a description of the transaction.
317 C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
318 or C<REF>.
319 C<$itemnumber> is the item involved, if pertinent; otherwise, it
320 should be the empty string.
321
322 =cut
323
324 #'
325 # FIXME - Okay, so what does this function do, really?
326 sub manualinvoice{
327   my ($borrowernumber,$itemnum,$desc,$type,$amount,$user)=@_;
328   my $dbh = C4::Context->dbh;
329   my $notifyid;
330   my $insert;
331   $itemnum=~ s/ //g;
332   my %env;
333   my $accountno=getnextacctno('',$borrowernumber,$dbh);
334   my $amountleft=$amount;
335
336   if ($type eq 'CS' || $type eq 'CB' || $type eq 'CW'
337   || $type eq 'CF' || $type eq 'CL'){
338     my $amount2=$amount*-1;     # FIXME - $amount2 = -$amount
339     $amountleft=fixcredit(\%env,$borrowernumber,$amount2,$itemnum,$type,$user);
340   }
341   if ($type eq 'N'){
342     $desc.="New Card";
343   }
344   if ($type eq 'F'){
345     $desc.="Fine";
346   }
347   if ($type eq 'A'){
348     $desc.="Account Management fee";
349   }
350   if ($type eq 'M'){
351     $desc.="Sundry";
352   }     
353         
354   if ($type eq 'L' && $desc eq ''){
355     
356     $desc="Lost Item";
357   }
358   if ($type eq 'REF'){
359     $desc.="Cash Refund";    
360     $amountleft=refund('',$borrowernumber,$amount);
361   }
362   if(($type eq 'L') or ($type eq 'F') or ($type eq 'A') or ($type eq 'N') or ($type eq 'M') ){
363   $notifyid=1;  
364   }
365     
366   if ($itemnum ne ''){
367     $desc.=" ".$itemnum;
368     my $sth=$dbh->prepare("INSERT INTO  accountlines
369                         (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id)
370         VALUES (?, ?, now(), ?,?, ?,?,?,?)");
371 #     $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $data->{'itemnumber'});
372      $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid);
373   } else {
374     my $sth=$dbh->prepare("INSERT INTO  accountlines
375             (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id)
376             VALUES (?, ?, now(), ?, ?, ?, ?,?)");
377     $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft,$notifyid);
378   }
379 }
380
381 =head2 fixcredit
382
383  $amountleft = &fixcredit($env, $borrowernumber, $data, $barcode, $type, $user);
384
385  This function is only used internally, not exported.
386  FIXME - Figure out what this function does, and write it down.
387
388 =cut
389
390 sub fixcredit{
391   #here we update both the accountoffsets and the account lines
392   my ($env,$borrowernumber,$data,$barcode,$type,$user)=@_;
393   my $dbh = C4::Context->dbh;
394   my $newamtos = 0;
395   my $accdata = "";
396   my $amountleft = $data;
397   if ($barcode ne ''){
398     my $item=getiteminformation('',$barcode);
399     my $nextaccntno = getnextacctno($env,$borrowernumber,$dbh);
400     my $query="Select * from accountlines where (borrowernumber=?
401     and itemnumber=? and amountoutstanding > 0)";
402     if ($type eq 'CL'){
403       $query.=" and (accounttype = 'L' or accounttype = 'Rep')";
404     } elsif ($type eq 'CF'){
405       $query.=" and (accounttype = 'F' or accounttype = 'FU' or
406       accounttype='Res' or accounttype='Rent')";
407     } elsif ($type eq 'CB'){
408       $query.=" and accounttype='A'";
409     }
410 #    print $query;
411     my $sth=$dbh->prepare($query);
412     $sth->execute($borrowernumber,$item->{'itemnumber'});
413     $accdata=$sth->fetchrow_hashref;
414     $sth->finish;
415     if ($accdata->{'amountoutstanding'} < $amountleft) {
416         $newamtos = 0;
417         $amountleft -= $accdata->{'amountoutstanding'};
418      }  else {
419         $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
420         $amountleft = 0;
421      }
422           my $thisacct = $accdata->{accountno};
423      my $usth = $dbh->prepare("update accountlines set amountoutstanding= ?
424      where (borrowernumber = ?) and (accountno=?)");
425      $usth->execute($newamtos,$borrowernumber,$thisacct);
426      $usth->finish;
427      $usth = $dbh->prepare("insert into accountoffsets
428      (borrowernumber, accountno, offsetaccount,  offsetamount)
429      values (?,?,?,?)");
430      $usth->execute($borrowernumber,$accdata->{'accountno'},$nextaccntno,$newamtos);
431      $usth->finish;
432   }
433   # begin transaction
434   my $nextaccntno = getnextacctno($env,$borrowernumber,$dbh);
435   # get lines with outstanding amounts to offset
436   my $sth = $dbh->prepare("select * from accountlines
437   where (borrowernumber = ?) and (amountoutstanding >0)
438   order by date");
439   $sth->execute($borrowernumber);
440 #  print $query;
441   # offset transactions
442   while (($accdata=$sth->fetchrow_hashref) and ($amountleft>0)){
443      if ($accdata->{'amountoutstanding'} < $amountleft) {
444         $newamtos = 0;
445         $amountleft -= $accdata->{'amountoutstanding'};
446      }  else {
447         $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
448         $amountleft = 0;
449      }
450      my $thisacct = $accdata->{accountno};
451      my $usth = $dbh->prepare("update accountlines set amountoutstanding= ?
452      where (borrowernumber = ?) and (accountno=?)");
453      $usth->execute($newamtos,$borrowernumber,$thisacct);
454      $usth->finish;
455      $usth = $dbh->prepare("insert into accountoffsets
456      (borrowernumber, accountno, offsetaccount,  offsetamount)
457      values (?,?,?,?)");
458      $usth->execute($borrowernumber,$accdata->{'accountno'},$nextaccntno,$newamtos);
459      $usth->finish;
460   }
461   $sth->finish;
462   $env->{'branch'}=$user;
463   $type="Credit ".$type;
464   UpdateStats($env,$user,$type,$data,$user,'','',$borrowernumber);
465   $amountleft*=-1;
466   return($amountleft);
467
468 }
469
470 =head2 refund
471
472 # FIXME - Figure out what this function does, and write it down.
473
474 =cut 
475
476 sub refund{
477   #here we update both the accountoffsets and the account lines
478   my ($env,$borrowernumber,$data)=@_;
479   my $dbh = C4::Context->dbh;
480   my $newamtos = 0;
481   my $accdata = "";
482 #  my $branch=$env->{'branchcode'};
483   my $amountleft = $data *-1;
484
485   # begin transaction
486   my $nextaccntno = getnextacctno($env,$borrowernumber,$dbh);
487   # get lines with outstanding amounts to offset
488   my $sth = $dbh->prepare("select * from accountlines
489   where (borrowernumber = ?) and (amountoutstanding<0)
490   order by date");
491   $sth->execute($borrowernumber);
492 #  print $amountleft;
493   # offset transactions
494   while (($accdata=$sth->fetchrow_hashref) and ($amountleft<0)){
495      if ($accdata->{'amountoutstanding'} > $amountleft) {
496         $newamtos = 0;
497         $amountleft -= $accdata->{'amountoutstanding'};
498      }  else {
499         $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
500         $amountleft = 0;
501      }
502 #     print $amountleft;
503      my $thisacct = $accdata->{accountno};
504      my $usth = $dbh->prepare("update accountlines set amountoutstanding= ?
505      where (borrowernumber = ?) and (accountno=?)");
506      $usth->execute($newamtos,$borrowernumber,$thisacct);
507      $usth->finish;
508      $usth = $dbh->prepare("insert into accountoffsets
509      (borrowernumber, accountno, offsetaccount,  offsetamount)
510      values (?,?,?,?)");
511      $usth->execute($borrowernumber,$accdata->{'accountno'},$nextaccntno,$newamtos);
512      $usth->finish;
513   }
514   $sth->finish;
515   return($amountleft);
516 }
517
518
519 END { }       # module clean-up code here (global destructor)
520
521 1;
522 __END__
523
524
525 =head1 SEE ALSO
526
527 DBI(3)
528
529 =cut
530