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 use C4::Context;
  23 use C4::Stats;
  24 use C4::Members;
  25 use C4::Items;
  26
  27 #use C4::Circulation;
  28 use vars qw($VERSION @ISA @EXPORT);
  29
  30 BEGIN {
  31         # set the version for version checking
  32         $VERSION = 3.01;
  33         require Exporter;
  34         @ISA    = qw(Exporter);
  35         @EXPORT = qw(
  36                 &recordpayment &fixaccounts &makepayment &manualinvoice
  37                 &getnextacctno &reconcileaccount
  38         );
  39 }
  40
  41 =head1 NAME
  42
  43 C4::Accounts - Functions for dealing with Koha accounts
  44
  45 =head1 SYNOPSIS
  46
  47 use C4::Accounts;
  48
  49 =head1 DESCRIPTION
  50
  51 The functions in this module deal with the monetary aspect of Koha,
  52 including looking up and modifying the amount of money owed by a
  53 patron.
  54
  55 =head1 FUNCTIONS
  56
  57 =head2 recordpayment
  58
  59   &recordpayment($borrowernumber, $payment);
  60
  61 Record payment by a patron. C<$borrowernumber> is the patron's
  62 borrower number. C<$payment> is a floating-point number, giving the
  63 amount that was paid.
  64
  65 Amounts owed are paid off oldest first. That is, if the patron has a
  66 $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
  67 of $1.50, then the oldest fine will be paid off in full, and $0.50
  68 will be credited to the next one.
  69
  70 =cut
  71
  72 #'
  73 sub recordpayment {
  74
  75     #here we update both the accountoffsets and the account lines
  76     my ( $borrowernumber, $data ) = @_;
  77     my $dbh        = C4::Context->dbh;
  78     my $newamtos   = 0;
  79     my $accdata    = "";
  80     my $branch     = C4::Context->userenv->{'branch'};
  81     my $amountleft = $data;
  82
  83     # begin transaction
  84     my $nextaccntno = getnextacctno($borrowernumber);
  85
  86     # get lines with outstanding amounts to offset
  87     my $sth = $dbh->prepare(
  88         "SELECT * FROM accountlines
  89   WHERE (borrowernumber = ?) AND (amountoutstanding<>0)
  90   ORDER BY date"
  91     );
  92     $sth->execute($borrowernumber);
  93
  94     # offset transactions
  95     while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
  96         if ( $accdata->{'amountoutstanding'} < $amountleft ) {
  97             $newamtos = 0;
  98             $amountleft -= $accdata->{'amountoutstanding'};
  99         }
 100         else {
 101             $newamtos   = $accdata->{'amountoutstanding'} - $amountleft;
 102             $amountleft = 0;
 103         }
 104         my $thisacct = $accdata->{accountno};
 105         my $usth     = $dbh->prepare(
 106             "UPDATE accountlines SET amountoutstanding= ?
 107      WHERE (borrowernumber = ?) AND (accountno=?)"
 108         );
 109         $usth->execute( $newamtos, $borrowernumber, $thisacct );
 110         $usth->finish;
 111         $usth = $dbh->prepare(
 112             "INSERT INTO accountoffsets
 113      (borrowernumber, accountno, offsetaccount,  offsetamount)
 114      VALUES (?,?,?,?)"
 115         );
 116         $usth->execute( $borrowernumber, $accdata->{'accountno'},
 117             $nextaccntno, $newamtos );
 118         $usth->finish;
 119     }
 120
 121     # create new line
 122     my $usth = $dbh->prepare(
 123         "INSERT INTO accountlines
 124   (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding)
 125   VALUES (?,?,now(),?,'Payment,thanks','Pay',?)"
 126     );
 127     $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, 0 - $amountleft );
 128     $usth->finish;
 129     UpdateStats( $branch, 'payment', $data, '', '', '', $borrowernumber );
 130     $sth->finish;
 131 }
 132
 133 =head2 makepayment
 134
 135   &makepayment($borrowernumber, $acctnumber, $amount, $branchcode);
 136
 137 Records the fact that a patron has paid off the entire amount he or
 138 she owes.
 139
 140 C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is
 141 the account that was credited. C<$amount> is the amount paid (this is
 142 only used to record the payment. It is assumed to be equal to the
 143 amount owed). C<$branchcode> is the code of the branch where payment
 144 was made.
 145
 146 =cut
 147
 148 #'
 149 # FIXME - I'm not at all sure about the above, because I don't
 150 # understand what the acct* tables in the Koha database are for.
 151 sub makepayment {
 152
 153     #here we update both the accountoffsets and the account lines
 154     #updated to check, if they are paying off a lost item, we return the item
 155     # from their card, and put a note on the item record
 156     my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_;
 157     my $dbh = C4::Context->dbh;
 158
 159     # begin transaction
 160     my $nextaccntno = getnextacctno($borrowernumber);
 161     my $newamtos    = 0;
 162     my $sth =
 163       $dbh->prepare(
 164         "SELECT * FROM accountlines WHERE  borrowernumber=? AND accountno=?");
 165     $sth->execute( $borrowernumber, $accountno );
 166     my $data = $sth->fetchrow_hashref;
 167     $sth->finish;
 168
 169     $dbh->do(
 170         "UPDATE  accountlines
 171         SET     amountoutstanding = 0
 172         WHERE   borrowernumber = $borrowernumber
 173           AND   accountno = $accountno
 174         "
 175     );
 176
 177     #  print $updquery;
 178     $dbh->do( "
 179         INSERT INTO     accountoffsets
 180                         (borrowernumber, accountno, offsetaccount,
 181                          offsetamount)
 182         VALUES          ($borrowernumber, $accountno, $nextaccntno, $newamtos)
 183         " );
 184
 185     # create new line
 186     my $payment = 0 - $amount;
 187     $dbh->do( "
 188         INSERT INTO     accountlines
 189                         (borrowernumber, accountno, date, amount,
 190                          description, accounttype, amountoutstanding)
 191         VALUES          ($borrowernumber, $nextaccntno, now(), $payment,
 192                         'Payment,thanks - $user', 'Pay', 0)
 193         " );
 194
 195     # FIXME - The second argument to &UpdateStats is supposed to be the
 196     # branch code.
 197     # UpdateStats is now being passed $accountno too. MTJ
 198     UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber,
 199         $accountno );
 200     $sth->finish;
 201
 202     #check to see what accounttype
 203     if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
 204         returnlost( $borrowernumber, $data->{'itemnumber'} );
 205     }
 206 }
 207
 208 =head2 getnextacctno
 209
 210   $nextacct = &getnextacctno($borrowernumber);
 211
 212 Returns the next unused account number for the patron with the given
 213 borrower number.
 214
 215 =cut
 216
 217 #'
 218 # FIXME - Okay, so what does the above actually _mean_?
 219 sub getnextacctno {
 220     my ($borrowernumber) = @_;
 221     my $nextaccntno      = 1;
 222     my $dbh              = C4::Context->dbh;
 223     my $sth              = $dbh->prepare(
 224         "SELECT * FROM accountlines
 225                                 WHERE (borrowernumber = ?)
 226                                 ORDER BY accountno DESC"
 227     );
 228     $sth->execute($borrowernumber);
 229     if ( my $accdata = $sth->fetchrow_hashref ) {
 230         $nextaccntno = $accdata->{'accountno'} + 1;
 231     }
 232     $sth->finish;
 233     return ($nextaccntno);
 234 }
 235
 236 =head2 fixaccounts
 237
 238   &fixaccounts($borrowernumber, $accountnumber, $amount);
 239
 240 =cut
 241
 242 #'
 243 # FIXME - I don't understand what this function does.
 244 sub fixaccounts {
 245     my ( $borrowernumber, $accountno, $amount ) = @_;
 246     my $dbh = C4::Context->dbh;
 247     my $sth = $dbh->prepare(
 248         "SELECT * FROM accountlines WHERE borrowernumber=?
 249      AND accountno=?"
 250     );
 251     $sth->execute( $borrowernumber, $accountno );
 252     my $data = $sth->fetchrow_hashref;
 253
 254     # FIXME - Error-checking
 255     my $diff        = $amount - $data->{'amount'};
 256     my $outstanding = $data->{'amountoutstanding'} + $diff;
 257     $sth->finish;
 258
 259     $dbh->do(<<EOT);
 260         UPDATE  accountlines
 261         SET     amount = '$amount',
 262                 amountoutstanding = '$outstanding'
 263         WHERE   borrowernumber = $borrowernumber
 264           AND   accountno = $accountno
 265 EOT
 266 }
 267
 268 # FIXME - Never used, but not exported, either.
 269 sub returnlost {
 270     my ( $borrowernumber, $itemnum ) = @_;
 271     my $dbh      = C4::Context->dbh;
 272     my $borrower = C4::Members::GetMember( $borrowernumber, 'borrowernumber' );
 273     my $sth      = $dbh->prepare(
 274         "UPDATE issues SET returndate=now() WHERE
 275   borrowernumber=? AND itemnumber=? AND returndate IS NULL"
 276     );
 277     $sth->execute( $borrowernumber, $itemnum );
 278     $sth->finish;
 279     my @datearr = localtime(time);
 280     my $date =
 281       ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
 282     my $bor =
 283 "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
 284     ModItem({ paidfor =>  "Paid for by $bor $date" }, undef, $itemnum);
 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 =head1 SEE ALSO
 544
 545 DBI(3)
 546
 547 =cut
 548