| File: | C4/Accounts.pm |
| Coverage: | 8.1% |
| 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 | 13 13 13 | 2468 126 446 | use strict; | |||
| 22 | #use warnings; FIXME - Bug 2505 | |||||
| 23 | 13 13 13 | 159 78 193 | use C4::Context; | |||
| 24 | 13 13 13 | 286 57 2481 | use C4::Stats; | |||
| 25 | 13 13 13 | 245 114 1139 | use C4::Members; | |||
| 26 | 13 13 13 | 150 149 716 | use C4::Circulation qw(ReturnLostItem); | |||
| 27 | ||||||
| 28 | 13 13 13 | 138 96 1627 | use vars qw($VERSION @ISA @EXPORT); | |||
| 29 | ||||||
| 30 | BEGIN { | |||||
| 31 | # set the version for version checking | |||||
| 32 | 13 | 88 | $VERSION = 3.03; | |||
| 33 | 13 | 97 | require Exporter; | |||
| 34 | 13 | 250 | @ISA = qw(Exporter); | |||
| 35 | 13 | 45342 | @EXPORT = qw( | |||
| 36 | &recordpayment &makepayment &manualinvoice | |||||
| 37 | &getnextacctno &reconcileaccount &getcharges &ModNote &getcredits | |||||
| 38 | &getrefunds &chargelostitem | |||||
| 39 | &ReversePayment | |||||
| 40 | makepartialpayment | |||||
| 41 | recordpayment_selectaccts | |||||
| 42 | ); | |||||
| 43 | } | |||||
| 44 | ||||||
| 45 - 74 | =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 | |||||
| 75 | ||||||
| 76 | #' | |||||
| 77 | sub recordpayment { | |||||
| 78 | ||||||
| 79 | #here we update the account lines | |||||
| 80 | 0 | my ( $borrowernumber, $data ) = @_; | ||||
| 81 | 0 | my $dbh = C4::Context->dbh; | ||||
| 82 | 0 | my $newamtos = 0; | ||||
| 83 | 0 | my $accdata = ""; | ||||
| 84 | 0 | my $branch = C4::Context->userenv->{'branch'}; | ||||
| 85 | 0 | my $amountleft = $data; | ||||
| 86 | ||||||
| 87 | # begin transaction | |||||
| 88 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
| 89 | ||||||
| 90 | # get lines with outstanding amounts to offset | |||||
| 91 | 0 | my $sth = $dbh->prepare( | ||||
| 92 | "SELECT * FROM accountlines | |||||
| 93 | WHERE (borrowernumber = ?) AND (amountoutstanding<>0) | |||||
| 94 | ORDER BY date" | |||||
| 95 | ); | |||||
| 96 | 0 | $sth->execute($borrowernumber); | ||||
| 97 | ||||||
| 98 | # offset transactions | |||||
| 99 | 0 | while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) { | ||||
| 100 | 0 | if ( $accdata->{'amountoutstanding'} < $amountleft ) { | ||||
| 101 | 0 | $newamtos = 0; | ||||
| 102 | 0 | $amountleft -= $accdata->{'amountoutstanding'}; | ||||
| 103 | } | |||||
| 104 | else { | |||||
| 105 | 0 | $newamtos = $accdata->{'amountoutstanding'} - $amountleft; | ||||
| 106 | 0 | $amountleft = 0; | ||||
| 107 | } | |||||
| 108 | 0 | my $thisacct = $accdata->{accountno}; | ||||
| 109 | 0 | my $usth = $dbh->prepare( | ||||
| 110 | "UPDATE accountlines SET amountoutstanding= ? | |||||
| 111 | WHERE (borrowernumber = ?) AND (accountno=?)" | |||||
| 112 | ); | |||||
| 113 | 0 | $usth->execute( $newamtos, $borrowernumber, $thisacct ); | ||||
| 114 | 0 | $usth->finish; | ||||
| 115 | # $usth = $dbh->prepare( | |||||
| 116 | # "INSERT INTO accountoffsets | |||||
| 117 | # (borrowernumber, accountno, offsetaccount, offsetamount) | |||||
| 118 | # VALUES (?,?,?,?)" | |||||
| 119 | # ); | |||||
| 120 | # $usth->execute( $borrowernumber, $accdata->{'accountno'}, | |||||
| 121 | # $nextaccntno, $newamtos ); | |||||
| 122 | 0 | $usth->finish; | ||||
| 123 | } | |||||
| 124 | ||||||
| 125 | # create new line | |||||
| 126 | 0 | my $usth = $dbh->prepare( | ||||
| 127 | "INSERT INTO accountlines | |||||
| 128 | (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding) | |||||
| 129 | VALUES (?,?,now(),?,'Payment,thanks','Pay',?)" | |||||
| 130 | ); | |||||
| 131 | 0 | $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, 0 - $amountleft ); | ||||
| 132 | 0 | $usth->finish; | ||||
| 133 | 0 | UpdateStats( $branch, 'payment', $data, '', '', '', $borrowernumber, $nextaccntno ); | ||||
| 134 | 0 | $sth->finish; | ||||
| 135 | } | |||||
| 136 | ||||||
| 137 - 150 | =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 | |||||
| 151 | ||||||
| 152 | #' | |||||
| 153 | # FIXME - I'm not at all sure about the above, because I don't | |||||
| 154 | # understand what the acct* tables in the Koha database are for. | |||||
| 155 | sub makepayment { | |||||
| 156 | ||||||
| 157 | #here we update both the accountoffsets and the account lines | |||||
| 158 | #updated to check, if they are paying off a lost item, we return the item | |||||
| 159 | # from their card, and put a note on the item record | |||||
| 160 | 0 | my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_; | ||||
| 161 | 0 | my $dbh = C4::Context->dbh; | ||||
| 162 | 0 | my $manager_id = 0; | ||||
| 163 | 0 | $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; | ||||
| 164 | ||||||
| 165 | # begin transaction | |||||
| 166 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
| 167 | 0 | my $newamtos = 0; | ||||
| 168 | 0 | my $sth = | ||||
| 169 | $dbh->prepare( | |||||
| 170 | "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno=?"); | |||||
| 171 | 0 | $sth->execute( $borrowernumber, $accountno ); | ||||
| 172 | 0 | my $data = $sth->fetchrow_hashref; | ||||
| 173 | 0 | $sth->finish; | ||||
| 174 | ||||||
| 175 | 0 | if($data->{'accounttype'} eq "Pay"){ | ||||
| 176 | 0 | my $udp = | ||||
| 177 | $dbh->prepare( | |||||
| 178 | "UPDATE accountlines | |||||
| 179 | SET amountoutstanding = 0, description = 'Payment,thanks' | |||||
| 180 | WHERE borrowernumber = ? | |||||
| 181 | AND accountno = ? | |||||
| 182 | " | |||||
| 183 | ); | |||||
| 184 | 0 | $udp->execute($borrowernumber, $accountno ); | ||||
| 185 | 0 | $udp->finish; | ||||
| 186 | }else{ | |||||
| 187 | 0 | my $udp = | ||||
| 188 | $dbh->prepare( | |||||
| 189 | "UPDATE accountlines | |||||
| 190 | SET amountoutstanding = 0 | |||||
| 191 | WHERE borrowernumber = ? | |||||
| 192 | AND accountno = ? | |||||
| 193 | " | |||||
| 194 | ); | |||||
| 195 | 0 | $udp->execute($borrowernumber, $accountno ); | ||||
| 196 | 0 | $udp->finish; | ||||
| 197 | ||||||
| 198 | # create new line | |||||
| 199 | 0 | my $payment = 0 - $amount; | ||||
| 200 | ||||||
| 201 | 0 | my $ins = | ||||
| 202 | $dbh->prepare( | |||||
| 203 | "INSERT | |||||
| 204 | INTO accountlines (borrowernumber, accountno, date, amount, itemnumber, description, accounttype, amountoutstanding, manager_id) | |||||
| 205 | VALUES ( ?, ?, now(), ?, ?, 'Payment,thanks', 'Pay', 0, ?)" | |||||
| 206 | ); | |||||
| 207 | 0 | $ins->execute($borrowernumber, $nextaccntno, $payment, $data->{'itemnumber'}, $manager_id); | ||||
| 208 | 0 | $ins->finish; | ||||
| 209 | } | |||||
| 210 | ||||||
| 211 | # FIXME - The second argument to &UpdateStats is supposed to be the | |||||
| 212 | # branch code. | |||||
| 213 | # UpdateStats is now being passed $accountno too. MTJ | |||||
| 214 | 0 | UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber, | ||||
| 215 | $accountno ); | |||||
| 216 | #from perldoc: for SELECT only #$sth->finish; | |||||
| 217 | ||||||
| 218 | #check to see what accounttype | |||||
| 219 | 0 | if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) { | ||||
| 220 | 0 | C4::Circulation::ReturnLostItem( $borrowernumber, $data->{'itemnumber'} ); | ||||
| 221 | } | |||||
| 222 | } | |||||
| 223 | ||||||
| 224 - 231 | =head2 getnextacctno $nextacct = &getnextacctno($borrowernumber); Returns the next unused account number for the patron with the given borrower number. =cut | |||||
| 232 | ||||||
| 233 | #' | |||||
| 234 | # FIXME - Okay, so what does the above actually _mean_? | |||||
| 235 | sub getnextacctno ($) { | |||||
| 236 | 0 | my ($borrowernumber) = shift or return undef; | ||||
| 237 | 0 | my $sth = C4::Context->dbh->prepare( | ||||
| 238 | "SELECT accountno+1 FROM accountlines | |||||
| 239 | WHERE (borrowernumber = ?) | |||||
| 240 | ORDER BY accountno DESC | |||||
| 241 | LIMIT 1" | |||||
| 242 | ); | |||||
| 243 | 0 | $sth->execute($borrowernumber); | ||||
| 244 | 0 | return ($sth->fetchrow || 1); | ||||
| 245 | } | |||||
| 246 | ||||||
| 247 - 278 | =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 | |||||
| 279 | ||||||
| 280 | sub chargelostitem{ | |||||
| 281 | # lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for | |||||
| 282 | # FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that | |||||
| 283 | # a charge has been added | |||||
| 284 | # FIXME : if no replacement price, borrower just doesn't get charged? | |||||
| 285 | 0 | my $dbh = C4::Context->dbh(); | ||||
| 286 | 0 | my ($borrowernumber, $itemnumber, $amount, $description) = @_; | ||||
| 287 | ||||||
| 288 | # first make sure the borrower hasn't already been charged for this item | |||||
| 289 | 0 | my $sth1=$dbh->prepare("SELECT * from accountlines | ||||
| 290 | WHERE borrowernumber=? AND itemnumber=? and accounttype='L'"); | |||||
| 291 | 0 | $sth1->execute($borrowernumber,$itemnumber); | ||||
| 292 | 0 | my $existing_charge_hashref=$sth1->fetchrow_hashref(); | ||||
| 293 | ||||||
| 294 | # OK, they haven't | |||||
| 295 | 0 | unless ($existing_charge_hashref) { | ||||
| 296 | # This item is on issue ... add replacement cost to the borrower's record and mark it returned | |||||
| 297 | # Note that we add this to the account even if there's no replacement price, allowing some other | |||||
| 298 | # process (or person) to update it, since we don't handle any defaults for replacement prices. | |||||
| 299 | 0 | my $accountno = getnextacctno($borrowernumber); | ||||
| 300 | 0 | my $sth2=$dbh->prepare("INSERT INTO accountlines | ||||
| 301 | (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber) | |||||
| 302 | VALUES (?,?,now(),?,?,'L',?,?)"); | |||||
| 303 | 0 | $sth2->execute($borrowernumber,$accountno,$amount, | ||||
| 304 | $description,$amount,$itemnumber); | |||||
| 305 | 0 | $sth2->finish; | ||||
| 306 | # FIXME: Log this ? | |||||
| 307 | } | |||||
| 308 | } | |||||
| 309 | ||||||
| 310 - 322 | =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 | |||||
| 323 | ||||||
| 324 | #' | |||||
| 325 | # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function | |||||
| 326 | # are : | |||||
| 327 | # 'C' = CREDIT | |||||
| 328 | # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere) | |||||
| 329 | # 'N' = New Card fee | |||||
| 330 | # 'F' = Fine | |||||
| 331 | # 'A' = Account Management fee | |||||
| 332 | # 'M' = Sundry | |||||
| 333 | # 'L' = Lost Item | |||||
| 334 | # | |||||
| 335 | ||||||
| 336 | sub manualinvoice { | |||||
| 337 | 0 | my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_; | ||||
| 338 | 0 | my $manager_id = 0; | ||||
| 339 | 0 | $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; | ||||
| 340 | 0 | my $dbh = C4::Context->dbh; | ||||
| 341 | 0 | my $notifyid = 0; | ||||
| 342 | 0 | my $insert; | ||||
| 343 | 0 | my $accountno = getnextacctno($borrowernumber); | ||||
| 344 | 0 | my $amountleft = $amount; | ||||
| 345 | ||||||
| 346 | # if ( $type eq 'CS' | |||||
| 347 | # || $type eq 'CB' | |||||
| 348 | # || $type eq 'CW' | |||||
| 349 | # || $type eq 'CF' | |||||
| 350 | # || $type eq 'CL' ) | |||||
| 351 | # { | |||||
| 352 | # my $amount2 = $amount * -1; # FIXME - $amount2 = -$amount | |||||
| 353 | # $amountleft = | |||||
| 354 | # fixcredit( $borrowernumber, $amount2, $itemnum, $type, $user ); | |||||
| 355 | # } | |||||
| 356 | 0 | if ( $type eq 'N' ) { | ||||
| 357 | 0 | $desc .= " New Card"; | ||||
| 358 | } | |||||
| 359 | 0 | if ( $type eq 'F' ) { | ||||
| 360 | 0 | $desc .= " Fine"; | ||||
| 361 | } | |||||
| 362 | 0 | if ( $type eq 'A' ) { | ||||
| 363 | 0 | $desc .= " Account Management fee"; | ||||
| 364 | } | |||||
| 365 | 0 | if ( $type eq 'M' ) { | ||||
| 366 | 0 | $desc .= " Sundry"; | ||||
| 367 | } | |||||
| 368 | ||||||
| 369 | 0 | if ( $type eq 'L' && $desc eq '' ) { | ||||
| 370 | ||||||
| 371 | 0 | $desc = " Lost Item"; | ||||
| 372 | } | |||||
| 373 | # if ( $type eq 'REF' ) { | |||||
| 374 | # $desc .= " Cash Refund"; | |||||
| 375 | # $amountleft = refund( '', $borrowernumber, $amount ); | |||||
| 376 | # } | |||||
| 377 | 0 | if ( ( $type eq 'L' ) | ||||
| 378 | or ( $type eq 'F' ) | |||||
| 379 | or ( $type eq 'A' ) | |||||
| 380 | or ( $type eq 'N' ) | |||||
| 381 | or ( $type eq 'M' ) ) | |||||
| 382 | { | |||||
| 383 | 0 | $notifyid = 1; | ||||
| 384 | } | |||||
| 385 | ||||||
| 386 | 0 | if ( $itemnum ) { | ||||
| 387 | 0 | $desc .= ' ' . $itemnum; | ||||
| 388 | 0 | my $sth = $dbh->prepare( | ||||
| 389 | 'INSERT INTO accountlines | |||||
| 390 | (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id) | |||||
| 391 | VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)'); | |||||
| 392 | 0 | $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr; | ||||
| 393 | } else { | |||||
| 394 | 0 | my $sth=$dbh->prepare("INSERT INTO accountlines | ||||
| 395 | (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id) | |||||
| 396 | VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)" | |||||
| 397 | ); | |||||
| 398 | 0 | $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type, | ||||
| 399 | $amountleft, $notifyid, $note, $manager_id ); | |||||
| 400 | } | |||||
| 401 | 0 | return 0; | ||||
| 402 | } | |||||
| 403 | ||||||
| 404 - 410 | =head2 fixcredit #### DEPRECATED $amountleft = &fixcredit($borrowernumber, $data, $barcode, $type, $user); This function is only used internally, not exported. =cut | |||||
| 411 | ||||||
| 412 | # This function is deprecated in 3.0 | |||||
| 413 | ||||||
| 414 | sub fixcredit { | |||||
| 415 | ||||||
| 416 | #here we update both the accountoffsets and the account lines | |||||
| 417 | 0 | my ( $borrowernumber, $data, $barcode, $type, $user ) = @_; | ||||
| 418 | 0 | my $dbh = C4::Context->dbh; | ||||
| 419 | 0 | my $newamtos = 0; | ||||
| 420 | 0 | my $accdata = ""; | ||||
| 421 | 0 | my $amountleft = $data; | ||||
| 422 | 0 | if ( $barcode ne '' ) { | ||||
| 423 | 0 | my $item = GetBiblioFromItemNumber( '', $barcode ); | ||||
| 424 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
| 425 | 0 | my $query = "SELECT * FROM accountlines WHERE (borrowernumber=? | ||||
| 426 | AND itemnumber=? AND amountoutstanding > 0)"; | |||||
| 427 | 0 | if ( $type eq 'CL' ) { | ||||
| 428 | 0 | $query .= " AND (accounttype = 'L' OR accounttype = 'Rep')"; | ||||
| 429 | } | |||||
| 430 | elsif ( $type eq 'CF' ) { | |||||
| 431 | 0 | $query .= " AND (accounttype = 'F' OR accounttype = 'FU' OR | ||||
| 432 | accounttype='Res' OR accounttype='Rent')"; | |||||
| 433 | } | |||||
| 434 | elsif ( $type eq 'CB' ) { | |||||
| 435 | 0 | $query .= " and accounttype='A'"; | ||||
| 436 | } | |||||
| 437 | ||||||
| 438 | # print $query; | |||||
| 439 | 0 | my $sth = $dbh->prepare($query); | ||||
| 440 | 0 | $sth->execute( $borrowernumber, $item->{'itemnumber'} ); | ||||
| 441 | 0 | $accdata = $sth->fetchrow_hashref; | ||||
| 442 | 0 | $sth->finish; | ||||
| 443 | 0 | if ( $accdata->{'amountoutstanding'} < $amountleft ) { | ||||
| 444 | 0 | $newamtos = 0; | ||||
| 445 | 0 | $amountleft -= $accdata->{'amountoutstanding'}; | ||||
| 446 | } | |||||
| 447 | else { | |||||
| 448 | 0 | $newamtos = $accdata->{'amountoutstanding'} - $amountleft; | ||||
| 449 | 0 | $amountleft = 0; | ||||
| 450 | } | |||||
| 451 | 0 | my $thisacct = $accdata->{accountno}; | ||||
| 452 | 0 | my $usth = $dbh->prepare( | ||||
| 453 | "UPDATE accountlines SET amountoutstanding= ? | |||||
| 454 | WHERE (borrowernumber = ?) AND (accountno=?)" | |||||
| 455 | ); | |||||
| 456 | 0 | $usth->execute( $newamtos, $borrowernumber, $thisacct ); | ||||
| 457 | 0 | $usth->finish; | ||||
| 458 | 0 | $usth = $dbh->prepare( | ||||
| 459 | "INSERT INTO accountoffsets | |||||
| 460 | (borrowernumber, accountno, offsetaccount, offsetamount) | |||||
| 461 | VALUES (?,?,?,?)" | |||||
| 462 | ); | |||||
| 463 | 0 | $usth->execute( $borrowernumber, $accdata->{'accountno'}, | ||||
| 464 | $nextaccntno, $newamtos ); | |||||
| 465 | 0 | $usth->finish; | ||||
| 466 | } | |||||
| 467 | ||||||
| 468 | # begin transaction | |||||
| 469 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
| 470 | ||||||
| 471 | # get lines with outstanding amounts to offset | |||||
| 472 | 0 | my $sth = $dbh->prepare( | ||||
| 473 | "SELECT * FROM accountlines | |||||
| 474 | WHERE (borrowernumber = ?) AND (amountoutstanding >0) | |||||
| 475 | ORDER BY date" | |||||
| 476 | ); | |||||
| 477 | 0 | $sth->execute($borrowernumber); | ||||
| 478 | ||||||
| 479 | # print $query; | |||||
| 480 | # offset transactions | |||||
| 481 | 0 | while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) { | ||||
| 482 | 0 | if ( $accdata->{'amountoutstanding'} < $amountleft ) { | ||||
| 483 | 0 | $newamtos = 0; | ||||
| 484 | 0 | $amountleft -= $accdata->{'amountoutstanding'}; | ||||
| 485 | } | |||||
| 486 | else { | |||||
| 487 | 0 | $newamtos = $accdata->{'amountoutstanding'} - $amountleft; | ||||
| 488 | 0 | $amountleft = 0; | ||||
| 489 | } | |||||
| 490 | 0 | my $thisacct = $accdata->{accountno}; | ||||
| 491 | 0 | my $usth = $dbh->prepare( | ||||
| 492 | "UPDATE accountlines SET amountoutstanding= ? | |||||
| 493 | WHERE (borrowernumber = ?) AND (accountno=?)" | |||||
| 494 | ); | |||||
| 495 | 0 | $usth->execute( $newamtos, $borrowernumber, $thisacct ); | ||||
| 496 | 0 | $usth->finish; | ||||
| 497 | 0 | $usth = $dbh->prepare( | ||||
| 498 | "INSERT INTO accountoffsets | |||||
| 499 | (borrowernumber, accountno, offsetaccount, offsetamount) | |||||
| 500 | VALUE (?,?,?,?)" | |||||
| 501 | ); | |||||
| 502 | 0 | $usth->execute( $borrowernumber, $accdata->{'accountno'}, | ||||
| 503 | $nextaccntno, $newamtos ); | |||||
| 504 | 0 | $usth->finish; | ||||
| 505 | } | |||||
| 506 | 0 | $sth->finish; | ||||
| 507 | 0 | $type = "Credit " . $type; | ||||
| 508 | 0 | UpdateStats( $user, $type, $data, $user, '', '', $borrowernumber ); | ||||
| 509 | 0 | $amountleft *= -1; | ||||
| 510 | 0 | return ($amountleft); | ||||
| 511 | ||||||
| 512 | } | |||||
| 513 | ||||||
| 514 - 521 | =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 | |||||
| 522 | ||||||
| 523 | sub refund { | |||||
| 524 | ||||||
| 525 | #here we update both the accountoffsets and the account lines | |||||
| 526 | 0 | my ( $borrowernumber, $data ) = @_; | ||||
| 527 | 0 | my $dbh = C4::Context->dbh; | ||||
| 528 | 0 | my $newamtos = 0; | ||||
| 529 | 0 | my $accdata = ""; | ||||
| 530 | 0 | my $amountleft = $data * -1; | ||||
| 531 | ||||||
| 532 | # begin transaction | |||||
| 533 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
| 534 | ||||||
| 535 | # get lines with outstanding amounts to offset | |||||
| 536 | 0 | my $sth = $dbh->prepare( | ||||
| 537 | "SELECT * FROM accountlines | |||||
| 538 | WHERE (borrowernumber = ?) AND (amountoutstanding<0) | |||||
| 539 | ORDER BY date" | |||||
| 540 | ); | |||||
| 541 | 0 | $sth->execute($borrowernumber); | ||||
| 542 | ||||||
| 543 | # print $amountleft; | |||||
| 544 | # offset transactions | |||||
| 545 | 0 | while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft < 0 ) ) { | ||||
| 546 | 0 | if ( $accdata->{'amountoutstanding'} > $amountleft ) { | ||||
| 547 | 0 | $newamtos = 0; | ||||
| 548 | 0 | $amountleft -= $accdata->{'amountoutstanding'}; | ||||
| 549 | } | |||||
| 550 | else { | |||||
| 551 | 0 | $newamtos = $accdata->{'amountoutstanding'} - $amountleft; | ||||
| 552 | 0 | $amountleft = 0; | ||||
| 553 | } | |||||
| 554 | ||||||
| 555 | # print $amountleft; | |||||
| 556 | 0 | my $thisacct = $accdata->{accountno}; | ||||
| 557 | 0 | my $usth = $dbh->prepare( | ||||
| 558 | "UPDATE accountlines SET amountoutstanding= ? | |||||
| 559 | WHERE (borrowernumber = ?) AND (accountno=?)" | |||||
| 560 | ); | |||||
| 561 | 0 | $usth->execute( $newamtos, $borrowernumber, $thisacct ); | ||||
| 562 | 0 | $usth->finish; | ||||
| 563 | 0 | $usth = $dbh->prepare( | ||||
| 564 | "INSERT INTO accountoffsets | |||||
| 565 | (borrowernumber, accountno, offsetaccount, offsetamount) | |||||
| 566 | VALUES (?,?,?,?)" | |||||
| 567 | ); | |||||
| 568 | 0 | $usth->execute( $borrowernumber, $accdata->{'accountno'}, | ||||
| 569 | $nextaccntno, $newamtos ); | |||||
| 570 | 0 | $usth->finish; | ||||
| 571 | } | |||||
| 572 | 0 | $sth->finish; | ||||
| 573 | 0 | return ($amountleft); | ||||
| 574 | } | |||||
| 575 | ||||||
| 576 | sub getcharges { | |||||
| 577 | 0 | my ( $borrowerno, $timestamp, $accountno ) = @_; | ||||
| 578 | 0 | my $dbh = C4::Context->dbh; | ||||
| 579 | 0 | my $timestamp2 = $timestamp - 1; | ||||
| 580 | 0 | my $query = ""; | ||||
| 581 | 0 | my $sth = $dbh->prepare( | ||||
| 582 | "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?" | |||||
| 583 | ); | |||||
| 584 | 0 | $sth->execute( $borrowerno, $accountno ); | ||||
| 585 | ||||||
| 586 | 0 | my @results; | ||||
| 587 | 0 | while ( my $data = $sth->fetchrow_hashref ) { | ||||
| 588 | 0 | push @results,$data; | ||||
| 589 | } | |||||
| 590 | 0 | return (@results); | ||||
| 591 | } | |||||
| 592 | ||||||
| 593 | sub ModNote { | |||||
| 594 | 0 | my ( $borrowernumber, $accountno, $note ) = @_; | ||||
| 595 | 0 | my $dbh = C4::Context->dbh; | ||||
| 596 | 0 | my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE borrowernumber = ? AND accountno = ?'); | ||||
| 597 | 0 | $sth->execute( $note, $borrowernumber, $accountno ); | ||||
| 598 | } | |||||
| 599 | ||||||
| 600 | sub getcredits { | |||||
| 601 | 0 | my ( $date, $date2 ) = @_; | ||||
| 602 | 0 | my $dbh = C4::Context->dbh; | ||||
| 603 | 0 | my $sth = $dbh->prepare( | ||||
| 604 | "SELECT * FROM accountlines,borrowers | |||||
| 605 | WHERE amount < 0 AND accounttype <> 'Pay' AND accountlines.borrowernumber = borrowers.borrowernumber | |||||
| 606 | AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)" | |||||
| 607 | ); | |||||
| 608 | ||||||
| 609 | 0 | $sth->execute( $date, $date2 ); | ||||
| 610 | 0 | my @results; | ||||
| 611 | 0 | while ( my $data = $sth->fetchrow_hashref ) { | ||||
| 612 | 0 | $data->{'date'} = $data->{'timestamp'}; | ||||
| 613 | 0 | push @results,$data; | ||||
| 614 | } | |||||
| 615 | 0 | return (@results); | ||||
| 616 | } | |||||
| 617 | ||||||
| 618 | ||||||
| 619 | sub getrefunds { | |||||
| 620 | 0 | my ( $date, $date2 ) = @_; | ||||
| 621 | 0 | my $dbh = C4::Context->dbh; | ||||
| 622 | ||||||
| 623 | 0 | my $sth = $dbh->prepare( | ||||
| 624 | "SELECT *,timestamp AS datetime | |||||
| 625 | FROM accountlines,borrowers | |||||
| 626 | WHERE (accounttype = 'REF' | |||||
| 627 | AND accountlines.borrowernumber = borrowers.borrowernumber | |||||
| 628 | AND date >=? AND date <?)" | |||||
| 629 | ); | |||||
| 630 | ||||||
| 631 | 0 | $sth->execute( $date, $date2 ); | ||||
| 632 | ||||||
| 633 | 0 | my @results; | ||||
| 634 | 0 | while ( my $data = $sth->fetchrow_hashref ) { | ||||
| 635 | 0 | push @results,$data; | ||||
| 636 | ||||||
| 637 | } | |||||
| 638 | 0 | return (@results); | ||||
| 639 | } | |||||
| 640 | ||||||
| 641 | sub ReversePayment { | |||||
| 642 | 0 | my ( $borrowernumber, $accountno ) = @_; | ||||
| 643 | 0 | my $dbh = C4::Context->dbh; | ||||
| 644 | ||||||
| 645 | 0 | my $sth = $dbh->prepare('SELECT amountoutstanding FROM accountlines WHERE borrowernumber = ? AND accountno = ?'); | ||||
| 646 | 0 | $sth->execute( $borrowernumber, $accountno ); | ||||
| 647 | 0 | my $row = $sth->fetchrow_hashref(); | ||||
| 648 | 0 | my $amount_outstanding = $row->{'amountoutstanding'}; | ||||
| 649 | ||||||
| 650 | 0 | if ( $amount_outstanding <= 0 ) { | ||||
| 651 | 0 | $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?'); | ||||
| 652 | 0 | $sth->execute( $borrowernumber, $accountno ); | ||||
| 653 | } else { | |||||
| 654 | 0 | $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?'); | ||||
| 655 | 0 | $sth->execute( $borrowernumber, $accountno ); | ||||
| 656 | } | |||||
| 657 | } | |||||
| 658 | ||||||
| 659 - 673 | =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 | |||||
| 674 | ||||||
| 675 | sub recordpayment_selectaccts { | |||||
| 676 | 0 | my ( $borrowernumber, $amount, $accts ) = @_; | ||||
| 677 | ||||||
| 678 | 0 | my $dbh = C4::Context->dbh; | ||||
| 679 | 0 | my $newamtos = 0; | ||||
| 680 | 0 | my $accdata = q{}; | ||||
| 681 | 0 | my $branch = C4::Context->userenv->{branch}; | ||||
| 682 | 0 | my $amountleft = $amount; | ||||
| 683 | 0 | my $sql = 'SELECT * FROM accountlines WHERE (borrowernumber = ?) ' . | ||||
| 684 | 'AND (amountoutstanding<>0) '; | |||||
| 685 | 0 0 | if (@{$accts} ) { | ||||
| 686 | 0 0 | $sql .= ' AND accountno IN ( ' . join ',', @{$accts}; | ||||
| 687 | 0 | $sql .= ' ) '; | ||||
| 688 | } | |||||
| 689 | 0 | $sql .= ' ORDER BY date'; | ||||
| 690 | # begin transaction | |||||
| 691 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
| 692 | ||||||
| 693 | # get lines with outstanding amounts to offset | |||||
| 694 | 0 | my $rows = $dbh->selectall_arrayref($sql, { Slice => {} }, $borrowernumber); | ||||
| 695 | ||||||
| 696 | # offset transactions | |||||
| 697 | 0 | my $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding= ? ' . | ||||
| 698 | 'WHERE (borrowernumber = ?) AND (accountno=?)'); | |||||
| 699 | 0 0 | for my $accdata ( @{$rows} ) { | ||||
| 700 | 0 | if ($amountleft == 0) { | ||||
| 701 | 0 | last; | ||||
| 702 | } | |||||
| 703 | 0 | if ( $accdata->{amountoutstanding} < $amountleft ) { | ||||
| 704 | 0 | $newamtos = 0; | ||||
| 705 | 0 | $amountleft -= $accdata->{amountoutstanding}; | ||||
| 706 | } | |||||
| 707 | else { | |||||
| 708 | 0 | $newamtos = $accdata->{amountoutstanding} - $amountleft; | ||||
| 709 | 0 | $amountleft = 0; | ||||
| 710 | } | |||||
| 711 | 0 | my $thisacct = $accdata->{accountno}; | ||||
| 712 | 0 | $sth->execute( $newamtos, $borrowernumber, $thisacct ); | ||||
| 713 | } | |||||
| 714 | ||||||
| 715 | # create new line | |||||
| 716 | 0 | $sql = 'INSERT INTO accountlines ' . | ||||
| 717 | '(borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding) ' . | |||||
| 718 | q|VALUES (?,?,now(),?,'Payment,thanks','Pay',?)|; | |||||
| 719 | 0 | $dbh->do($sql,{},$borrowernumber, $nextaccntno, 0 - $amount, 0 - $amountleft ); | ||||
| 720 | 0 | UpdateStats( $branch, 'payment', $amount, '', '', '', $borrowernumber, $nextaccntno ); | ||||
| 721 | 0 | return; | ||||
| 722 | } | |||||
| 723 | ||||||
| 724 | # makepayment needs to be fixed to handle partials till then this separate subroutine | |||||
| 725 | # fills in | |||||
| 726 | sub makepartialpayment { | |||||
| 727 | 0 | my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_; | ||||
| 728 | 0 | my $manager_id = 0; | ||||
| 729 | 0 | $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; | ||||
| 730 | 0 | if (!$amount || $amount < 0) { | ||||
| 731 | 0 | return; | ||||
| 732 | } | |||||
| 733 | 0 | my $dbh = C4::Context->dbh; | ||||
| 734 | ||||||
| 735 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
| 736 | 0 | my $newamtos = 0; | ||||
| 737 | ||||||
| 738 | 0 | my $data = $dbh->selectrow_hashref( | ||||
| 739 | 'SELECT * FROM accountlines WHERE borrowernumber=? AND accountno=?',undef,$borrowernumber,$accountno); | |||||
| 740 | 0 | my $new_outstanding = $data->{amountoutstanding} - $amount; | ||||
| 741 | ||||||
| 742 | 0 | my $update = 'UPDATE accountlines SET amountoutstanding = ? WHERE borrowernumber = ? ' | ||||
| 743 | . ' AND accountno = ?'; | |||||
| 744 | 0 | $dbh->do( $update, undef, $new_outstanding, $borrowernumber, $accountno); | ||||
| 745 | ||||||
| 746 | # create new line | |||||
| 747 | 0 | my $insert = 'INSERT INTO accountlines (borrowernumber, accountno, date, amount, ' | ||||
| 748 | . 'description, accounttype, amountoutstanding, itemnumber, manager_id) ' | |||||
| 749 | . ' VALUES (?, ?, now(), ?, ?, ?, 0, ?, ?)'; | |||||
| 750 | ||||||
| 751 | 0 | $dbh->do( $insert, undef, $borrowernumber, $nextaccntno, $amount, | ||||
| 752 | "Payment, thanks - $user", 'Pay', $data->{'itemnumber'}, $manager_id); | |||||
| 753 | ||||||
| 754 | 0 | UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber, $accountno ); | ||||
| 755 | ||||||
| 756 | 0 | return; | ||||
| 757 | } | |||||
| 758 | ||||||
| 759 | ||||||
| 760 | ||||||
| 761 | 13 | 1412 | END { } # module clean-up code here (global destructor) | |||
| 762 | ||||||
| 763 | 1; | |||||