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