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 use C4::Circulation;
  27
  28 use vars qw($VERSION @ISA @EXPORT);
  29
  30 BEGIN {
  31         # set the version for version checking
  32         $VERSION = 3.03;
  33         require Exporter;
  34         @ISA    = qw(Exporter);
  35         @EXPORT = qw(
  36                 &recordpayment &makepayment &manualinvoice
  37                 &getnextacctno &reconcileaccount &getcharges &getcredits
  38                 &getrefunds
  39         ); # removed &fixaccounts
  40 }
  41
  42 =head1 NAME
  43
  44 C4::Accounts - Functions for dealing with Koha accounts
  45
  46 =head1 SYNOPSIS
  47
  48 use C4::Accounts;
  49
  50 =head1 DESCRIPTION
  51
  52 The functions in this module deal with the monetary aspect of Koha,
  53 including looking up and modifying the amount of money owed by a
  54 patron.
  55
  56 =head1 FUNCTIONS
  57
  58 =head2 recordpayment
  59
  60   &recordpayment($borrowernumber, $payment);
  61
  62 Record payment by a patron. C<$borrowernumber> is the patron's
  63 borrower number. C<$payment> is a floating-point number, giving the
  64 amount that was paid.
  65
  66 Amounts owed are paid off oldest first. That is, if the patron has a
  67 $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
  68 of $1.50, then the oldest fine will be paid off in full, and $0.50
  69 will be credited to the next one.
  70
  71 =cut
  72
  73 #'
  74 sub recordpayment {
  75
  76     #here we update the account lines
  77     my ( $borrowernumber, $data ) = @_;
  78     my $dbh        = C4::Context->dbh;
  79     my $newamtos   = 0;
  80     my $accdata    = "";
  81     my $branch     = C4::Context->userenv->{'branch'};
  82     my $amountleft = $data;
  83
  84     # begin transaction
  85     my $nextaccntno = getnextacctno($borrowernumber);
  86
  87     # get lines with outstanding amounts to offset
  88     my $sth = $dbh->prepare(
  89         "SELECT * FROM accountlines
  90   WHERE (borrowernumber = ?) AND (amountoutstanding<>0)
  91   ORDER BY date"
  92     );
  93     $sth->execute($borrowernumber);
  94
  95     # offset transactions
  96     while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
  97         if ( $accdata->{'amountoutstanding'} < $amountleft ) {
  98             $newamtos = 0;
  99             $amountleft -= $accdata->{'amountoutstanding'};
 100         }
 101         else {
 102             $newamtos   = $accdata->{'amountoutstanding'} - $amountleft;
 103             $amountleft = 0;
 104         }
 105         my $thisacct = $accdata->{accountno};
 106         my $usth     = $dbh->prepare(
 107             "UPDATE accountlines SET amountoutstanding= ?
 108      WHERE (borrowernumber = ?) AND (accountno=?)"
 109         );
 110         $usth->execute( $newamtos, $borrowernumber, $thisacct );
 111         $usth->finish;
 112 #        $usth = $dbh->prepare(
 113 #            "INSERT INTO accountoffsets
 114 #     (borrowernumber, accountno, offsetaccount,  offsetamount)
 115 #     VALUES (?,?,?,?)"
 116 #        );
 117 #        $usth->execute( $borrowernumber, $accdata->{'accountno'},
 118 #            $nextaccntno, $newamtos );
 119         $usth->finish;
 120     }
 121
 122     # create new line
 123     my $usth = $dbh->prepare(
 124         "INSERT INTO accountlines
 125   (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding)
 126   VALUES (?,?,now(),?,'Payment,thanks','Pay',?)"
 127     );
 128     $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, 0 - $amountleft );
 129     $usth->finish;
 130     UpdateStats( $branch, 'payment', $data, '', '', '', $borrowernumber, $nextaccntno );
 131     $sth->finish;
 132 }
 133
 134 =head2 makepayment
 135
 136   &makepayment($borrowernumber, $acctnumber, $amount, $branchcode);
 137
 138 Records the fact that a patron has paid off the entire amount he or
 139 she owes.
 140
 141 C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is
 142 the account that was credited. C<$amount> is the amount paid (this is
 143 only used to record the payment. It is assumed to be equal to the
 144 amount owed). C<$branchcode> is the code of the branch where payment
 145 was made.
 146
 147 =cut
 148
 149 #'
 150 # FIXME - I'm not at all sure about the above, because I don't
 151 # understand what the acct* tables in the Koha database are for.
 152 sub makepayment {
 153
 154     #here we update both the accountoffsets and the account lines
 155     #updated to check, if they are paying off a lost item, we return the item
 156     # from their card, and put a note on the item record
 157     my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_;
 158     my $dbh = C4::Context->dbh;
 159
 160     # begin transaction
 161     my $nextaccntno = getnextacctno($borrowernumber);
 162     my $newamtos    = 0;
 163     my $sth =
 164       $dbh->prepare(
 165         "SELECT * FROM accountlines WHERE  borrowernumber=? AND accountno=?");
 166     $sth->execute( $borrowernumber, $accountno );
 167     my $data = $sth->fetchrow_hashref;
 168     $sth->finish;
 169
 170     $dbh->do(
 171         "UPDATE  accountlines
 172         SET     amountoutstanding = 0
 173         WHERE   borrowernumber = $borrowernumber
 174           AND   accountno = $accountno
 175         "
 176     );
 177
 178     #  print $updquery;
 179 #    $dbh->do( "
 180 #        INSERT INTO     accountoffsets
 181 #                        (borrowernumber, accountno, offsetaccount,
 182 #                         offsetamount)
 183 #        VALUES          ($borrowernumber, $accountno, $nextaccntno, $newamtos)
 184 #        " );
 185
 186     # create new line
 187     my $payment = 0 - $amount;
 188     $dbh->do( "
 189         INSERT INTO     accountlines
 190                         (borrowernumber, accountno, date, amount,
 191                          description, accounttype, amountoutstanding)
 192         VALUES          ($borrowernumber, $nextaccntno, now(), $payment,
 193                         'Payment,thanks - $user', 'Pay', 0)
 194         " );
 195
 196     # FIXME - The second argument to &UpdateStats is supposed to be the
 197     # branch code.
 198     # UpdateStats is now being passed $accountno too. MTJ
 199     UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber,
 200         $accountno );
 201     $sth->finish;
 202
 203     #check to see what accounttype
 204     if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
 205         returnlost( $borrowernumber, $data->{'itemnumber'} );
 206     }
 207 }
 208
 209 =head2 getnextacctno
 210
 211   $nextacct = &getnextacctno($borrowernumber);
 212
 213 Returns the next unused account number for the patron with the given
 214 borrower number.
 215
 216 =cut
 217
 218 #'
 219 # FIXME - Okay, so what does the above actually _mean_?
 220 sub getnextacctno ($) {
 221     my ($borrowernumber) = shift or return undef;
 222     my $sth = C4::Context->dbh->prepare(
 223         "SELECT accountno+1 FROM accountlines
 224          WHERE    (borrowernumber = ?)
 225          ORDER BY accountno DESC
 226                  LIMIT 1"
 227     );
 228     $sth->execute($borrowernumber);
 229     return ($sth->fetchrow || 1);
 230 }
 231
 232 =head2 fixaccounts (removed)
 233
 234   &fixaccounts($borrowernumber, $accountnumber, $amount);
 235
 236 #'
 237 # FIXME - I don't understand what this function does.
 238 sub fixaccounts {
 239     my ( $borrowernumber, $accountno, $amount ) = @_;
 240     my $dbh = C4::Context->dbh;
 241     my $sth = $dbh->prepare(
 242         "SELECT * FROM accountlines WHERE borrowernumber=?
 243      AND accountno=?"
 244     );
 245     $sth->execute( $borrowernumber, $accountno );
 246     my $data = $sth->fetchrow_hashref;
 247
 248     # FIXME - Error-checking
 249     my $diff        = $amount - $data->{'amount'};
 250     my $outstanding = $data->{'amountoutstanding'} + $diff;
 251     $sth->finish;
 252
 253     $dbh->do(<<EOT);
 254         UPDATE  accountlines
 255         SET     amount = '$amount',
 256                 amountoutstanding = '$outstanding'
 257         WHERE   borrowernumber = $borrowernumber
 258           AND   accountno = $accountno
 259 EOT
 260         # FIXME: exceedingly bad form.  Use prepare with placholders ("?") in query and execute args.
 261 }
 262
 263 =cut
 264
 265 sub returnlost {
 266     my ( $borrowernumber, $itemnum ) = @_;
 267     C4::Circulation::MarkIssueReturned( $borrowernumber, $itemnum );
 268     my $borrower = C4::Members::GetMember( $borrowernumber, 'borrowernumber' );
 269     my @datearr = localtime(time);
 270     my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
 271     my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
 272     ModItem({ paidfor =>  "Paid for by $bor $date" }, undef, $itemnum);
 273 }
 274
 275 =head2 manualinvoice
 276
 277   &manualinvoice($borrowernumber, $itemnumber, $description, $type,
 278                  $amount, $user);
 279
 280 C<$borrowernumber> is the patron's borrower number.
 281 C<$description> is a description of the transaction.
 282 C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
 283 or C<REF>.
 284 C<$itemnumber> is the item involved, if pertinent; otherwise, it
 285 should be the empty string.
 286
 287 =cut
 288
 289 #'
 290 # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
 291 # are :
 292 #               'C' = CREDIT
 293 #               'FOR' = FORGIVEN  (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
 294 #               'N' = New Card fee
 295 #               'F' = Fine
 296 #               'A' = Account Management fee
 297 #               'M' = Sundry
 298 #               'L' = Lost Item
 299 #
 300
 301 sub manualinvoice {
 302     my ( $borrowernumber, $itemnum, $desc, $type, $amount, $user ) = @_;
 303     my $dbh      = C4::Context->dbh;
 304     my $notifyid = 0;
 305     my $insert;
 306     $itemnum =~ s/ //g;
 307     my $accountno  = getnextacctno($borrowernumber);
 308     my $amountleft = $amount;
 309
 310 #    if (   $type eq 'CS'
 311 #        || $type eq 'CB'
 312 #        || $type eq 'CW'
 313 #        || $type eq 'CF'
 314 #        || $type eq 'CL' )
 315 #    {
 316 #        my $amount2 = $amount * -1;    # FIXME - $amount2 = -$amount
 317 #        $amountleft =
 318 #          fixcredit( $borrowernumber, $amount2, $itemnum, $type, $user );
 319 #    }
 320     if ( $type eq 'N' ) {
 321         $desc .= " New Card";
 322     }
 323     if ( $type eq 'F' ) {
 324         $desc .= " Fine";
 325     }
 326     if ( $type eq 'A' ) {
 327         $desc .= " Account Management fee";
 328     }
 329     if ( $type eq 'M' ) {
 330         $desc .= " Sundry";
 331     }
 332
 333     if ( $type eq 'L' && $desc eq '' ) {
 334
 335         $desc = " Lost Item";
 336     }
 337 #    if ( $type eq 'REF' ) {
 338 #        $desc .= " Cash Refund";
 339 #        $amountleft = refund( '', $borrowernumber, $amount );
 340 #    }
 341     if (   ( $type eq 'L' )
 342         or ( $type eq 'F' )
 343         or ( $type eq 'A' )
 344         or ( $type eq 'N' )
 345         or ( $type eq 'M' ) )
 346     {
 347         $notifyid = 1;
 348     }
 349
 350     if ( $itemnum ne '' ) {
 351         $desc .= " " . $itemnum;
 352         my $sth = $dbh->prepare(
 353             "INSERT INTO  accountlines
 354                         (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id)
 355         VALUES (?, ?, now(), ?,?, ?,?,?,?)");
 356      $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid) || return $sth->errstr;
 357   } else {
 358     my $sth=$dbh->prepare("INSERT INTO  accountlines
 359             (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id)
 360             VALUES (?, ?, now(), ?, ?, ?, ?,?)"
 361         );
 362         $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
 363             $amountleft, $notifyid );
 364     }
 365     return 0;
 366 }
 367
 368 =head2 fixcredit #### DEPRECATED
 369
 370  $amountleft = &fixcredit($borrowernumber, $data, $barcode, $type, $user);
 371
 372  This function is only used internally, not exported.
 373
 374 =cut
 375
 376 # This function is deprecated in 3.0
 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 : DEPRECATED SUB
 481  This subroutine tracks payments and/or credits against fines/charges
 482    using the accountoffsets table, which is not used consistently in
 483    Koha's fines management, and so is not used in 3.0
 484
 485 =cut
 486
 487 sub refund {
 488
 489     #here we update both the accountoffsets and the account lines
 490     my ( $borrowernumber, $data ) = @_;
 491     my $dbh        = C4::Context->dbh;
 492     my $newamtos   = 0;
 493     my $accdata    = "";
 494     my $amountleft = $data * -1;
 495
 496     # begin transaction
 497     my $nextaccntno = getnextacctno($borrowernumber);
 498
 499     # get lines with outstanding amounts to offset
 500     my $sth = $dbh->prepare(
 501         "SELECT * FROM accountlines
 502   WHERE (borrowernumber = ?) AND (amountoutstanding<0)
 503   ORDER BY date"
 504     );
 505     $sth->execute($borrowernumber);
 506
 507     #  print $amountleft;
 508     # offset transactions
 509     while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft < 0 ) ) {
 510         if ( $accdata->{'amountoutstanding'} > $amountleft ) {
 511             $newamtos = 0;
 512             $amountleft -= $accdata->{'amountoutstanding'};
 513         }
 514         else {
 515             $newamtos   = $accdata->{'amountoutstanding'} - $amountleft;
 516             $amountleft = 0;
 517         }
 518
 519         #     print $amountleft;
 520         my $thisacct = $accdata->{accountno};
 521         my $usth     = $dbh->prepare(
 522             "UPDATE accountlines SET amountoutstanding= ?
 523      WHERE (borrowernumber = ?) AND (accountno=?)"
 524         );
 525         $usth->execute( $newamtos, $borrowernumber, $thisacct );
 526         $usth->finish;
 527         $usth = $dbh->prepare(
 528             "INSERT INTO accountoffsets
 529      (borrowernumber, accountno, offsetaccount,  offsetamount)
 530      VALUES (?,?,?,?)"
 531         );
 532         $usth->execute( $borrowernumber, $accdata->{'accountno'},
 533             $nextaccntno, $newamtos );
 534         $usth->finish;
 535     }
 536     $sth->finish;
 537     return ($amountleft);
 538 }
 539
 540 sub getcharges {
 541         my ( $borrowerno, $timestamp, $accountno ) = @_;
 542         my $dbh        = C4::Context->dbh;
 543         my $timestamp2 = $timestamp - 1;
 544         my $query      = "";
 545         my $sth = $dbh->prepare(
 546                         "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
 547           );
 548         $sth->execute( $borrowerno, $accountno );
 549
 550     my @results;
 551     while ( my $data = $sth->fetchrow_hashref ) {
 552                 push @results,$data;
 553         }
 554     return (@results);
 555 }
 556
 557
 558 sub getcredits {
 559         my ( $date, $date2 ) = @_;
 560         my $dbh = C4::Context->dbh;
 561         my $sth = $dbh->prepare(
 562                                 "SELECT * FROM accountlines,borrowers
 563       WHERE amount < 0 AND accounttype <> 'Pay' AND accountlines.borrowernumber = borrowers.borrowernumber
 564           AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
 565       );
 566
 567     $sth->execute( $date, $date2 );
 568     my @results;
 569     while ( my $data = $sth->fetchrow_hashref ) {
 570                 $data->{'date'} = $data->{'timestamp'};
 571                 push @results,$data;
 572         }
 573     return (@results);
 574 }
 575
 576
 577 sub getrefunds {
 578         my ( $date, $date2 ) = @_;
 579         my $dbh = C4::Context->dbh;
 580
 581         my $sth = $dbh->prepare(
 582                                 "SELECT *,timestamp AS datetime
 583                   FROM accountlines,borrowers
 584                   WHERE (accounttype = 'REF'
 585                                           AND accountlines.borrowernumber = borrowers.borrowernumber
 586                                                           AND date  >=?  AND date  <?)"
 587     );
 588
 589     $sth->execute( $date, $date2 );
 590
 591     my @results;
 592     while ( my $data = $sth->fetchrow_hashref ) {
 593                 push @results,$data;
 594
 595         }
 596     return (@results);
 597 }
 598 END { }    # module clean-up code here (global destructor)
 599
 600 1;
 601 __END__
 602
 603 =head1 SEE ALSO
 604
 605 DBI(3)
 606
 607 =cut
 608