|
Lines 26-31
use Date::Manip qw/UnixDate/;
Link Here
|
| 26 |
use List::MoreUtils qw( uniq ); |
26 |
use List::MoreUtils qw( uniq ); |
| 27 |
use POSIX qw( floor ceil ); |
27 |
use POSIX qw( floor ceil ); |
| 28 |
use Locale::Currency::Format 1.28; |
28 |
use Locale::Currency::Format 1.28; |
|
|
29 |
use Carp; |
| 29 |
|
30 |
|
| 30 |
use C4::Circulation; |
31 |
use C4::Circulation; |
| 31 |
use C4::Context; |
32 |
use C4::Context; |
|
Lines 34-39
use C4::Log; # logaction
Link Here
|
| 34 |
use C4::Debug; |
35 |
use C4::Debug; |
| 35 |
use C4::Budgets qw(GetCurrency); |
36 |
use C4::Budgets qw(GetCurrency); |
| 36 |
use Koha::DateUtils; |
37 |
use Koha::DateUtils; |
|
|
38 |
use Koha::Account::Line; |
| 39 |
use Koha::Account::Lines; |
| 37 |
|
40 |
|
| 38 |
use vars qw($VERSION @ISA @EXPORT); |
41 |
use vars qw($VERSION @ISA @EXPORT); |
| 39 |
|
42 |
|
|
Lines 471-477
sub GetIssuesIteminfo {
Link Here
|
| 471 |
|
474 |
|
| 472 |
=head2 UpdateFine |
475 |
=head2 UpdateFine |
| 473 |
|
476 |
|
| 474 |
&UpdateFine($itemnumber, $borrowernumber, $amount, $type, $description); |
477 |
&UpdateFine({ issue_id => $issue_id, itemnumber => $itemnumber, borrwernumber => $borrowernumber, amount => $amount, type => $type, $due => $date_due }); |
| 475 |
|
478 |
|
| 476 |
(Note: the following is mostly conjecture and guesswork.) |
479 |
(Note: the following is mostly conjecture and guesswork.) |
| 477 |
|
480 |
|
|
Lines 486-493
C<$amount> is the current amount owed by the patron.
Link Here
|
| 486 |
|
489 |
|
| 487 |
C<$type> will be used in the description of the fine. |
490 |
C<$type> will be used in the description of the fine. |
| 488 |
|
491 |
|
| 489 |
C<$description> is a string that must be present in the description of |
492 |
C<$due> is the due date formatted to the currently specified date format |
| 490 |
the fine. I think this is expected to be a date in DD/MM/YYYY format. |
|
|
| 491 |
|
493 |
|
| 492 |
C<&UpdateFine> looks up the amount currently owed on the given item |
494 |
C<&UpdateFine> looks up the amount currently owed on the given item |
| 493 |
and sets it to C<$amount>, creating, if necessary, a new entry in the |
495 |
and sets it to C<$amount>, creating, if necessary, a new entry in the |
|
Lines 504-511
accountlines table of the Koha database.
Link Here
|
| 504 |
# Possible Answer: You might update a fine for a damaged item, *after* it is returned. |
506 |
# Possible Answer: You might update a fine for a damaged item, *after* it is returned. |
| 505 |
# |
507 |
# |
| 506 |
sub UpdateFine { |
508 |
sub UpdateFine { |
| 507 |
my ( $itemnum, $borrowernumber, $amount, $type, $due ) = @_; |
509 |
my ($params) = @_; |
| 508 |
$debug and warn "UpdateFine($itemnum, $borrowernumber, $amount, " . ($type||'""') . ", $due) called"; |
510 |
|
|
|
511 |
my $issue_id = $params->{issue_id}; |
| 512 |
my $itemnum = $params->{itemnumber}; |
| 513 |
my $borrowernumber = $params->{borrowernumber}; |
| 514 |
my $amount = $params->{amount}; |
| 515 |
my $type = $params->{type}; |
| 516 |
my $due = $params->{due}; |
| 517 |
|
| 518 |
$debug and warn "UpdateFine({ itemnumber => $itemnum, borrowernumber => $borrowernumber, type => $type, due => $due, issue_id => $issue_id})"; |
| 519 |
|
| 520 |
unless ( $issue_id ) { |
| 521 |
carp("No issue_id passed in!"); |
| 522 |
return; |
| 523 |
} |
| 524 |
|
| 509 |
my $dbh = C4::Context->dbh; |
525 |
my $dbh = C4::Context->dbh; |
| 510 |
# FIXME - What exactly is this query supposed to do? It looks up an |
526 |
# FIXME - What exactly is this query supposed to do? It looks up an |
| 511 |
# entry in accountlines that matches the given item and borrower |
527 |
# entry in accountlines that matches the given item and borrower |
|
Lines 536-545
sub UpdateFine {
Link Here
|
| 536 |
# - accumulate fines for other items |
552 |
# - accumulate fines for other items |
| 537 |
# so we can update $itemnum fine taking in account fine caps |
553 |
# so we can update $itemnum fine taking in account fine caps |
| 538 |
while (my $rec = $sth->fetchrow_hashref) { |
554 |
while (my $rec = $sth->fetchrow_hashref) { |
| 539 |
if ($rec->{itemnumber} == $itemnum && $rec->{description} =~ /$due_qr/) { |
555 |
if ( $rec->{issue_id} == $issue_id ) { |
| 540 |
if ($data) { |
556 |
if ($data) { |
| 541 |
warn "Not a unique accountlines record for item $itemnum borrower $borrowernumber"; |
557 |
warn "Not a unique accountlines record for issue_id $issue_id"; |
| 542 |
} else { |
558 |
} |
|
|
559 |
else { |
| 543 |
$data = $rec; |
560 |
$data = $rec; |
| 544 |
next; |
561 |
next; |
| 545 |
} |
562 |
} |
|
Lines 557-591
sub UpdateFine {
Link Here
|
| 557 |
} |
574 |
} |
| 558 |
|
575 |
|
| 559 |
if ( $data ) { |
576 |
if ( $data ) { |
| 560 |
|
577 |
# we're updating an existing fine. Only modify if amount changed |
| 561 |
# we're updating an existing fine. Only modify if amount changed |
|
|
| 562 |
# Note that in the current implementation, you cannot pay against an accruing fine |
578 |
# Note that in the current implementation, you cannot pay against an accruing fine |
| 563 |
# (i.e. , of accounttype 'FU'). Doing so will break accrual. |
579 |
# (i.e. , of accounttype 'FU'). Doing so will break accrual. |
| 564 |
if ( $data->{'amount'} != $amount ) { |
580 |
if ( $data->{'amount'} != $amount ) { |
|
|
581 |
my $accountline = Koha::Account::Lines->find( $data->{accountlines_id} ); |
| 565 |
my $diff = $amount - $data->{'amount'}; |
582 |
my $diff = $amount - $data->{'amount'}; |
| 566 |
#3341: diff could be positive or negative! |
583 |
|
| 567 |
my $out = $data->{'amountoutstanding'} + $diff; |
584 |
#3341: diff could be positive or negative! |
| 568 |
my $query = " |
585 |
my $out = $data->{'amountoutstanding'} + $diff; |
| 569 |
UPDATE accountlines |
586 |
|
| 570 |
SET date=now(), amount=?, amountoutstanding=?, |
587 |
$accountline->set( |
| 571 |
lastincrement=?, accounttype='FU' |
588 |
{ |
| 572 |
WHERE borrowernumber=? |
589 |
date => dt_from_string(), |
| 573 |
AND itemnumber=? |
590 |
amount => $amount, |
| 574 |
AND accounttype IN ('FU','O') |
591 |
outstanding => $out, |
| 575 |
AND description LIKE ? |
592 |
lastincrement => $diff, |
| 576 |
LIMIT 1 "; |
593 |
accounttype => 'FU', |
| 577 |
my $sth2 = $dbh->prepare($query); |
594 |
} |
| 578 |
# FIXME: BOGUS query cannot ensure uniqueness w/ LIKE %x% !!! |
595 |
)->store(); |
| 579 |
# LIMIT 1 added to prevent multiple affected lines |
596 |
|
| 580 |
# FIXME: accountlines table needs unique key!! Possibly a combo of borrowernumber and accountline. |
597 |
# FIXME: BOGUS query cannot ensure uniqueness w/ LIKE %x% !!! |
| 581 |
# But actually, we should just have a regular autoincrementing PK and forget accountline, |
598 |
# LIMIT 1 added to prevent multiple affected lines |
| 582 |
# including the bogus getnextaccountno function (doesn't prevent conflict on simultaneous ops). |
599 |
# FIXME: accountlines table needs unique key!! Possibly a combo of borrowernumber and accountline. |
| 583 |
# FIXME: Why only 2 account types here? |
600 |
# But actually, we should just have a regular autoincrementing PK and forget accountline, |
| 584 |
$debug and print STDERR "UpdateFine query: $query\n" . |
601 |
# including the bogus getnextaccountno function (doesn't prevent conflict on simultaneous ops). |
| 585 |
"w/ args: $amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, \"\%$due\%\"\n"; |
602 |
# FIXME: Why only 2 account types here? |
| 586 |
$sth2->execute($amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, "%$due%"); |
|
|
| 587 |
} else { |
| 588 |
# print "no update needed $data->{'amount'}" |
| 589 |
} |
603 |
} |
| 590 |
} else { |
604 |
} else { |
| 591 |
if ( $amount ) { # Don't add new fines with an amount of 0 |
605 |
if ( $amount ) { # Don't add new fines with an amount of 0 |
|
Lines 599-610
sub UpdateFine {
Link Here
|
| 599 |
|
613 |
|
| 600 |
my $desc = ( $type ? "$type " : '' ) . "$title $due"; # FIXEDME, avoid whitespace prefix on empty $type |
614 |
my $desc = ( $type ? "$type " : '' ) . "$title $due"; # FIXEDME, avoid whitespace prefix on empty $type |
| 601 |
|
615 |
|
| 602 |
my $query = "INSERT INTO accountlines |
616 |
my $accountline = Koha::Account::Line->new( |
| 603 |
(borrowernumber,itemnumber,date,amount,description,accounttype,amountoutstanding,lastincrement,accountno) |
617 |
{ |
| 604 |
VALUES (?,?,now(),?,?,'FU',?,?,?)"; |
618 |
borrowernumber => $borrowernumber, |
| 605 |
my $sth2 = $dbh->prepare($query); |
619 |
itemnumber => $itemnum, |
| 606 |
$debug and print STDERR "UpdateFine query: $query\nw/ args: $borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno\n"; |
620 |
date => dt_from_string(), |
| 607 |
$sth2->execute( $borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno ); |
621 |
amount => $amount, |
|
|
622 |
description => $desc, |
| 623 |
accounttype => 'FU', |
| 624 |
amountoutstanding => $amount, |
| 625 |
lastincrement => $amount, |
| 626 |
accountno => $nextaccntno, |
| 627 |
} |
| 628 |
)->store(); |
| 608 |
} |
629 |
} |
| 609 |
} |
630 |
} |
| 610 |
# logging action |
631 |
# logging action |