Attachment #104399 for bug #16223

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

Lines 37-42 use Koha::Account::DebitTypes; Link Here

(-)a/Koha/Account.pm (+3 lines)
37	use Koha::DateUtils qw( dt_from_string );	37	use Koha::DateUtils qw( dt_from_string );
38	use Koha::Exceptions;	38	use Koha::Exceptions;
39	use Koha::Exceptions::Account;	39	use Koha::Exceptions::Account;
		40	use Koha::Patron::Debarments;
40		41
41	=head1 NAME	42	=head1 NAME
42		43
Lines 288-293 sub pay { Link Here
288	}	289	}
289	);	290	);
290		291
		292	Koha::Patron::Debarments::DelDebarmentsAfterPayment({ borrowernumber => $self->{patron_id} });
		293
291	if ( C4::Context->preference("FinesLog") ) {	294	if ( C4::Context->preference("FinesLog") ) {
292	logaction(	295	logaction(
293	"FINES", 'CREATE',	296	"FINES", 'CREATE',

Lines 20-26 package Koha::Patron::Debarments; Link Here

(-)a/Koha/Patron/Debarments.pm (+65 lines)
20	use Modern::Perl;	20	use Modern::Perl;
21		21
22	use C4::Context;	22	use C4::Context;
		23	use C4::Members;
		24	use Koha::Patrons;
		25	use Koha::Account::Lines;
23		26
		27	use YAML::XS;
24	use parent qw( Exporter );	28	use parent qw( Exporter );
25		29
26	our @EXPORT = qw(	30	our @EXPORT = qw(
Lines 33-38 our @EXPORT = qw( Link Here
33	AddUniqueDebarment	37	AddUniqueDebarment
34	DelUniqueDebarment	38	DelUniqueDebarment
35		39
		40	DelDebarmentsAfterPayment
36	);	41	);
37		42
38	=head1 Koha::Patron::Debarments	43	=head1 Koha::Patron::Debarments
Lines 245-250 sub DelUniqueDebarment { Link Here
245	return DelDebarment( $debarment->{'borrower_debarment_id'} );	250	return DelDebarment( $debarment->{'borrower_debarment_id'} );
246	}	251	}
247		252
		253	=head2 DelDebarmentsAfterPayment
		254
		255	my $success = DelDebarmentsAfterPayment({
		256	borrowernumber => $borrowernumber,
		257	});
		258
		259	Deletes any debarments from Borrower by following the rules
		260	defined in system preference DebarmentsToLiftAfterPayment
		261
		262	Debarments are defined in the system preference by comment.
		263
		264	=cut
		265
		266	sub DelDebarmentsAfterPayment {
		267	my ($params) = @_;
		268
		269	my $borrowernumber = $params->{'borrowernumber'};
		270	return unless ( $borrowernumber );
		271
		272	my $debarments = GetDebarments( { borrowernumber => $borrowernumber } );
		273	return unless ( $debarments );
		274
		275	my $liftDebarmentRules = C4::Context->preference("DebarmentsToLiftAfterPayment");
		276	return unless ( $liftDebarmentRules );
		277
		278	my $borrower = Koha::Patrons->find( $borrowernumber );
		279	return unless ( $borrower );
		280
		281	$liftDebarmentRules = YAML::XS::Load(
		282	Encode::encode(
		283	'UTF-8',
		284	$liftDebarmentRules,
		285	Encode::FB_CROAK
		286	));
		287
		288	my $lines = Koha::Account::Lines->search({ borrowernumber => $borrowernumber });
		289	my $total_due = $lines->total_outstanding;
		290
		291	foreach my $debarment (@{ $debarments }){
		292	if (exists $liftDebarmentRules->{$debarment->{'comment'}}) {
		293	# Delete debarment IF:
		294	# 1. there is no maximum outstanding fines defined for the liftDebarmentRule
		295	# and there is no outstanding fines.
		296	# 2. there is a maximum outstanding fines amount defined
		297	# and total_due is smaller or equal than the defined maximum outstanding amount
		298	# Otherwise, do not lift the debarment.
		299	if (not defined $liftDebarmentRules->{$debarment->{'comment'}}->{'outstanding'}){
		300	if ($total_due <= 0) {
		301	DelDebarment($debarment->{'borrower_debarment_id'});
		302	}
		303	}
		304	else {
		305	if ($total_due <= $liftDebarmentRules->{$debarment->{'comment'}}->{'outstanding'}) {
		306	DelDebarment($debarment->{'borrower_debarment_id'});
		307	}
		308	}
		309	}
		310	}
		311	}
		312
248	=head2 _UpdateBorrowerDebarmentFlags	313	=head2 _UpdateBorrowerDebarmentFlags
249		314
250	my $success = _UpdateBorrowerDebarmentFlags( $borrowernumber );	315	my $success = _UpdateBorrowerDebarmentFlags( $borrowernumber );




#! /usr/bin/perl

use strict;
use warnings;
use C4::Context;
use Koha::AtomicUpdater;

my $dbh = C4::Context->dbh;
my $atomicUpdater = Koha::AtomicUpdater->new();

unless($atomicUpdater->find('Bug16223')) {
    # Add system preference
    $dbh->do("INSERT INTO systempreferences (variable, value, options, explanation, type)
             VALUES ('DebarmentsToLiftAfterPayment', '', '', 'Lift these debarments after Borrower has paid his/her fees', 'textarea')");

    print "Upgrade done (Bug 16623: Automatically remove any borrower debarments after a payment)\n";
}

Lines 140-145 INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, ` Link Here

(-)a/installer/data/mysql/sysprefs.sql (+1 lines)
140	('CustomCoverImages','0',NULL,'If enabled, the custom cover images will be displayed in the staff client. CustomCoverImagesURL must be defined.','YesNo'),	140	('CustomCoverImages','0',NULL,'If enabled, the custom cover images will be displayed in the staff client. CustomCoverImagesURL must be defined.','YesNo'),
141	('CustomCoverImagesURL','',NULL,'Define an URL serving book cover images, using the following patterns: %issn%, %isbn%, FIXME ADD MORE (use it with CustomCoverImages and/or OPACCustomCoverImages)','free'),	141	('CustomCoverImagesURL','',NULL,'Define an URL serving book cover images, using the following patterns: %issn%, %isbn%, FIXME ADD MORE (use it with CustomCoverImages and/or OPACCustomCoverImages)','free'),
142	('dateformat','us','metric\|us\|iso\|dmydot','Define global date format (us mm/dd/yyyy, metric dd/mm/yyy, ISO yyyy-mm-dd, dmydot dd.mm.yyyy)','Choice'),	142	('dateformat','us','metric\|us\|iso\|dmydot','Define global date format (us mm/dd/yyyy, metric dd/mm/yyy, ISO yyyy-mm-dd, dmydot dd.mm.yyyy)','Choice'),
		143	('DebarmentsToLiftAfterPayment', '', '', 'Lift these debarments after Borrower has paid his/her fees', 'textarea'),
143	('DebugLevel','2','0\|1\|2','Define the level of debugging information sent to the browser when errors are encountered (set to 0 in production). 0=none, 1=some, 2=most','Choice'),	144	('DebugLevel','2','0\|1\|2','Define the level of debugging information sent to the browser when errors are encountered (set to 0 in production). 0=none, 1=some, 2=most','Choice'),
144	('decreaseLoanHighHolds',NULL,'','Decreases the loan period for items with number of holds above the threshold specified in decreaseLoanHighHoldsValue','YesNo'),	145	('decreaseLoanHighHolds',NULL,'','Decreases the loan period for items with number of holds above the threshold specified in decreaseLoanHighHoldsValue','YesNo'),
145	('decreaseLoanHighHoldsControl', 'static', 'static\|dynamic', "Chooses between static and dynamic high holds checking", 'Choice'),	146	('decreaseLoanHighHoldsControl', 'static', 'static\|dynamic', "Chooses between static and dynamic high holds checking", 'Choice'),




               yes: Allow patrons
               no: Allow only staff
         - "to allow/disallow auto renewal for account. If allowed a patron will be able to update their own account to allow/disallow auto renewals"
     -     
         - pref: DebarmentsToLiftAfterPayment
           type: textarea
           class: code
         - Lift these debarments after Borrower has paid his/her fees
         - "<p>Example, debarment is lifted after all fees are paid:</p>"
         - "<pre>Debarment message:</pre>
            <pre>  outstanding: 0</pre>"
         - "<p>Example, debarment is lifted after payment with outstanding fees less or equal than 5:</p>"
         - "<pre>Another debarment:</pre>
            <pre>  outstanding: 5.00</pre>"
    Membership expiry:
     -
         - When renewing borrowers, base the new expiry date on





use t::lib::TestBuilder;

use Test::More tests => 33;

use_ok('Koha::Patron::Debarments');



$dbh->do(q|UPDATE borrowers SET debarred = '9999-12-31'|); # Note: Change this test before the first of January 10000!
is( Koha::Patrons->find( $borrowernumber )->is_debarred, '9999-12-31', 'A patron with a debarred date in the future is debarred' );

my $debarmentsRulesPref = C4::Context->preference("DebarmentsToLiftAfterPayment");
C4::Context->set_preference("DebarmentsToLiftAfterPayment", "Test debarment:\n  outstanding: 0\nTest debarment 2:");

AddDebarment({
    borrowernumber => $borrowernumber,
    comment => 'Test debarment',
});
AddDebarment({
    borrowernumber => $borrowernumber,
    comment => 'Test debarment 2',
});

$debarments = GetDebarments({ borrowernumber => $borrowernumber });
is( @$debarments, 2, "GetDebarments returns 2 debarments before payment" );

DelDebarmentsAfterPayment({ borrowernumber => $borrowernumber });
C4::Context->set_preference("DebarmentsToLiftAfterPayment", $debarmentsRulesPref);

$debarments = GetDebarments({ borrowernumber => $borrowernumber });
is( @$debarments, 0, "GetDebarments returns 0 debarments after payment" );

Return to bug 16223

Line 0 Link Here

(-)a/installer/data/mysql/atomicupdate/Bug_16223_-_Automatically_remove_any_borrower_debarments_after_a_payment.pl (+17 lines)
	1	#! /usr/bin/perl
	2
	3	use strict;
	4	use warnings;
	5	use C4::Context;
	6	use Koha::AtomicUpdater;
	7
	8	my $dbh = C4::Context->dbh;
	9	my $atomicUpdater = Koha::AtomicUpdater->new();
	10
	11	unless($atomicUpdater->find('Bug16223')) {
	12	# Add system preference
	13	$dbh->do("INSERT INTO systempreferences (variable, value, options, explanation, type)
	14	VALUES ('DebarmentsToLiftAfterPayment', '', '', 'Lift these debarments after Borrower has paid his/her fees', 'textarea')");
	15
	16	print "Upgrade done (Bug 16623: Automatically remove any borrower debarments after a payment)\n";
	17	}

Lines 85-90 Patrons: Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/patrons.pref (+11 lines)
85	yes: Allow patrons	85	yes: Allow patrons
86	no: Allow only staff	86	no: Allow only staff
87	- "to allow/disallow auto renewal for account. If allowed a patron will be able to update their own account to allow/disallow auto renewals"	87	- "to allow/disallow auto renewal for account. If allowed a patron will be able to update their own account to allow/disallow auto renewals"
		88	-
		89	- pref: DebarmentsToLiftAfterPayment
		90	type: textarea
		91	class: code
		92	- Lift these debarments after Borrower has paid his/her fees
		93	- "<p>Example, debarment is lifted after all fees are paid:</p>"
		94	- "<pre>Debarment message:</pre>
		95	<pre> outstanding: 0</pre>"
		96	- "<p>Example, debarment is lifted after payment with outstanding fees less or equal than 5:</p>"
		97	- "<pre>Another debarment:</pre>
		98	<pre> outstanding: 5.00</pre>"
88	Membership expiry:	99	Membership expiry:
89	-	100	-
90	- When renewing borrowers, base the new expiry date on	101	- When renewing borrowers, base the new expiry date on

Lines 8-14 use Koha::Patrons; Link Here

(-)a/t/db_dependent/Patron/Borrower_Debarments.t (-2 / +22 lines)
8		8
9	use t::lib::TestBuilder;	9	use t::lib::TestBuilder;
10		10
11	use Test::More tests => 31;	11	use Test::More tests => 33;
12		12
13	use_ok('Koha::Patron::Debarments');	13	use_ok('Koha::Patron::Debarments');
14		14
Lines 161-163 is( Koha::Patrons->find( $borrowernumber )->is_debarred, undef, 'A patron withou Link Here
161		161
162	$dbh->do(q\|UPDATE borrowers SET debarred = '9999-12-31'\|); # Note: Change this test before the first of January 10000!	162	$dbh->do(q\|UPDATE borrowers SET debarred = '9999-12-31'\|); # Note: Change this test before the first of January 10000!
163	is( Koha::Patrons->find( $borrowernumber )->is_debarred, '9999-12-31', 'A patron with a debarred date in the future is debarred' );	163	is( Koha::Patrons->find( $borrowernumber )->is_debarred, '9999-12-31', 'A patron with a debarred date in the future is debarred' );
164	-	164
		165	my $debarmentsRulesPref = C4::Context->preference("DebarmentsToLiftAfterPayment");
		166	C4::Context->set_preference("DebarmentsToLiftAfterPayment", "Test debarment:\n outstanding: 0\nTest debarment 2:");
		167
		168	AddDebarment({
		169	borrowernumber => $borrowernumber,
		170	comment => 'Test debarment',
		171	});
		172	AddDebarment({
		173	borrowernumber => $borrowernumber,
		174	comment => 'Test debarment 2',
		175	});
		176
		177	$debarments = GetDebarments({ borrowernumber => $borrowernumber });
		178	is( @$debarments, 2, "GetDebarments returns 2 debarments before payment" );
		179
		180	DelDebarmentsAfterPayment({ borrowernumber => $borrowernumber });
		181	C4::Context->set_preference("DebarmentsToLiftAfterPayment", $debarmentsRulesPref);
		182
		183	$debarments = GetDebarments({ borrowernumber => $borrowernumber });
		184	is( @$debarments, 0, "GetDebarments returns 0 debarments after payment" );