Attachment #47373 for bug #15675

View | Details | Raw Unified | Return to bug 15675
Collapse All | Expand All





                if ( C4::Context->preference('finesMode') eq 'production' ) {
                    if ( $amount > 0 ) {
                        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

                        C4::Overdues::UpdateFine(
                            {
                                issue_id       => $issue->{issue_id},
                                itemnumber     => $issue->{itemnumber},
                                borrowernumber => $issue->{borrowernumber},
                                amount         => 0,
                                type           => $type,
                                due            => output_pref($datedue),
                            }
                        );
                    }
                }
            }

Lines 26-31 use Date::Manip qw/UnixDate/; Link Here

(-)a/C4/Overdues.pm (-40 / +61 lines)
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




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;




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;

Line 0 Link Here

(-)a/installer/data/mysql/atomicupdate/bug_15334.sql (+1 lines)
	1	ALTER TABLE accountlines ADD issue_id INT(11) NULL DEFAULT NULL AFTER accountlines_id;

Lines 2747-2752 CREATE TABLE `messages` ( -- circulation messages left via the patron's check ou Link Here

(-)a/installer/data/mysql/kohastructure.sql (+1 lines)
2747	DROP TABLE IF EXISTS `accountlines`;	2747	DROP TABLE IF EXISTS `accountlines`;
2748	CREATE TABLE `accountlines` (	2748	CREATE TABLE `accountlines` (
2749	`accountlines_id` int(11) NOT NULL AUTO_INCREMENT,	2749	`accountlines_id` int(11) NOT NULL AUTO_INCREMENT,
		2750	`issue_id` int(11) NULL DEFAULT NULL,
2750	`borrowernumber` int(11) NOT NULL default 0,	2751	`borrowernumber` int(11) NOT NULL default 0,
2751	`accountno` smallint(6) NOT NULL default 0,	2752	`accountno` smallint(6) NOT NULL default 0,
2752	`itemnumber` int(11) default NULL,	2753	`itemnumber` int(11) default NULL,

Lines 132-140 for my $overdue ( @{$overdues} ) { Link Here

(-)a/misc/cronjobs/fines.pl (-3 / +8 lines)
132	if ( $mode eq 'production' && !$is_holiday{$branchcode} ) {	132	if ( $mode eq 'production' && !$is_holiday{$branchcode} ) {
133	if ( $amount > 0 ) {	133	if ( $amount > 0 ) {
134	UpdateFine(	134	UpdateFine(
135	$overdue->{itemnumber},	135	{
136	$overdue->{borrowernumber},	136	issue_id => $overdue->{issue_id},
137	$amount, $type, output_pref($datedue)	137	itemnumber => $overdue->{itemnumber},
		138	borrowernumber => $overdue->{borrowernumber},
		139	amount => $amount,
		140	type => $type,
		141	due => output_pref($datedue),
		142	}
138	);	143	);
139	}	144	}
140	}	145	}

Lines 467-473 C4::Context->dbh->do("DELETE FROM accountlines"); Link Here

(-)a/t/db_dependent/Circulation.t (-7 / +30 lines)
467	$biblionumber	467	$biblionumber
468	);	468	);
469		469
470	AddIssue( $renewing_borrower, $barcode4, undef, undef, undef, undef, { auto_renew => 1 } );	470	$issue = AddIssue( $renewing_borrower, $barcode4, undef, undef, undef, undef, { auto_renew => 1 } );
471	( $renewokay, $error ) =	471	( $renewokay, $error ) =
472	CanBookBeRenewed( $renewing_borrowernumber, $itemnumber4 );	472	CanBookBeRenewed( $renewing_borrowernumber, $itemnumber4 );
473	is( $renewokay, 0, 'Bug 14101: Cannot renew, renewal is automatic and premature' );	473	is( $renewokay, 0, 'Bug 14101: Cannot renew, renewal is automatic and premature' );
Lines 527-534 C4::Context->dbh->do("DELETE FROM accountlines"); Link Here
527	C4::Context->set_preference('WhenLostForgiveFine','1');	527	C4::Context->set_preference('WhenLostForgiveFine','1');
528	C4::Context->set_preference('WhenLostChargeReplacementFee','1');	528	C4::Context->set_preference('WhenLostChargeReplacementFee','1');
529		529
530	C4::Overdues::UpdateFine( $itemnumber, $renewing_borrower->{borrowernumber},	530	C4::Overdues::UpdateFine(
531	15.00, q{}, Koha::DateUtils::output_pref($datedue) );	531	{
		532	issue_id => $issue->id(),
		533	itemnumber => $itemnumber,
		534	borrowernumber => $renewing_borrower->{borrowernumber},
		535	amount => 15.00,
		536	type => q{},
		537	due => Koha::DateUtils::output_pref($datedue)
		538	}
		539	);
532		540
533	LostItem( $itemnumber, 1 );	541	LostItem( $itemnumber, 1 );
534		542
Lines 547-554 C4::Context->dbh->do("DELETE FROM accountlines"); Link Here
547	C4::Context->set_preference('WhenLostForgiveFine','0');	555	C4::Context->set_preference('WhenLostForgiveFine','0');
548	C4::Context->set_preference('WhenLostChargeReplacementFee','0');	556	C4::Context->set_preference('WhenLostChargeReplacementFee','0');
549		557
550	C4::Overdues::UpdateFine( $itemnumber2, $renewing_borrower->{borrowernumber},	558	C4::Overdues::UpdateFine(
551	15.00, q{}, Koha::DateUtils::output_pref($datedue) );	559	{
		560	issue_id => $issue2->id(),
		561	itemnumber => $itemnumber2,
		562	borrowernumber => $renewing_borrower->{borrowernumber},
		563	amount => 15.00,
		564	type => q{},
		565	due => Koha::DateUtils::output_pref($datedue)
		566	}
		567	);
552		568
553	LostItem( $itemnumber2, 0 );	569	LostItem( $itemnumber2, 0 );
554		570
Lines 692-698 C4::Context->dbh->do("DELETE FROM accountlines"); Link Here
692		708
693	my $borrowernumber = AddMember(%a_borrower_data);	709	my $borrowernumber = AddMember(%a_borrower_data);
694		710
695	UpdateFine( $itemnumber, $borrowernumber, 0 );	711	my $issue = AddIssue( GetMember( borrowernumber => $borrowernumber ), $barcode );
		712	UpdateFine(
		713	{
		714	issue_id => $issue->id(),
		715	itemnumber => $itemnumber,
		716	borrowernumber => $borrowernumber,
		717	amount => 0
		718	}
		719	);
696		720
697	my $hr = $dbh->selectrow_hashref(q{SELECT COUNT(*) AS count FROM accountlines WHERE borrowernumber = ? AND itemnumber = ?}, undef, $borrowernumber, $itemnumber );	721	my $hr = $dbh->selectrow_hashref(q{SELECT COUNT(*) AS count FROM accountlines WHERE borrowernumber = ? AND itemnumber = ?}, undef, $borrowernumber, $itemnumber );
698	my $count = $hr->{count};	722	my $count = $hr->{count};
699	-

Return to bug 15675

Lines 1932-1949 sub AddReturn { Link Here

(-)a/C4/Circulation.pm (-9 / +23 lines)
1932		1932
1933	if ( C4::Context->preference('finesMode') eq 'production' ) {	1933	if ( C4::Context->preference('finesMode') eq 'production' ) {
1934	if ( $amount > 0 ) {	1934	if ( $amount > 0 ) {
1935	C4::Overdues::UpdateFine( $issue->{itemnumber},	1935	C4::Overdues::UpdateFine(
1936	$issue->{borrowernumber},	1936	{
1937	$amount, $type, output_pref($datedue) );	1937	issue_id => $issue->{issue_id},
		1938	itemnumber => $issue->{itemnumber},
		1939	borrowernumber => $issue->{borrowernumber},
		1940	amount => $amount,
		1941	type => $type,
		1942	due => output_pref($datedue),
		1943	}
		1944	);
1938	}	1945	}
1939	elsif ($return_date) {	1946	elsif ($return_date) {
1940		1947
1941	# Backdated returns may have fines that shouldn't exist,	1948	# Backdated returns may have fines that shouldn't exist,
1942	# so in this case, we need to drop those fines to 0	1949	# so in this case, we need to drop those fines to 0
1943		1950
1944	C4::Overdues::UpdateFine( $issue->{itemnumber},	1951	C4::Overdues::UpdateFine(
1945	$issue->{borrowernumber},	1952	{
1946	0, $type, output_pref($datedue) );	1953	issue_id => $issue->{issue_id},
		1954	itemnumber => $issue->{itemnumber},
		1955	borrowernumber => $issue->{borrowernumber},
		1956	amount => 0,
		1957	type => $type,
		1958	due => output_pref($datedue),
		1959	}
		1960	);
1947	}	1961	}
1948	}	1962	}
1949	}	1963	}

Line 0 Link Here

(-)a/Koha/Account/Line.pm (+44 lines)
	1	package Koha::Account::Line;
	2
	3	# This file is part of Koha.
	4	#
	5	# Koha is free software; you can redistribute it and/or modify it under the
	6	# terms of the GNU General Public License as published by the Free Software
	7	# Foundation; either version 3 of the License, or (at your option) any later
	8	# version.
	9	#
	10	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
	11	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
	12	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
	13	#
	14	# You should have received a copy of the GNU General Public License along
	15	# with Koha; if not, write to the Free Software Foundation, Inc.,
	16	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
	17
	18	use Modern::Perl;
	19
	20	use Carp;
	21
	22	use Koha::Database;
	23
	24	use base qw(Koha::Object);
	25
	26	=head1 NAME
	27
	28	Koha::Account::Lines - Koha accountline Object class
	29
	30	=head1 API
	31
	32	=head2 Class Methods
	33
	34	=cut
	35
	36	=head3 type
	37
	38	=cut
	39
	40	sub type {
	41	return 'Accountline';
	42	}
	43
	44	1;

Line 0 Link Here

(-)a/Koha/Account/Lines.pm (+51 lines)
	1	package Koha::Account::Lines;
	2
	3	# This file is part of Koha.
	4	#
	5	# Koha is free software; you can redistribute it and/or modify it under the
	6	# terms of the GNU General Public License as published by the Free Software
	7	# Foundation; either version 3 of the License, or (at your option) any later
	8	# version.
	9	#
	10	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
	11	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
	12	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
	13	#
	14	# You should have received a copy of the GNU General Public License along
	15	# with Koha; if not, write to the Free Software Foundation, Inc.,
	16	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
	17
	18	use Modern::Perl;
	19
	20	use Carp;
	21
	22	use Koha::Database;
	23
	24	use Koha::Account::Line;
	25
	26	use base qw(Koha::Objects);
	27
	28	=head1 NAME
	29
	30	Koha::Cities - Koha City Object set class
	31	Koha::Account::Lines - Koha Account Line Object set class
	32
	33	=head1 API
	34
	35	=head2 Class Methods
	36
	37	=cut
	38
	39	=head3 type
	40
	41	=cut
	42
	43	sub type {
	44	return 'Accountline';
	45	}
	46
	47	sub object_class {
	48	return 'Koha::Account::Line';
	49	}
	50
	51	1;