koha-dev.rot13.org Git - koha_gimpoz/blob - C4/Accounts2.pm

   1 package C4::Accounts2; #assumes C4/Accounts2
   2
   3
   4 # Copyright 2000-2002 Katipo Communications
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it under the
   9 # terms of the GNU General Public License as published by the Free Software
  10 # Foundation; either version 2 of the License, or (at your option) any later
  11 # version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License along with
  18 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  19 # Suite 330, Boston, MA  02111-1307 USA
  20
  21 use strict;
  22 require Exporter;
  23 use C4::Context;
  24 use C4::Stats;
  25 use C4::Search;
  26 use C4::Circulation::Circ2;
  27 use C4::Members;
  28 use vars qw($VERSION @ISA @EXPORT);
  29
  30 # set the version for version checking
  31 $VERSION = 0.01;        # FIXME - Should probably be different from
  32                         # the version for C4::Accounts
  33
  34 =head1 NAME
  35
  36 C4::Accounts - Functions for dealing with Koha accounts
  37
  38 =head1 SYNOPSIS
  39
  40   use C4::Accounts2;
  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 =over 2
  51
  52 =cut
  53
  54 @ISA = qw(Exporter);
  55 @EXPORT = qw(&checkaccount      &recordpayment &fixaccounts &makepayment &manualinvoice
  56                                 &getnextacctno &manualcredit
  57
  58                                 &dailyAccountBalance &addDailyAccountOp &getDailyAccountOp);
  59
  60 =item checkaccount
  61
  62   $owed = &checkaccount($env, $borrowernumber, $dbh, $date);
  63
  64 Looks up the total amount of money owed by a borrower (fines, etc.).
  65
  66 C<$borrowernumber> specifies the borrower to look up.
  67
  68 C<$dbh> is a DBI::db handle for the Koha database.
  69
  70 C<$env> is ignored.
  71
  72 =cut
  73 #'
  74 sub checkaccount  {
  75   #take borrower number
  76   #check accounts and list amounts owing
  77         my ($env,$bornumber,$dbh,$date)=@_;
  78         my $select="SELECT SUM(amountoutstanding) AS total
  79                         FROM accountlines
  80                 WHERE borrowernumber = ?
  81                         AND amountoutstanding<>0";
  82         my @bind = ($bornumber);
  83         if ($date ne ''){
  84         $select.=" AND date < ?";
  85         push(@bind,$date);
  86         }
  87         #  print $select;
  88         my $sth=$dbh->prepare($select);
  89         $sth->execute(@bind);
  90         my $data=$sth->fetchrow_hashref;
  91         my $total = $data->{'total'};
  92         $sth->finish;
  93         # output(1,2,"borrower owes $total");
  94         #if ($total > 0){
  95         #  # output(1,2,"borrower owes $total");
  96         #  if ($total > 5){
  97         #    reconcileaccount($env,$dbh,$bornumber,$total);
  98         #  }
  99         #}
 100         #  pause();
 101         return($total);
 102 }
 103
 104 =item recordpayment
 105
 106   &recordpayment($env, $borrowernumber, $payment);
 107
 108 Record payment by a patron. C<$borrowernumber> is the patron's
 109 borrower number. C<$payment> is a floating-point number, giving the
 110 amount that was paid. C<$env> is a reference-to-hash;
 111 C<$env-E<gt>{branchcode}> is the code of the branch where payment was
 112 made.
 113
 114 Amounts owed are paid off oldest first. That is, if the patron has a
 115 $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
 116 of $1.50, then the oldest fine will be paid off in full, and $0.50
 117 will be credited to the next one.
 118
 119 =cut
 120 #'
 121 sub recordpayment{
 122   #here we update both the accountoffsets and the account lines
 123   my ($env,$bornumber,$data)=@_;
 124   my $dbh = C4::Context->dbh;
 125   my $newamtos = 0;
 126   my $accdata = "";
 127   my $branch=$env->{'branchcode'};
 128   my $amountleft = $data;
 129   # begin transaction
 130   my $nextaccntno = getnextacctno($env,$bornumber,$dbh);
 131   # get lines with outstanding amounts to offset
 132   my $sth = $dbh->prepare("select * from accountlines
 133   where (borrowernumber = ?) and (amountoutstanding<>0)
 134   order by date");
 135   $sth->execute($bornumber);
 136   # offset transactions
 137   while (($accdata=$sth->fetchrow_hashref) and ($amountleft>0)){
 138      if ($accdata->{'amountoutstanding'} < $amountleft) {
 139         $newamtos = 0;
 140         $amountleft -= $accdata->{'amountoutstanding'};
 141      }  else {
 142         $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
 143         $amountleft = 0;
 144      }
 145      my $thisacct = $accdata->{accountid};
 146      my $usth = $dbh->prepare("update accountlines set amountoutstanding= ?
 147      where accountid=?");
 148      $usth->execute($newamtos,$thisacct);
 149      $usth->finish;
 150   }
 151   # create new line
 152   my $usth = $dbh->prepare("insert into accountlines
 153   (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding)
 154   values (?,?,now(),?,'Payment,thanks','Pay',?)");
 155   $usth->execute($bornumber,$nextaccntno,0-$data,0-$amountleft);
 156   $usth->finish;
 157 #  UpdateStats($env,$branch,'payment',$data,'','','',$bornumber);
 158   $sth->finish;
 159 }
 160
 161 =item makepayment
 162
 163   &makepayment($borrowernumber, $acctnumber, $amount, $branchcode);
 164
 165 Records the fact that a patron has paid off the an amount he or
 166 she owes.
 167
 168 C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is
 169 the account that was credited. C<$amount> is the amount paid (this is
 170 only used to record the payment. C<$branchcode> is the code of the branch where payment
 171 was made.
 172
 173 =cut
 174 #'
 175 # FIXME - I'm not at all sure about the above, because I don't
 176 # understand what the acct* tables in the Koha database are for.
 177
 178 sub makepayment{
 179   #here we update  the account lines
 180   #updated to check, if they are paying off a lost item, we return the item
 181   # from their card, and put a note on the item record
 182   my ($bornumber,$accountno,$amount,$user,$type)=@_;
 183   my $env;
 184 my $desc;
 185 my $pay;
 186 if ($type eq "Pay"){
 187  $desc="Payment,received by -". $user;
 188  $pay="Pay";
 189 }else{
 190  $desc="Written-off -by". $user;
 191  $pay="W";
 192 }
 193   my $dbh = C4::Context->dbh;
 194   # begin transaction
 195   my $nextaccntno = getnextacctno($env,$bornumber,$dbh);
 196   my $newamtos=0;
 197   my $sth=$dbh->prepare("Select * from accountlines where  borrowernumber=? and accountno=?");
 198   $sth->execute($bornumber,$accountno);
 199   my $data=$sth->fetchrow_hashref;
 200   $sth->finish;
 201
 202   $dbh->do(<<EOT);
 203         UPDATE  accountlines
 204         SET     amountoutstanding = amountoutstanding-$amount
 205         WHERE   borrowernumber = $bornumber
 206           AND   accountno = $accountno
 207 EOT
 208
 209
 210
 211   # create new line
 212   my $payment=0-$amount;
 213 if ($data->{'itemnumber'}){
 214 $desc.=" ".$data->{'itemnumber'};
 215
 216   $dbh->do(<<EOT);
 217         INSERT INTO     accountlines
 218                         (borrowernumber, accountno, itemnumber,date, amount,
 219                          description, accounttype, amountoutstanding,offset)
 220         VALUES          ($bornumber, $nextaccntno, $data->{'itemnumber'},now(), $payment,
 221                         '$desc', '$pay', 0,$accountno)
 222 EOT
 223 }else{
 224   $dbh->do(<<EOT);
 225 INSERT INTO     accountlines
 226                         (borrowernumber, accountno, date, amount,
 227                          description, accounttype, amountoutstanding,offset)
 228         VALUES          ($bornumber, $nextaccntno, now(), $payment,
 229                         '$desc', '$pay', 0,$accountno)
 230 EOT
 231 }
 232
 233   # FIXME - The second argument to &UpdateStats is supposed to be the
 234   # branch code.
 235 #  UpdateStats($env,'MAIN',$pay,$amount,'','','',$bornumber);
 236   $sth->finish;
 237   #check to see what accounttype
 238   if ($data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L'){
 239     returnlost($bornumber,$data->{'itemnumber'});
 240   }
 241 }
 242
 243 =item getnextacctno
 244
 245   $nextacct = &getnextacctno($env, $borrowernumber, $dbh);
 246
 247 Returns the next unused account number for the patron with the given
 248 borrower number.
 249
 250 C<$dbh> is a DBI::db handle to the Koha database.
 251
 252 C<$env> is ignored.
 253
 254 =cut
 255 #'
 256 # FIXME - Okay, so what does the above actually _mean_?
 257 sub getnextacctno {
 258   my ($env,$bornumber,$dbh)=@_;
 259   my $nextaccntno = 1;
 260   my $sth = $dbh->prepare("select * from accountlines
 261   where (borrowernumber = ?)
 262   order by accountno desc");
 263   $sth->execute($bornumber);
 264   if (my $accdata=$sth->fetchrow_hashref){
 265     $nextaccntno = $accdata->{'accountno'} + 1;
 266   }
 267   $sth->finish;
 268   return($nextaccntno);
 269 }
 270
 271 =item fixaccounts
 272
 273   &fixaccounts($borrowernumber, $accountnumber, $amount);
 274
 275 =cut
 276 #'
 277 # FIXME - I don't know whether used
 278 sub fixaccounts {
 279   my ($borrowernumber,$accountno,$amount)=@_;
 280   my $dbh = C4::Context->dbh;
 281   my $sth=$dbh->prepare("Select * from accountlines where borrowernumber=?
 282      and accountno=?");
 283   $sth->execute($borrowernumber,$accountno);
 284   my $data=$sth->fetchrow_hashref;
 285         # FIXME - Error-checking
 286   my $diff=$amount-$data->{'amount'};
 287   my $outstanding=$data->{'amountoutstanding'}+$diff;
 288   $sth->finish;
 289
 290   $dbh->do(<<EOT);
 291         UPDATE  accountlines
 292         SET     amount = '$amount',
 293                 amountoutstanding = '$outstanding'
 294         WHERE   borrowernumber = $borrowernumber
 295           AND   accountno = $accountno
 296 EOT
 297  }
 298
 299 # FIXME - Never used, but not exported, either.
 300 sub returnlost{
 301   my ($borrnum,$itemnum)=@_;
 302   my $dbh = C4::Context->dbh;
 303   my $borrower=C4::Members::borrdata('',$borrnum); #from C4::Members;
 304   my $sth=$dbh->prepare("Update issues set returndate=now() where
 305   borrowernumber=? and itemnumber=? and returndate is null");
 306   $sth->execute($borrnum,$itemnum);
 307   $sth->finish;
 308 }
 309
 310 =item manualinvoice
 311
 312   &manualinvoice($borrowernumber, $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
 320
 321 =cut
 322 #'
 323
 324 sub manualinvoice{
 325   my ($bornum,$desc,$type,$amount,$user)=@_;
 326   my $dbh = C4::Context->dbh;
 327   my $insert;
 328   my %env;
 329   my $accountno=getnextacctno('',$bornum,$dbh);
 330   my $amountleft=$amount;
 331
 332
 333   if ($type eq 'N'){
 334     $desc.="New Card";
 335   }
 336
 337   if ($type eq 'L' && $desc eq ''){
 338     $desc="Lost Item";
 339   }
 340  if ($type eq 'REF'){
 341  $desc="Cash refund";
 342   }
 343  $amountleft=refund('',$bornum,$amount);
 344     my $sth=$dbh->prepare("INSERT INTO  accountlines
 345                         (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding)
 346                         VALUES (?, ?, now(), ?, ?, ?, ?)");
 347     $sth->execute($bornum, $accountno, $amount, $desc, $type, $amountleft);
 348
 349 }
 350
 351 sub manualcredit{
 352   my ($bornum,$accountid,$desc,$type,$amount,$user,$oldaccount)=@_;
 353   my $dbh = C4::Context->dbh;
 354   my $insert;
 355   my $accountno=getnextacctno('',$bornum,$dbh);
 356 #  my $amountleft=$amount;
 357 my $amountleft;
 358 my $noerror;
 359   if ($type eq 'CN' || $type eq 'CA'  || $type eq 'CR'
 360   || $type eq 'CF' || $type eq 'CL' || $type eq 'CM'){
 361     my $amount2=$amount*-1;
 362    ( $amountleft, $noerror,$oldaccount)=fixcredit($dbh,$bornum,$amount2,$accountid,$type,$user);
 363   }
 364  if ($noerror>0){
 365
 366 ## find the accountline desc
 367 my $sth2=$dbh->prepare("select description from accountlines where accountid=?");
 368 $sth2->execute($accountid);
 369 my $desc2=$sth2->fetchrow;
 370 $desc.=" Credited for ".$desc2." by ".$user;
 371 $sth2->finish;
 372
 373          my $sth=$dbh->prepare("INSERT INTO     accountlines
 374                         (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,offset)
 375                         VALUES (?, ?, now(), ?, ?, ?, ?,?)");
 376         $sth->execute($bornum, $accountno, $amount, $desc, $type, $amountleft,$oldaccount);
 377
 378 return ("0");
 379 } else {
 380         return("1");
 381 }
 382 }
 383 # fixcredit
 384 sub fixcredit{
 385   #here we update both the accountoffsets and the account lines
 386   my ($dbh,$bornumber,$data,$accountid,$type,$user)=@_;
 387   my $newamtos = 0;
 388   my $accdata = "";
 389   my $amountleft = $data;
 390  my $env;
 391     my $query="Select * from accountlines where accountid=? and amountoutstanding > 0";
 392  my $sth=$dbh->prepare($query);
 393 $sth->execute($accountid);
 394     $accdata=$sth->fetchrow_hashref;
 395     $sth->finish;
 396
 397 if ($accdata){
 398           if ($accdata->{'amountoutstanding'} < $amountleft) {
 399               $newamtos = 0;
 400                 $amountleft -= $accdata->{'amountoutstanding'};
 401            }  else {
 402               $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
 403         $amountleft = 0;
 404            }
 405           my $thisacct = $accdata->{accountid};
 406      my $usth = $dbh->prepare("update accountlines set amountoutstanding= ?
 407      where accountid=?");
 408      $usth->execute($newamtos,$thisacct);
 409      $usth->finish;
 410
 411   # begin transaction
 412   # get lines with outstanding amounts to offset
 413   my $sth = $dbh->prepare("select * from accountlines
 414   where (borrowernumber = ?) and (amountoutstanding >0)
 415   order by date");
 416   $sth->execute($bornumber);
 417 #  print $query;
 418   # offset transactions
 419   while (($accdata=$sth->fetchrow_hashref) and ($amountleft>0)){
 420          if ($accdata->{'amountoutstanding'} < $amountleft) {
 421           $newamtos = 0;
 422           $amountleft -= $accdata->{'amountoutstanding'};
 423          }  else {
 424           $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
 425         $amountleft = 0;
 426          }
 427      my $thisacct = $accdata->{accountid};
 428      my $usth = $dbh->prepare("update accountlines set amountoutstanding= ?
 429      where accountid=?");
 430      $usth->execute($newamtos,$thisacct);
 431      $usth->finish;
 432   }##  while account
 433   $sth->finish;
 434
 435   $amountleft*=-1;
 436   return($amountleft,1,$accdata->{'accountno'});
 437 }else{
 438 return("",0);
 439 }
 440 }
 441
 442
 443 #
 444 sub refund{
 445   #here we update both the accountoffsets and the account lines
 446   my ($env,$bornumber,$data)=@_;
 447   my $dbh = C4::Context->dbh;
 448   my $newamtos = 0;
 449   my $accdata = "";
 450 #  my $branch=$env->{'branchcode'};
 451   my $amountleft = $data *-1;
 452
 453   # begin transaction
 454   # get lines with outstanding amounts to offset
 455   my $sth = $dbh->prepare("select * from accountlines
 456   where (borrowernumber = ?) and (amountoutstanding<0)
 457   order by date");
 458   $sth->execute($bornumber);
 459 #  print $amountleft;
 460   # offset transactions
 461   while (($accdata=$sth->fetchrow_hashref) and ($amountleft<0)){
 462      if ($accdata->{'amountoutstanding'} > $amountleft) {
 463         $newamtos = 0;
 464         $amountleft -= $accdata->{'amountoutstanding'};
 465      }  else {
 466         $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
 467         $amountleft = 0;
 468      }
 469 #     print $amountleft;
 470      my $thisacct = $accdata->{accountid};
 471      my $usth = $dbh->prepare("update accountlines set amountoutstanding= ?
 472      where accountid=?");
 473      $usth->execute($newamtos,$thisacct);
 474      $usth->finish;
 475
 476   }
 477   $sth->finish;
 478   return($amountleft*-1);
 479 }
 480
 481 #Funtion to manage the daily account#
 482
 483 sub dailyAccountBalance {
 484         my ($date) = @_;
 485         my $dbh = C4::Context->dbh;
 486         my $sth;
 487
 488         if ($date) {
 489
 490                 $sth = $dbh->prepare("SELECT * FROM dailyaccountbalance WHERE balanceDate = ?");
 491                 $sth->execute($date);
 492                 my $data = $sth->fetchrow_hashref;
 493                 if (!$data->{'balanceDate'}) {
 494                         $data->{'noentry'} = 1;
 495                 }
 496                 return ($data);
 497
 498         } else {
 499
 500                 $sth = $dbh->prepare("SELECT * FROM dailyaccountbalance WHERE balanceDate = CURRENT_DATE()");
 501                 $sth->execute();
 502
 503                 if ($sth->rows) {
 504                         return ($sth->fetchrow_hashref);
 505                 } else  {
 506                         my %hash;
 507
 508                         $sth = $dbh->prepare("SELECT currentBalanceInHand FROM dailyaccountbalance ORDER BY balanceDate DESC LIMIT 1");
 509                         $sth->execute();
 510                         if ($sth->rows) {
 511                                 ($hash{'initialBalanceInHand'}) = $sth->fetchrow_array;
 512                                 $hash{'currentBalanceInHand'} = $hash{'initialBalanceInHand'};
 513                         } else {
 514                                 $hash{'initialBalanceInHand'} = 0;
 515                                 $hash{'currentBalanceInHand'} = 0;
 516                         }
 517                         #gets the current date.
 518                         my @nowarr = localtime();
 519                         my $date = (1900+$nowarr[5])."-".($nowarr[4]+1)."-".$nowarr[3];
 520
 521                         $hash{'balanceDate'} = $date;
 522                         $hash{'initialBalanceInHand'} = sprintf  ("%.2f", $hash{'initialBalanceInHand'});
 523                         $hash{'currentBalanceInHand'} = sprintf  ("%.2f", $hash{'currentBalanceInHand'});
 524                         return \%hash;
 525                 }
 526
 527         }
 528 }
 529
 530 sub addDailyAccountOp {
 531         my ($description, $amount, $type, $invoice) = @_;
 532         my $dbh = C4::Context->dbh;
 533         unless ($invoice) { $invoice = undef};
 534         my $sth = $dbh->prepare("INSERT INTO dailyaccount (date, description, amount, type, invoice) VALUES (CURRENT_DATE(), ?, ?, ?, ?)");
 535         $sth->execute($description, $amount, $type, $invoice);
 536         my $accountop = $dbh->{'mysql_insertid'};
 537         $sth = $dbh->prepare("SELECT * FROM dailyaccountbalance WHERE balanceDate = CURRENT_DATE()");
 538         $sth->execute();
 539         if (!$sth->rows) {
 540                 $sth = $dbh->prepare("SELECT currentBalanceInHand FROM dailyaccountbalance ORDER BY balanceDate DESC LIMIT 1");
 541                 $sth->execute();
 542                 my ($blc) = $sth->fetchrow_array;
 543                 unless ($blc) {$blc = 0}
 544                 $sth = $dbh->prepare("INSERT INTO dailyaccountbalance (balanceDate, initialBalanceInHand, currentBalanceInHand) VALUES (CURRENT_DATE(), ?, ?)");
 545                 $sth->execute($blc, $blc);
 546         }
 547         if ($type eq 'D') {
 548                 $amount = -1 * $amount;
 549         }
 550         $sth = $dbh->prepare("UPDATE dailyaccountbalance SET currentBalanceInHand = currentBalanceInHand + ? WHERE balanceDate = CURRENT_DATE()");
 551         $sth->execute($amount);
 552         return $accountop;
 553 }
 554
 555 sub getDailyAccountOp {
 556         my ($date) = @_;
 557         my $dbh = C4::Context->dbh;
 558         my $sth;
 559         if ($date) {
 560                 $sth = $dbh->prepare("SELECT * FROM dailyaccount WHERE date = ?");
 561                 $sth->execute($date);
 562         } else {
 563                 $sth = $dbh->prepare("SELECT * FROM dailyaccount WHERE date = CURRENT_DATE()");
 564                 $sth->execute();
 565         }
 566         my @operations;
 567         my $count = 1;
 568         while (my $row = $sth->fetchrow_hashref) {
 569                 $row->{'num'} = $count++;
 570                 $row->{$row->{'type'}} = 1;
 571
 572                 $row->{'invoice'} =~ /(\w*)\-(\w*)\-(\w*)/;
 573                 $row->{'invoiceNumber'} = $1;
 574                 $row->{'invoiceSupplier'} = $2;
 575                 $row->{'invoiceType'} = $3;
 576
 577                 push @operations, $row;
 578         }
 579         return (scalar(@operations), \@operations);
 580 }
 581
 582 END { }       # module clean-up code here (global destructor)
 583
 584 1;
 585 __END__
 586
 587 =back
 588
 589 =head1 SEE ALSO
 590
 591 DBI(3)
 592
 593 =cut