| File: | C4/Accounts.pm |
| Coverage: | 7.6% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 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 | |||||
| 17 | # with Koha; if not, write to the Free Software Foundation, Inc., | |||||
| 18 | # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | |||||
| 19 | ||||||
| 20 | ||||||
| 21 | 14 14 14 | 506 114 548 | use strict; | |||
| 22 | #use warnings; FIXME - Bug 2505 | |||||
| 23 | 14 14 14 | 151 123 277 | use C4::Context; | |||
| 24 | 14 14 14 | 301 79 1561 | use C4::Stats; | |||
| 25 | 14 14 14 | 203 120 956 | use C4::Members; | |||
| 26 | 14 14 14 | 143 66 995 | use C4::Circulation qw(ReturnLostItem); | |||
| 27 | ||||||
| 28 | 14 14 14 | 104 51 1793 | use vars qw($VERSION @ISA @EXPORT); | |||
| 29 | ||||||
| 30 | BEGIN { | |||||
| 31 | # set the version for version checking | |||||
| 32 | 14 | 103 | $VERSION = 3.03; | |||
| 33 | 14 | 165 | require Exporter; | |||
| 34 | 14 | 209 | @ISA = qw(Exporter); | |||
| 35 | 14 | 49532 | @EXPORT = qw( | |||
| 36 | &recordpayment | |||||
| 37 | &makepayment | |||||
| 38 | &manualinvoice | |||||
| 39 | &getnextacctno | |||||
| 40 | &reconcileaccount | |||||
| 41 | &getcharges | |||||
| 42 | &ModNote | |||||
| 43 | &getcredits | |||||
| 44 | &getrefunds | |||||
| 45 | &chargelostitem | |||||
| 46 | &ReversePayment | |||||
| 47 | &makepartialpayment | |||||
| 48 | &recordpayment_selectaccts | |||||
| 49 | &WriteOffFee | |||||
| 50 | ); | |||||
| 51 | } | |||||
| 52 | ||||||
| 53 - 82 | =head1 NAME C4::Accounts - Functions for dealing with Koha accounts =head1 SYNOPSIS use C4::Accounts; =head1 DESCRIPTION The functions in this module deal with the monetary aspect of Koha, including looking up and modifying the amount of money owed by a patron. =head1 FUNCTIONS =head2 recordpayment &recordpayment($borrowernumber, $payment); Record payment by a patron. C<$borrowernumber> is the patron's borrower number. C<$payment> is a floating-point number, giving the amount that was paid. Amounts owed are paid off oldest first. That is, if the patron has a $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment of $1.50, then the oldest fine will be paid off in full, and $0.50 will be credited to the next one. =cut | |||||
| 83 | ||||||
| 84 | #' | |||||
| 85 | sub recordpayment { | |||||
| 86 | ||||||
| 87 | #here we update the account lines | |||||
| 88 | 0 | my ( $borrowernumber, $data ) = @_; | ||||
| 89 | 0 | my $dbh = C4::Context->dbh; | ||||
| 90 | 0 | my $newamtos = 0; | ||||
| 91 | 0 | my $accdata = ""; | ||||
| 92 | 0 | my $branch = C4::Context->userenv->{'branch'}; | ||||
| 93 | 0 | my $amountleft = $data; | ||||
| 94 | ||||||
| 95 | # begin transaction | |||||
| 96 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
| 97 | ||||||
| 98 | # get lines with outstanding amounts to offset | |||||
| 99 | 0 | my $sth = $dbh->prepare( | ||||
| 100 | "SELECT * FROM accountlines | |||||
| 101 | WHERE (borrowernumber = ?) AND (amountoutstanding<>0) | |||||
| 102 | ORDER BY date" | |||||
| 103 | ); | |||||
| 104 | 0 | $sth->execute($borrowernumber); | ||||
| 105 | ||||||
| 106 | # offset transactions | |||||
| 107 | 0 | while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) { | ||||
| 108 | 0 | if ( $accdata->{'amountoutstanding'} < $amountleft ) { | ||||
| 109 | 0 | $newamtos = 0; | ||||
| 110 | 0 | $amountleft -= $accdata->{'amountoutstanding'}; | ||||
| 111 | } | |||||
| 112 | else { | |||||
| 113 | 0 | $newamtos = $accdata->{'amountoutstanding'} - $amountleft; | ||||
| 114 | 0 | $amountleft = 0; | ||||
| 115 | } | |||||
| 116 | 0 | my $thisacct = $accdata->{accountno}; | ||||
| 117 | 0 | my $usth = $dbh->prepare( | ||||
| 118 | "UPDATE accountlines SET amountoutstanding= ? | |||||
| 119 | WHERE (borrowernumber = ?) AND (accountno=?)" | |||||
| 120 | ); | |||||
| 121 | 0 | $usth->execute( $newamtos, $borrowernumber, $thisacct ); | ||||
| 122 | 0 | $usth->finish; | ||||
| 123 | # $usth = $dbh->prepare( | |||||
| 124 | # "INSERT INTO accountoffsets | |||||
| 125 | # (borrowernumber, accountno, offsetaccount, offsetamount) | |||||
| 126 | # VALUES (?,?,?,?)" | |||||
| 127 | # ); | |||||
| 128 | # $usth->execute( $borrowernumber, $accdata->{'accountno'}, | |||||
| 129 | # $nextaccntno, $newamtos ); | |||||
| 130 | 0 | $usth->finish; | ||||
| 131 | } | |||||
| 132 | ||||||
| 133 | # create new line | |||||
| 134 | 0 | my $usth = $dbh->prepare( | ||||
| 135 | "INSERT INTO accountlines | |||||
| 136 | (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding) | |||||
| 137 | VALUES (?,?,now(),?,'Payment,thanks','Pay',?)" | |||||
| 138 | ); | |||||
| 139 | 0 | $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, 0 - $amountleft ); | ||||
| 140 | 0 | $usth->finish; | ||||
| 141 | 0 | UpdateStats( $branch, 'payment', $data, '', '', '', $borrowernumber, $nextaccntno ); | ||||
| 142 | 0 | $sth->finish; | ||||
| 143 | } | |||||
| 144 | ||||||
| 145 - 158 | =head2 makepayment &makepayment($borrowernumber, $acctnumber, $amount, $branchcode); Records the fact that a patron has paid off the entire amount he or she owes. C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is the account that was credited. C<$amount> is the amount paid (this is only used to record the payment. It is assumed to be equal to the amount owed). C<$branchcode> is the code of the branch where payment was made. =cut | |||||
| 159 | ||||||
| 160 | #' | |||||
| 161 | # FIXME - I'm not at all sure about the above, because I don't | |||||
| 162 | # understand what the acct* tables in the Koha database are for. | |||||
| 163 | sub makepayment { | |||||
| 164 | ||||||
| 165 | #here we update both the accountoffsets and the account lines | |||||
| 166 | #updated to check, if they are paying off a lost item, we return the item | |||||
| 167 | # from their card, and put a note on the item record | |||||
| 168 | 0 | my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_; | ||||
| 169 | 0 | my $dbh = C4::Context->dbh; | ||||
| 170 | 0 | my $manager_id = 0; | ||||
| 171 | 0 | $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; | ||||
| 172 | ||||||
| 173 | # begin transaction | |||||
| 174 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
| 175 | 0 | my $newamtos = 0; | ||||
| 176 | 0 | my $sth = | ||||
| 177 | $dbh->prepare( | |||||
| 178 | "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno=?"); | |||||
| 179 | 0 | $sth->execute( $borrowernumber, $accountno ); | ||||
| 180 | 0 | my $data = $sth->fetchrow_hashref; | ||||
| 181 | 0 | $sth->finish; | ||||
| 182 | ||||||
| 183 | 0 | if($data->{'accounttype'} eq "Pay"){ | ||||
| 184 | 0 | my $udp = | ||||
| 185 | $dbh->prepare( | |||||
| 186 | "UPDATE accountlines | |||||
| 187 | SET amountoutstanding = 0, description = 'Payment,thanks' | |||||
| 188 | WHERE borrowernumber = ? | |||||
| 189 | AND accountno = ? | |||||
| 190 | " | |||||
| 191 | ); | |||||
| 192 | 0 | $udp->execute($borrowernumber, $accountno ); | ||||
| 193 | 0 | $udp->finish; | ||||
| 194 | }else{ | |||||
| 195 | 0 | my $udp = | ||||
| 196 | $dbh->prepare( | |||||
| 197 | "UPDATE accountlines | |||||
| 198 | SET amountoutstanding = 0 | |||||
| 199 | WHERE borrowernumber = ? | |||||
| 200 | AND accountno = ? | |||||
| 201 | " | |||||
| 202 | ); | |||||
| 203 | 0 | $udp->execute($borrowernumber, $accountno ); | ||||
| 204 | 0 | $udp->finish; | ||||
| 205 | ||||||
| 206 | # create new line | |||||
| 207 | 0 | my $payment = 0 - $amount; | ||||
| 208 | ||||||
| 209 | 0 | my $ins = | ||||
| 210 | $dbh->prepare( | |||||
| 211 | "INSERT | |||||
| 212 | INTO accountlines (borrowernumber, accountno, date, amount, itemnumber, description, accounttype, amountoutstanding, manager_id) | |||||
| 213 | VALUES ( ?, ?, now(), ?, ?, 'Payment,thanks', 'Pay', 0, ?)" | |||||
| 214 | ); | |||||
| 215 | 0 | $ins->execute($borrowernumber, $nextaccntno, $payment, $data->{'itemnumber'}, $manager_id); | ||||
| 216 | 0 | $ins->finish; | ||||
| 217 | } | |||||
| 218 | ||||||
| 219 | # FIXME - The second argument to &UpdateStats is supposed to be the | |||||
| 220 | # branch code. | |||||
| 221 | # UpdateStats is now being passed $accountno too. MTJ | |||||
| 222 | 0 | UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber, | ||||
| 223 | $accountno ); | |||||
| 224 | #from perldoc: for SELECT only #$sth->finish; | |||||
| 225 | ||||||
| 226 | #check to see what accounttype | |||||
| 227 | 0 | if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) { | ||||
| 228 | 0 | C4::Circulation::ReturnLostItem( $borrowernumber, $data->{'itemnumber'} ); | ||||
| 229 | } | |||||
| 230 | } | |||||
| 231 | ||||||
| 232 - 239 | =head2 getnextacctno $nextacct = &getnextacctno($borrowernumber); Returns the next unused account number for the patron with the given borrower number. =cut | |||||
| 240 | ||||||
| 241 | #' | |||||
| 242 | # FIXME - Okay, so what does the above actually _mean_? | |||||
| 243 | sub getnextacctno ($) { | |||||
| 244 | 0 | my ($borrowernumber) = shift or return undef; | ||||
| 245 | 0 | my $sth = C4::Context->dbh->prepare( | ||||
| 246 | "SELECT accountno+1 FROM accountlines | |||||
| 247 | WHERE (borrowernumber = ?) | |||||
| 248 | ORDER BY accountno DESC | |||||
| 249 | LIMIT 1" | |||||
| 250 | ); | |||||
| 251 | 0 | $sth->execute($borrowernumber); | ||||
| 252 | 0 | return ($sth->fetchrow || 1); | ||||
| 253 | } | |||||
| 254 | ||||||
| 255 - 286 | =head2 fixaccounts (removed)
&fixaccounts($borrowernumber, $accountnumber, $amount);
#'
# FIXME - I don't understand what this function does.
sub fixaccounts {
my ( $borrowernumber, $accountno, $amount ) = @_;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare(
"SELECT * FROM accountlines WHERE borrowernumber=?
AND accountno=?"
);
$sth->execute( $borrowernumber, $accountno );
my $data = $sth->fetchrow_hashref;
# FIXME - Error-checking
my $diff = $amount - $data->{'amount'};
my $outstanding = $data->{'amountoutstanding'} + $diff;
$sth->finish;
$dbh->do(<<EOT);
UPDATE accountlines
SET amount = '$amount',
amountoutstanding = '$outstanding'
WHERE borrowernumber = $borrowernumber
AND accountno = $accountno
EOT
# FIXME: exceedingly bad form. Use prepare with placholders ("?") in query and execute args.
}
=cut | |||||
| 287 | ||||||
| 288 | sub chargelostitem{ | |||||
| 289 | # lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for | |||||
| 290 | # FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that | |||||
| 291 | # a charge has been added | |||||
| 292 | # FIXME : if no replacement price, borrower just doesn't get charged? | |||||
| 293 | 0 | my $dbh = C4::Context->dbh(); | ||||
| 294 | 0 | my ($borrowernumber, $itemnumber, $amount, $description) = @_; | ||||
| 295 | ||||||
| 296 | # first make sure the borrower hasn't already been charged for this item | |||||
| 297 | 0 | my $sth1=$dbh->prepare("SELECT * from accountlines | ||||
| 298 | WHERE borrowernumber=? AND itemnumber=? and accounttype='L'"); | |||||
| 299 | 0 | $sth1->execute($borrowernumber,$itemnumber); | ||||
| 300 | 0 | my $existing_charge_hashref=$sth1->fetchrow_hashref(); | ||||
| 301 | ||||||
| 302 | # OK, they haven't | |||||
| 303 | 0 | unless ($existing_charge_hashref) { | ||||
| 304 | # This item is on issue ... add replacement cost to the borrower's record and mark it returned | |||||
| 305 | # Note that we add this to the account even if there's no replacement price, allowing some other | |||||
| 306 | # process (or person) to update it, since we don't handle any defaults for replacement prices. | |||||
| 307 | 0 | my $accountno = getnextacctno($borrowernumber); | ||||
| 308 | 0 | my $sth2=$dbh->prepare("INSERT INTO accountlines | ||||
| 309 | (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber) | |||||
| 310 | VALUES (?,?,now(),?,?,'L',?,?)"); | |||||
| 311 | 0 | $sth2->execute($borrowernumber,$accountno,$amount, | ||||
| 312 | $description,$amount,$itemnumber); | |||||
| 313 | 0 | $sth2->finish; | ||||
| 314 | # FIXME: Log this ? | |||||
| 315 | } | |||||
| 316 | } | |||||
| 317 | ||||||
| 318 - 330 | =head2 manualinvoice
&manualinvoice($borrowernumber, $itemnumber, $description, $type,
$amount, $note);
C<$borrowernumber> is the patron's borrower number.
C<$description> is a description of the transaction.
C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
or C<REF>.
C<$itemnumber> is the item involved, if pertinent; otherwise, it
should be the empty string.
=cut | |||||
| 331 | ||||||
| 332 | #' | |||||
| 333 | # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function | |||||
| 334 | # are : | |||||
| 335 | # 'C' = CREDIT | |||||
| 336 | # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere) | |||||
| 337 | # 'N' = New Card fee | |||||
| 338 | # 'F' = Fine | |||||
| 339 | # 'A' = Account Management fee | |||||
| 340 | # 'M' = Sundry | |||||
| 341 | # 'L' = Lost Item | |||||
| 342 | # | |||||
| 343 | ||||||
| 344 | sub manualinvoice { | |||||
| 345 | 0 | my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_; | ||||
| 346 | 0 | my $manager_id = 0; | ||||
| 347 | 0 | $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; | ||||
| 348 | 0 | my $dbh = C4::Context->dbh; | ||||
| 349 | 0 | my $notifyid = 0; | ||||
| 350 | 0 | my $insert; | ||||
| 351 | 0 | my $accountno = getnextacctno($borrowernumber); | ||||
| 352 | 0 | my $amountleft = $amount; | ||||
| 353 | ||||||
| 354 | # if ( $type eq 'CS' | |||||
| 355 | # || $type eq 'CB' | |||||
| 356 | # || $type eq 'CW' | |||||
| 357 | # || $type eq 'CF' | |||||
| 358 | # || $type eq 'CL' ) | |||||
| 359 | # { | |||||
| 360 | # my $amount2 = $amount * -1; # FIXME - $amount2 = -$amount | |||||
| 361 | # $amountleft = | |||||
| 362 | # fixcredit( $borrowernumber, $amount2, $itemnum, $type, $user ); | |||||
| 363 | # } | |||||
| 364 | 0 | if ( $type eq 'N' ) { | ||||
| 365 | 0 | $desc .= " New Card"; | ||||
| 366 | } | |||||
| 367 | 0 | if ( $type eq 'F' ) { | ||||
| 368 | 0 | $desc .= " Fine"; | ||||
| 369 | } | |||||
| 370 | 0 | if ( $type eq 'A' ) { | ||||
| 371 | 0 | $desc .= " Account Management fee"; | ||||
| 372 | } | |||||
| 373 | 0 | if ( $type eq 'M' ) { | ||||
| 374 | 0 | $desc .= " Sundry"; | ||||
| 375 | } | |||||
| 376 | ||||||
| 377 | 0 | if ( $type eq 'L' && $desc eq '' ) { | ||||
| 378 | ||||||
| 379 | 0 | $desc = " Lost Item"; | ||||
| 380 | } | |||||
| 381 | # if ( $type eq 'REF' ) { | |||||
| 382 | # $desc .= " Cash Refund"; | |||||
| 383 | # $amountleft = refund( '', $borrowernumber, $amount ); | |||||
| 384 | # } | |||||
| 385 | 0 | if ( ( $type eq 'L' ) | ||||
| 386 | or ( $type eq 'F' ) | |||||
| 387 | or ( $type eq 'A' ) | |||||
| 388 | or ( $type eq 'N' ) | |||||
| 389 | or ( $type eq 'M' ) ) | |||||
| 390 | { | |||||
| 391 | 0 | $notifyid = 1; | ||||
| 392 | } | |||||
| 393 | ||||||
| 394 | 0 | if ( $itemnum ) { | ||||
| 395 | 0 | $desc .= ' ' . $itemnum; | ||||
| 396 | 0 | my $sth = $dbh->prepare( | ||||
| 397 | 'INSERT INTO accountlines | |||||
| 398 | (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id) | |||||
| 399 | VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)'); | |||||
| 400 | 0 | $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr; | ||||
| 401 | } else { | |||||
| 402 | 0 | my $sth=$dbh->prepare("INSERT INTO accountlines | ||||
| 403 | (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id) | |||||
| 404 | VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)" | |||||
| 405 | ); | |||||
| 406 | 0 | $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type, | ||||
| 407 | $amountleft, $notifyid, $note, $manager_id ); | |||||
| 408 | } | |||||
| 409 | 0 | return 0; | ||||
| 410 | } | |||||
| 411 | ||||||
| 412 - 418 | =head2 fixcredit #### DEPRECATED $amountleft = &fixcredit($borrowernumber, $data, $barcode, $type, $user); This function is only used internally, not exported. =cut | |||||
| 419 | ||||||
| 420 | # This function is deprecated in 3.0 | |||||
| 421 | ||||||
| 422 | sub fixcredit { | |||||
| 423 | ||||||
| 424 | #here we update both the accountoffsets and the account lines | |||||
| 425 | 0 | my ( $borrowernumber, $data, $barcode, $type, $user ) = @_; | ||||
| 426 | 0 | my $dbh = C4::Context->dbh; | ||||
| 427 | 0 | my $newamtos = 0; | ||||
| 428 | 0 | my $accdata = ""; | ||||
| 429 | 0 | my $amountleft = $data; | ||||
| 430 | 0 | if ( $barcode ne '' ) { | ||||
| 431 | 0 | my $item = GetBiblioFromItemNumber( '', $barcode ); | ||||
| 432 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
| 433 | 0 | my $query = "SELECT * FROM accountlines WHERE (borrowernumber=? | ||||
| 434 | AND itemnumber=? AND amountoutstanding > 0)"; | |||||
| 435 | 0 | if ( $type eq 'CL' ) { | ||||
| 436 | 0 | $query .= " AND (accounttype = 'L' OR accounttype = 'Rep')"; | ||||
| 437 | } | |||||
| 438 | elsif ( $type eq 'CF' ) { | |||||
| 439 | 0 | $query .= " AND (accounttype = 'F' OR accounttype = 'FU' OR | ||||
| 440 | accounttype='Res' OR accounttype='Rent')"; | |||||
| 441 | } | |||||
| 442 | elsif ( $type eq 'CB' ) { | |||||
| 443 | 0 | $query .= " and accounttype='A'"; | ||||
| 444 | } | |||||
| 445 | ||||||
| 446 | # print $query; | |||||
| 447 | 0 | my $sth = $dbh->prepare($query); | ||||
| 448 | 0 | $sth->execute( $borrowernumber, $item->{'itemnumber'} ); | ||||
| 449 | 0 | $accdata = $sth->fetchrow_hashref; | ||||
| 450 | 0 | $sth->finish; | ||||
| 451 | 0 | if ( $accdata->{'amountoutstanding'} < $amountleft ) { | ||||
| 452 | 0 | $newamtos = 0; | ||||
| 453 | 0 | $amountleft -= $accdata->{'amountoutstanding'}; | ||||
| 454 | } | |||||
| 455 | else { | |||||
| 456 | 0 | $newamtos = $accdata->{'amountoutstanding'} - $amountleft; | ||||
| 457 | 0 | $amountleft = 0; | ||||
| 458 | } | |||||
| 459 | 0 | my $thisacct = $accdata->{accountno}; | ||||
| 460 | 0 | my $usth = $dbh->prepare( | ||||
| 461 | "UPDATE accountlines SET amountoutstanding= ? | |||||
| 462 | WHERE (borrowernumber = ?) AND (accountno=?)" | |||||
| 463 | ); | |||||
| 464 | 0 | $usth->execute( $newamtos, $borrowernumber, $thisacct ); | ||||
| 465 | 0 | $usth->finish; | ||||
| 466 | 0 | $usth = $dbh->prepare( | ||||
| 467 | "INSERT INTO accountoffsets | |||||
| 468 | (borrowernumber, accountno, offsetaccount, offsetamount) | |||||
| 469 | VALUES (?,?,?,?)" | |||||
| 470 | ); | |||||
| 471 | 0 | $usth->execute( $borrowernumber, $accdata->{'accountno'}, | ||||
| 472 | $nextaccntno, $newamtos ); | |||||
| 473 | 0 | $usth->finish; | ||||
| 474 | } | |||||
| 475 | ||||||
| 476 | # begin transaction | |||||
| 477 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
| 478 | ||||||
| 479 | # get lines with outstanding amounts to offset | |||||
| 480 | 0 | my $sth = $dbh->prepare( | ||||
| 481 | "SELECT * FROM accountlines | |||||
| 482 | WHERE (borrowernumber = ?) AND (amountoutstanding >0) | |||||
| 483 | ORDER BY date" | |||||
| 484 | ); | |||||
| 485 | 0 | $sth->execute($borrowernumber); | ||||
| 486 | ||||||
| 487 | # print $query; | |||||
| 488 | # offset transactions | |||||
| 489 | 0 | while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) { | ||||
| 490 | 0 | if ( $accdata->{'amountoutstanding'} < $amountleft ) { | ||||
| 491 | 0 | $newamtos = 0; | ||||
| 492 | 0 | $amountleft -= $accdata->{'amountoutstanding'}; | ||||
| 493 | } | |||||
| 494 | else { | |||||
| 495 | 0 | $newamtos = $accdata->{'amountoutstanding'} - $amountleft; | ||||
| 496 | 0 | $amountleft = 0; | ||||
| 497 | } | |||||
| 498 | 0 | my $thisacct = $accdata->{accountno}; | ||||
| 499 | 0 | my $usth = $dbh->prepare( | ||||
| 500 | "UPDATE accountlines SET amountoutstanding= ? | |||||
| 501 | WHERE (borrowernumber = ?) AND (accountno=?)" | |||||
| 502 | ); | |||||
| 503 | 0 | $usth->execute( $newamtos, $borrowernumber, $thisacct ); | ||||
| 504 | 0 | $usth->finish; | ||||
| 505 | 0 | $usth = $dbh->prepare( | ||||
| 506 | "INSERT INTO accountoffsets | |||||
| 507 | (borrowernumber, accountno, offsetaccount, offsetamount) | |||||
| 508 | VALUE (?,?,?,?)" | |||||
| 509 | ); | |||||
| 510 | 0 | $usth->execute( $borrowernumber, $accdata->{'accountno'}, | ||||
| 511 | $nextaccntno, $newamtos ); | |||||
| 512 | 0 | $usth->finish; | ||||
| 513 | } | |||||
| 514 | 0 | $sth->finish; | ||||
| 515 | 0 | $type = "Credit " . $type; | ||||
| 516 | 0 | UpdateStats( $user, $type, $data, $user, '', '', $borrowernumber ); | ||||
| 517 | 0 | $amountleft *= -1; | ||||
| 518 | 0 | return ($amountleft); | ||||
| 519 | ||||||
| 520 | } | |||||
| 521 | ||||||
| 522 - 529 | =head2 refund #FIXME : DEPRECATED SUB This subroutine tracks payments and/or credits against fines/charges using the accountoffsets table, which is not used consistently in Koha's fines management, and so is not used in 3.0 =cut | |||||
| 530 | ||||||
| 531 | sub refund { | |||||
| 532 | ||||||
| 533 | #here we update both the accountoffsets and the account lines | |||||
| 534 | 0 | my ( $borrowernumber, $data ) = @_; | ||||
| 535 | 0 | my $dbh = C4::Context->dbh; | ||||
| 536 | 0 | my $newamtos = 0; | ||||
| 537 | 0 | my $accdata = ""; | ||||
| 538 | 0 | my $amountleft = $data * -1; | ||||
| 539 | ||||||
| 540 | # begin transaction | |||||
| 541 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
| 542 | ||||||
| 543 | # get lines with outstanding amounts to offset | |||||
| 544 | 0 | my $sth = $dbh->prepare( | ||||
| 545 | "SELECT * FROM accountlines | |||||
| 546 | WHERE (borrowernumber = ?) AND (amountoutstanding<0) | |||||
| 547 | ORDER BY date" | |||||
| 548 | ); | |||||
| 549 | 0 | $sth->execute($borrowernumber); | ||||
| 550 | ||||||
| 551 | # print $amountleft; | |||||
| 552 | # offset transactions | |||||
| 553 | 0 | while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft < 0 ) ) { | ||||
| 554 | 0 | if ( $accdata->{'amountoutstanding'} > $amountleft ) { | ||||
| 555 | 0 | $newamtos = 0; | ||||
| 556 | 0 | $amountleft -= $accdata->{'amountoutstanding'}; | ||||
| 557 | } | |||||
| 558 | else { | |||||
| 559 | 0 | $newamtos = $accdata->{'amountoutstanding'} - $amountleft; | ||||
| 560 | 0 | $amountleft = 0; | ||||
| 561 | } | |||||
| 562 | ||||||
| 563 | # print $amountleft; | |||||
| 564 | 0 | my $thisacct = $accdata->{accountno}; | ||||
| 565 | 0 | my $usth = $dbh->prepare( | ||||
| 566 | "UPDATE accountlines SET amountoutstanding= ? | |||||
| 567 | WHERE (borrowernumber = ?) AND (accountno=?)" | |||||
| 568 | ); | |||||
| 569 | 0 | $usth->execute( $newamtos, $borrowernumber, $thisacct ); | ||||
| 570 | 0 | $usth->finish; | ||||
| 571 | 0 | $usth = $dbh->prepare( | ||||
| 572 | "INSERT INTO accountoffsets | |||||
| 573 | (borrowernumber, accountno, offsetaccount, offsetamount) | |||||
| 574 | VALUES (?,?,?,?)" | |||||
| 575 | ); | |||||
| 576 | 0 | $usth->execute( $borrowernumber, $accdata->{'accountno'}, | ||||
| 577 | $nextaccntno, $newamtos ); | |||||
| 578 | 0 | $usth->finish; | ||||
| 579 | } | |||||
| 580 | 0 | $sth->finish; | ||||
| 581 | 0 | return ($amountleft); | ||||
| 582 | } | |||||
| 583 | ||||||
| 584 | sub getcharges { | |||||
| 585 | 0 | my ( $borrowerno, $timestamp, $accountno ) = @_; | ||||
| 586 | 0 | my $dbh = C4::Context->dbh; | ||||
| 587 | 0 | my $timestamp2 = $timestamp - 1; | ||||
| 588 | 0 | my $query = ""; | ||||
| 589 | 0 | my $sth = $dbh->prepare( | ||||
| 590 | "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?" | |||||
| 591 | ); | |||||
| 592 | 0 | $sth->execute( $borrowerno, $accountno ); | ||||
| 593 | ||||||
| 594 | 0 | my @results; | ||||
| 595 | 0 | while ( my $data = $sth->fetchrow_hashref ) { | ||||
| 596 | 0 | push @results,$data; | ||||
| 597 | } | |||||
| 598 | 0 | return (@results); | ||||
| 599 | } | |||||
| 600 | ||||||
| 601 | sub ModNote { | |||||
| 602 | 0 | my ( $borrowernumber, $accountno, $note ) = @_; | ||||
| 603 | 0 | my $dbh = C4::Context->dbh; | ||||
| 604 | 0 | my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE borrowernumber = ? AND accountno = ?'); | ||||
| 605 | 0 | $sth->execute( $note, $borrowernumber, $accountno ); | ||||
| 606 | } | |||||
| 607 | ||||||
| 608 | sub getcredits { | |||||
| 609 | 0 | my ( $date, $date2 ) = @_; | ||||
| 610 | 0 | my $dbh = C4::Context->dbh; | ||||
| 611 | 0 | my $sth = $dbh->prepare( | ||||
| 612 | "SELECT * FROM accountlines,borrowers | |||||
| 613 | WHERE amount < 0 AND accounttype <> 'Pay' AND accountlines.borrowernumber = borrowers.borrowernumber | |||||
| 614 | AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)" | |||||
| 615 | ); | |||||
| 616 | ||||||
| 617 | 0 | $sth->execute( $date, $date2 ); | ||||
| 618 | 0 | my @results; | ||||
| 619 | 0 | while ( my $data = $sth->fetchrow_hashref ) { | ||||
| 620 | 0 | $data->{'date'} = $data->{'timestamp'}; | ||||
| 621 | 0 | push @results,$data; | ||||
| 622 | } | |||||
| 623 | 0 | return (@results); | ||||
| 624 | } | |||||
| 625 | ||||||
| 626 | ||||||
| 627 | sub getrefunds { | |||||
| 628 | 0 | my ( $date, $date2 ) = @_; | ||||
| 629 | 0 | my $dbh = C4::Context->dbh; | ||||
| 630 | ||||||
| 631 | 0 | my $sth = $dbh->prepare( | ||||
| 632 | "SELECT *,timestamp AS datetime | |||||
| 633 | FROM accountlines,borrowers | |||||
| 634 | WHERE (accounttype = 'REF' | |||||
| 635 | AND accountlines.borrowernumber = borrowers.borrowernumber | |||||
| 636 | AND date >=? AND date <?)" | |||||
| 637 | ); | |||||
| 638 | ||||||
| 639 | 0 | $sth->execute( $date, $date2 ); | ||||
| 640 | ||||||
| 641 | 0 | my @results; | ||||
| 642 | 0 | while ( my $data = $sth->fetchrow_hashref ) { | ||||
| 643 | 0 | push @results,$data; | ||||
| 644 | ||||||
| 645 | } | |||||
| 646 | 0 | return (@results); | ||||
| 647 | } | |||||
| 648 | ||||||
| 649 | sub ReversePayment { | |||||
| 650 | 0 | my ( $borrowernumber, $accountno ) = @_; | ||||
| 651 | 0 | my $dbh = C4::Context->dbh; | ||||
| 652 | ||||||
| 653 | 0 | my $sth = $dbh->prepare('SELECT amountoutstanding FROM accountlines WHERE borrowernumber = ? AND accountno = ?'); | ||||
| 654 | 0 | $sth->execute( $borrowernumber, $accountno ); | ||||
| 655 | 0 | my $row = $sth->fetchrow_hashref(); | ||||
| 656 | 0 | my $amount_outstanding = $row->{'amountoutstanding'}; | ||||
| 657 | ||||||
| 658 | 0 | if ( $amount_outstanding <= 0 ) { | ||||
| 659 | 0 | $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?'); | ||||
| 660 | 0 | $sth->execute( $borrowernumber, $accountno ); | ||||
| 661 | } else { | |||||
| 662 | 0 | $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?'); | ||||
| 663 | 0 | $sth->execute( $borrowernumber, $accountno ); | ||||
| 664 | } | |||||
| 665 | } | |||||
| 666 | ||||||
| 667 - 681 | =head2 recordpayment_selectaccts recordpayment_selectaccts($borrowernumber, $payment,$accts); Record payment by a patron. C<$borrowernumber> is the patron's borrower number. C<$payment> is a floating-point number, giving the amount that was paid. C<$accts> is an array ref to a list of accountnos which the payment can be recorded against Amounts owed are paid off oldest first. That is, if the patron has a $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment of $1.50, then the oldest fine will be paid off in full, and $0.50 will be credited to the next one. =cut | |||||
| 682 | ||||||
| 683 | sub recordpayment_selectaccts { | |||||
| 684 | 0 | my ( $borrowernumber, $amount, $accts ) = @_; | ||||
| 685 | ||||||
| 686 | 0 | my $dbh = C4::Context->dbh; | ||||
| 687 | 0 | my $newamtos = 0; | ||||
| 688 | 0 | my $accdata = q{}; | ||||
| 689 | 0 | my $branch = C4::Context->userenv->{branch}; | ||||
| 690 | 0 | my $amountleft = $amount; | ||||
| 691 | 0 | my $sql = 'SELECT * FROM accountlines WHERE (borrowernumber = ?) ' . | ||||
| 692 | 'AND (amountoutstanding<>0) '; | |||||
| 693 | 0 0 | if (@{$accts} ) { | ||||
| 694 | 0 0 | $sql .= ' AND accountno IN ( ' . join ',', @{$accts}; | ||||
| 695 | 0 | $sql .= ' ) '; | ||||
| 696 | } | |||||
| 697 | 0 | $sql .= ' ORDER BY date'; | ||||
| 698 | # begin transaction | |||||
| 699 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
| 700 | ||||||
| 701 | # get lines with outstanding amounts to offset | |||||
| 702 | 0 | my $rows = $dbh->selectall_arrayref($sql, { Slice => {} }, $borrowernumber); | ||||
| 703 | ||||||
| 704 | # offset transactions | |||||
| 705 | 0 | my $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding= ? ' . | ||||
| 706 | 'WHERE (borrowernumber = ?) AND (accountno=?)'); | |||||
| 707 | 0 0 | for my $accdata ( @{$rows} ) { | ||||
| 708 | 0 | if ($amountleft == 0) { | ||||
| 709 | 0 | last; | ||||
| 710 | } | |||||
| 711 | 0 | if ( $accdata->{amountoutstanding} < $amountleft ) { | ||||
| 712 | 0 | $newamtos = 0; | ||||
| 713 | 0 | $amountleft -= $accdata->{amountoutstanding}; | ||||
| 714 | } | |||||
| 715 | else { | |||||
| 716 | 0 | $newamtos = $accdata->{amountoutstanding} - $amountleft; | ||||
| 717 | 0 | $amountleft = 0; | ||||
| 718 | } | |||||
| 719 | 0 | my $thisacct = $accdata->{accountno}; | ||||
| 720 | 0 | $sth->execute( $newamtos, $borrowernumber, $thisacct ); | ||||
| 721 | } | |||||
| 722 | ||||||
| 723 | # create new line | |||||
| 724 | 0 | $sql = 'INSERT INTO accountlines ' . | ||||
| 725 | '(borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding) ' . | |||||
| 726 | q|VALUES (?,?,now(),?,'Payment,thanks','Pay',?)|; | |||||
| 727 | 0 | $dbh->do($sql,{},$borrowernumber, $nextaccntno, 0 - $amount, 0 - $amountleft ); | ||||
| 728 | 0 | UpdateStats( $branch, 'payment', $amount, '', '', '', $borrowernumber, $nextaccntno ); | ||||
| 729 | 0 | return; | ||||
| 730 | } | |||||
| 731 | ||||||
| 732 | # makepayment needs to be fixed to handle partials till then this separate subroutine | |||||
| 733 | # fills in | |||||
| 734 | sub makepartialpayment { | |||||
| 735 | 0 | my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_; | ||||
| 736 | 0 | my $manager_id = 0; | ||||
| 737 | 0 | $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; | ||||
| 738 | 0 | if (!$amount || $amount < 0) { | ||||
| 739 | 0 | return; | ||||
| 740 | } | |||||
| 741 | 0 | my $dbh = C4::Context->dbh; | ||||
| 742 | ||||||
| 743 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
| 744 | 0 | my $newamtos = 0; | ||||
| 745 | ||||||
| 746 | 0 | my $data = $dbh->selectrow_hashref( | ||||
| 747 | 'SELECT * FROM accountlines WHERE borrowernumber=? AND accountno=?',undef,$borrowernumber,$accountno); | |||||
| 748 | 0 | my $new_outstanding = $data->{amountoutstanding} - $amount; | ||||
| 749 | ||||||
| 750 | 0 | my $update = 'UPDATE accountlines SET amountoutstanding = ? WHERE borrowernumber = ? ' | ||||
| 751 | . ' AND accountno = ?'; | |||||
| 752 | 0 | $dbh->do( $update, undef, $new_outstanding, $borrowernumber, $accountno); | ||||
| 753 | ||||||
| 754 | # create new line | |||||
| 755 | 0 | my $insert = 'INSERT INTO accountlines (borrowernumber, accountno, date, amount, ' | ||||
| 756 | . 'description, accounttype, amountoutstanding, itemnumber, manager_id) ' | |||||
| 757 | . ' VALUES (?, ?, now(), ?, ?, ?, 0, ?, ?)'; | |||||
| 758 | ||||||
| 759 | 0 | $dbh->do( $insert, undef, $borrowernumber, $nextaccntno, $amount, | ||||
| 760 | "Payment, thanks - $user", 'Pay', $data->{'itemnumber'}, $manager_id); | |||||
| 761 | ||||||
| 762 | 0 | UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber, $accountno ); | ||||
| 763 | ||||||
| 764 | 0 | return; | ||||
| 765 | } | |||||
| 766 | ||||||
| 767 - 779 | =head2 WriteOff WriteOff( $borrowernumber, $accountnum, $itemnum, $accounttype, $amount, $branch ); Write off a fine for a patron. C<$borrowernumber> is the patron's borrower number. C<$accountnum> is the accountnumber of the fee to write off. C<$itemnum> is the itemnumber of of item whose fine is being written off. C<$accounttype> is the account type of the fine being written off. C<$amount> is a floating-point number, giving the amount that is being written off. C<$branch> is the branchcode of the library where the writeoff occurred. =cut | |||||
| 780 | ||||||
| 781 | sub WriteOffFee { | |||||
| 782 | 0 | my ( $borrowernumber, $accountnum, $itemnum, $accounttype, $amount, $branch ) = @_; | ||||
| 783 | 0 | $branch ||= C4::Context->userenv->{branch}; | ||||
| 784 | 0 | my $manager_id = 0; | ||||
| 785 | 0 | $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; | ||||
| 786 | ||||||
| 787 | # if no item is attached to fine, make sure to store it as a NULL | |||||
| 788 | 0 | $itemnum ||= undef; | ||||
| 789 | ||||||
| 790 | 0 | my ( $sth, $query ); | ||||
| 791 | 0 | my $dbh = C4::Context->dbh(); | ||||
| 792 | ||||||
| 793 | 0 | $query = " | ||||
| 794 | UPDATE accountlines SET amountoutstanding = 0 | |||||
| 795 | WHERE accountno = ? AND borrowernumber = ? | |||||
| 796 | "; | |||||
| 797 | 0 | $sth = $dbh->prepare( $query ); | ||||
| 798 | 0 | $sth->execute( $accountnum, $borrowernumber ); | ||||
| 799 | ||||||
| 800 | 0 | $query =" | ||||
| 801 | INSERT INTO accountlines | |||||
| 802 | ( borrowernumber, accountno, itemnumber, date, amount, description, accounttype, manager_id ) | |||||
| 803 | VALUES ( ?, ?, ?, NOW(), ?, 'Writeoff', 'W', ? ) | |||||
| 804 | "; | |||||
| 805 | 0 | $sth = $dbh->prepare( $query ); | ||||
| 806 | 0 | my $acct = getnextacctno($borrowernumber); | ||||
| 807 | 0 | $sth->execute( $borrowernumber, $acct, $itemnum, $amount, $manager_id ); | ||||
| 808 | ||||||
| 809 | 0 | UpdateStats( $branch, 'writeoff', $amount, q{}, q{}, q{}, $borrowernumber ); | ||||
| 810 | ||||||
| 811 | } | |||||
| 812 | ||||||
| 813 | 14 | 1234 | END { } # module clean-up code here (global destructor) | |||
| 814 | ||||||
| 815 | 1; | |||||