gitea
/
Koha-clms
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Bug 15675 - Add issue_id column to accountlines and use it for updating fines 

Right now, fines are updated based on the fine description. There are a
number of areas where this can go wrong ( date or time format changing,
title being modified, etc ). Now that issues has a unique
identifier, we should use that for selection and updating of fines.

Test Plan:
1) Apply this patch
2) Test creating and updating fines via fines.pl
   and checking in overdue items. No changes should be noted.
3) prove t/db_dependent/Circulation.t

Signed-off-by: Marc Véron <veron@veron.ch>
Signed-off-by: Mirko Tietgen <mirko@abunchofthings.net>

Signed-off-by: Brendan Gallagher brendan@bywatersolutions.com
This commit is contained in:
Kyle M Hall 2016-01-26 16:42:44 +00:00 committed by Brendan Gallagher
parent 16548d3984
commit 2398bfafc6
8 changed files with 218 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
C4/Circulation.pm
View File

@ -1935,18 +1935,32 @@ sub AddReturn {
if ( C4::Context->preference('finesMode') eq 'production' ) {
if ( $amount > 0 ) {
C4::Overdues::UpdateFine( $issue->{itemnumber},
$issue->{borrowernumber},
$amount, $type, output_pref($datedue) );
C4::Overdues::UpdateFine(
{
issue_id => $issue->{issue_id},
itemnumber => $issue->{itemnumber},
borrowernumber => $issue->{borrowernumber},
amount => $amount,
type => $type,
due => output_pref($datedue),
}
);
}
elsif ($return_date) {
# Backdated returns may have fines that shouldn't exist,
# so in this case, we need to drop those fines to 0
# Backdated returns may have fines that shouldn't exist,
# so in this case, we need to drop those fines to 0
C4::Overdues::UpdateFine( $issue->{itemnumber},
$issue->{borrowernumber},
0, $type, output_pref($datedue) );
C4::Overdues::UpdateFine(
{
issue_id => $issue->{issue_id},
itemnumber => $issue->{itemnumber},
borrowernumber => $issue->{borrowernumber},
amount => 0,
type => $type,
due => output_pref($datedue),
}
);
}
}
}

101
C4/Overdues.pm
View File

@ -26,6 +26,7 @@ use Date::Manip qw/UnixDate/;
use List::MoreUtils qw( uniq );
use POSIX qw( floor ceil );
use Locale::Currency::Format 1.28;
use Carp;
use C4::Circulation;
use C4::Context;
@ -34,6 +35,8 @@ use C4::Log; # logaction
use C4::Debug;
use C4::Budgets qw(GetCurrency);
use Koha::DateUtils;
use Koha::Account::Line;
use Koha::Account::Lines;
use vars qw($VERSION @ISA @EXPORT);
@ -471,7 +474,7 @@ sub GetIssuesIteminfo {
=head2 UpdateFine
&UpdateFine($itemnumber, $borrowernumber, $amount, $type, $description);
&UpdateFine({ issue_id => $issue_id, itemnumber => $itemnumber, borrwernumber => $borrowernumber, amount => $amount, type => $type, $due => $date_due });
(Note: the following is mostly conjecture and guesswork.)
@ -486,8 +489,7 @@ C<$amount> is the current amount owed by the patron.
C<$type> will be used in the description of the fine.
C<$description> is a string that must be present in the description of
the fine. I think this is expected to be a date in DD/MM/YYYY format.
C<$due> is the due date formatted to the currently specified date format
C<&UpdateFine> looks up the amount currently owed on the given item
and sets it to C<$amount>, creating, if necessary, a new entry in the
@ -504,8 +506,22 @@ accountlines table of the Koha database.
# Possible Answer: You might update a fine for a damaged item, *after* it is returned.
#
sub UpdateFine {
my ( $itemnum, $borrowernumber, $amount, $type, $due ) = @_;
$debug and warn "UpdateFine($itemnum, $borrowernumber, $amount, " . ($type||'""') . ", $due) called";
my ($params) = @_;
my $issue_id = $params->{issue_id};
my $itemnum = $params->{itemnumber};
my $borrowernumber = $params->{borrowernumber};
my $amount = $params->{amount};
my $type = $params->{type};
my $due = $params->{due};
$debug and warn "UpdateFine({ itemnumber => $itemnum, borrowernumber => $borrowernumber, type => $type, due => $due, issue_id => $issue_id})";
unless ( $issue_id ) {
carp("No issue_id passed in!");
return;
}
my $dbh = C4::Context->dbh;
# FIXME - What exactly is this query supposed to do? It looks up an
# entry in accountlines that matches the given item and borrower
@ -536,10 +552,11 @@ sub UpdateFine {
# - accumulate fines for other items
# so we can update $itemnum fine taking in account fine caps
while (my $rec = $sth->fetchrow_hashref) {
if ($rec->{itemnumber} == $itemnum && $rec->{description} =~ /$due_qr/) {
if ( $rec->{issue_id} == $issue_id ) {
if ($data) {
warn "Not a unique accountlines record for item $itemnum borrower $borrowernumber";
} else {
warn "Not a unique accountlines record for issue_id $issue_id";
}
else {
$data = $rec;
next;
}
@ -557,35 +574,32 @@ sub UpdateFine {
}
if ( $data ) {
# we're updating an existing fine. Only modify if amount changed
# we're updating an existing fine. Only modify if amount changed
# Note that in the current implementation, you cannot pay against an accruing fine
# (i.e. , of accounttype 'FU'). Doing so will break accrual.
if ( $data->{'amount'} != $amount ) {
if ( $data->{'amount'} != $amount ) {
my $accountline = Koha::Account::Lines->find( $data->{accountlines_id} );
my $diff = $amount - $data->{'amount'};
#3341: diff could be positive or negative!
my $out = $data->{'amountoutstanding'} + $diff;
my $query = "
UPDATE accountlines
SET date=now(), amount=?, amountoutstanding=?,
lastincrement=?, accounttype='FU'
WHERE borrowernumber=?
AND itemnumber=?
AND accounttype IN ('FU','O')
AND description LIKE ?
LIMIT 1 ";
my $sth2 = $dbh->prepare($query);
# FIXME: BOGUS query cannot ensure uniqueness w/ LIKE %x% !!!
# LIMIT 1 added to prevent multiple affected lines
# FIXME: accountlines table needs unique key!! Possibly a combo of borrowernumber and accountline.
# But actually, we should just have a regular autoincrementing PK and forget accountline,
# including the bogus getnextaccountno function (doesn't prevent conflict on simultaneous ops).
# FIXME: Why only 2 account types here?
$debug and print STDERR "UpdateFine query: $query\n" .
"w/ args: $amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, \"\%$due\%\"\n";
$sth2->execute($amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, "%$due%");
} else {
# print "no update needed $data->{'amount'}"
#3341: diff could be positive or negative!
my $out = $data->{'amountoutstanding'} + $diff;
$accountline->set(
{
date => dt_from_string(),
amount => $amount,
outstanding => $out,
lastincrement => $diff,
accounttype => 'FU',
}
)->store();
# FIXME: BOGUS query cannot ensure uniqueness w/ LIKE %x% !!!
# LIMIT 1 added to prevent multiple affected lines
# FIXME: accountlines table needs unique key!! Possibly a combo of borrowernumber and accountline.
# But actually, we should just have a regular autoincrementing PK and forget accountline,
# including the bogus getnextaccountno function (doesn't prevent conflict on simultaneous ops).
# FIXME: Why only 2 account types here?
}
} else {
if ( $amount ) { # Don't add new fines with an amount of 0
@ -599,12 +613,19 @@ sub UpdateFine {
my $desc = ( $type ? "$type " : '' ) . "$title $due"; # FIXEDME, avoid whitespace prefix on empty $type
my $query = "INSERT INTO accountlines
(borrowernumber,itemnumber,date,amount,description,accounttype,amountoutstanding,lastincrement,accountno)
VALUES (?,?,now(),?,?,'FU',?,?,?)";
my $sth2 = $dbh->prepare($query);
$debug and print STDERR "UpdateFine query: $query\nw/ args: $borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno\n";
$sth2->execute( $borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno );
my $accountline = Koha::Account::Line->new(
{
borrowernumber => $borrowernumber,
itemnumber => $itemnum,
date => dt_from_string(),
amount => $amount,
description => $desc,
accounttype => 'FU',
amountoutstanding => $amount,
lastincrement => $amount,
accountno => $nextaccntno,
}
)->store();
}
}
# logging action

44
Koha/Account/Line.pm Normal file
View File

@ -0,0 +1,44 @@
package Koha::Account::Line;
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 3 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
use Modern::Perl;
use Carp;
use Koha::Database;
use base qw(Koha::Object);
=head1 NAME
Koha::Account::Lines - Koha accountline Object class
=head1 API
=head2 Class Methods
=cut
=head3 type
=cut
sub type {
return 'Accountline';
}
1;

51
Koha/Account/Lines.pm Normal file
View File

@ -0,0 +1,51 @@
package Koha::Account::Lines;
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 3 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
use Modern::Perl;
use Carp;
use Koha::Database;
use Koha::Account::Line;
use base qw(Koha::Objects);
=head1 NAME
Koha::Cities - Koha City Object set class
Koha::Account::Lines - Koha Account Line Object set class
=head1 API
=head2 Class Methods
=cut
=head3 type
=cut
sub type {
return 'Accountline';
}
sub object_class {
return 'Koha::Account::Line';
}
1;

1
installer/data/mysql/atomicupdate/bug_15334.sql Normal file
View File

@ -0,0 +1 @@
ALTER TABLE accountlines ADD issue_id INT(11) NULL DEFAULT NULL AFTER accountlines_id;

1
installer/data/mysql/kohastructure.sql
View File

@ -2765,6 +2765,7 @@ CREATE TABLE `messages` ( -- circulation messages left via the patron's check ou
DROP TABLE IF EXISTS `accountlines`;
CREATE TABLE `accountlines` (
`accountlines_id` int(11) NOT NULL AUTO_INCREMENT,
`issue_id` int(11) NULL DEFAULT NULL,
`borrowernumber` int(11) NOT NULL default 0,
`accountno` smallint(6) NOT NULL default 0,
`itemnumber` int(11) default NULL,

11
misc/cronjobs/fines.pl
View File

@ -132,9 +132,14 @@ for my $overdue ( @{$overdues} ) {
if ( $mode eq 'production' && !$is_holiday{$branchcode} ) {
if ( $amount > 0 ) {
UpdateFine(
$overdue->{itemnumber},
$overdue->{borrowernumber},
$amount, $type, output_pref($datedue)
{
issue_id => $overdue->{issue_id},
itemnumber => $overdue->{itemnumber},
borrowernumber => $overdue->{borrowernumber},
amount => $amount,
type => $type,
due => output_pref($datedue),
}
);
}
}

37
t/db_dependent/Circulation.t
View File

@ -469,8 +469,7 @@ C4::Context->dbh->do("DELETE FROM accountlines");
$biblionumber
);
AddIssue( $renewing_borrower, $barcode4, undef, undef, undef, undef,
{ auto_renew => 1 } );
$issue = AddIssue( $renewing_borrower, $barcode4, undef, undef, undef, undef, { auto_renew => 1 } );
( $renewokay, $error ) =
CanBookBeRenewed( $renewing_borrowernumber, $itemnumber4 );
is( $renewokay, 0, 'Bug 14101: Cannot renew, renewal is automatic and premature' );
@ -545,8 +544,16 @@ C4::Context->dbh->do("DELETE FROM accountlines");
C4::Context->set_preference('WhenLostForgiveFine','1');
C4::Context->set_preference('WhenLostChargeReplacementFee','1');
C4::Overdues::UpdateFine( $itemnumber, $renewing_borrower->{borrowernumber},
15.00, q{}, Koha::DateUtils::output_pref($datedue) );
C4::Overdues::UpdateFine(
{
issue_id => $issue->id(),
itemnumber => $itemnumber,
borrowernumber => $renewing_borrower->{borrowernumber},
amount => 15.00,
type => q{},
due => Koha::DateUtils::output_pref($datedue)
}
);
LostItem( $itemnumber, 1 );
@ -565,8 +572,16 @@ C4::Context->dbh->do("DELETE FROM accountlines");
C4::Context->set_preference('WhenLostForgiveFine','0');
C4::Context->set_preference('WhenLostChargeReplacementFee','0');
C4::Overdues::UpdateFine( $itemnumber2, $renewing_borrower->{borrowernumber},
15.00, q{}, Koha::DateUtils::output_pref($datedue) );
C4::Overdues::UpdateFine(
{
issue_id => $issue2->id(),
itemnumber => $itemnumber2,
borrowernumber => $renewing_borrower->{borrowernumber},
amount => 15.00,
type => q{},
due => Koha::DateUtils::output_pref($datedue)
}
);
LostItem( $itemnumber2, 0 );
@ -710,7 +725,15 @@ C4::Context->dbh->do("DELETE FROM accountlines");
my $borrowernumber = AddMember(%a_borrower_data);
UpdateFine( $itemnumber, $borrowernumber, 0 );
my $issue = AddIssue( GetMember( borrowernumber => $borrowernumber ), $barcode );
UpdateFine(
{
issue_id => $issue->id(),
itemnumber => $itemnumber,
borrowernumber => $borrowernumber,
amount => 0
}
);
my $hr = $dbh->selectrow_hashref(q{SELECT COUNT(*) AS count FROM accountlines WHERE borrowernumber = ? AND itemnumber = ?}, undef, $borrowernumber, $itemnumber );
my $count = $hr->{count};