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