Attachment #99697 for bug #16223

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

Lines 36-41 use Koha::Account::DebitTypes; Link Here

(-)a/Koha/Account.pm (+3 lines)
36	use Koha::DateUtils qw( dt_from_string );	36	use Koha::DateUtils qw( dt_from_string );
37	use Koha::Exceptions;	37	use Koha::Exceptions;
38	use Koha::Exceptions::Account;	38	use Koha::Exceptions::Account;
		39	use Koha::Patron::Debarments;
39		40
40	=head1 NAME	41	=head1 NAME
41		42
Lines 301-306 sub pay { Link Here
301	}	302	}
302	}	303	}
303		304
		305	Koha::Patron::Debarments::DelDebarmentsAfterPayment({ borrowernumber => $self->{patron_id} });
		306
304	return $payment->id;	307	return $payment->id;
305	}	308	}
306		309

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

(-)a/Koha/Patron/Debarments.pm (-1 / +66 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 32-38 our @EXPORT = qw( Link Here
32		36
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 134-139 INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, ` Link Here

(-)a/installer/data/mysql/sysprefs.sql (+1 lines)
134	('CustomCoverImages','0',NULL,'If enabled, the custom cover images will be displayed in the staff client. CustomCoverImagesURL must be defined.','YesNo'),	134	('CustomCoverImages','0',NULL,'If enabled, the custom cover images will be displayed in the staff client. CustomCoverImagesURL must be defined.','YesNo'),
135	('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'),	135	('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'),
136	('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'),	136	('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'),
		137	('DebarmentsToLiftAfterPayment', '', '', 'Lift these debarments after Borrower has paid his/her fees', 'textarea'),
137	('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'),	138	('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'),
138	('decreaseLoanHighHolds',NULL,'','Decreases the loan period for items with number of holds above the threshold specified in decreaseLoanHighHoldsValue','YesNo'),	139	('decreaseLoanHighHolds',NULL,'','Decreases the loan period for items with number of holds above the threshold specified in decreaseLoanHighHoldsValue','YesNo'),
139	('decreaseLoanHighHoldsControl', 'static', 'static\|dynamic', "Chooses between static and dynamic high holds checking", 'Choice'),	140	('decreaseLoanHighHoldsControl', 'static', 'static\|dynamic', "Chooses between static and dynamic high holds checking", 'Choice'),




               softno: "Unless overridden by patron category, do not"
               hardno: "Do not"
         - " check borrower checkout history to see if the current item has been checked out before."
     -
         - 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>"
     -
         - pref: EnhancedMessagingPreferences
           choices:





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 66-71 Patrons: Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/patrons.pref (+11 lines)
66	softno: "Unless overridden by patron category, do not"	66	softno: "Unless overridden by patron category, do not"
67	hardno: "Do not"	67	hardno: "Do not"
68	- " check borrower checkout history to see if the current item has been checked out before."	68	- " check borrower checkout history to see if the current item has been checked out before."
		69	-
		70	- pref: DebarmentsToLiftAfterPayment
		71	type: textarea
		72	class: code
		73	- Lift these debarments after Borrower has paid his/her fees
		74	- "<p>Example, debarment is lifted after all fees are paid:</p>"
		75	- "<pre>Debarment message:</pre>
		76	<pre> outstanding: 0</pre>"
		77	- "<p>Example, debarment is lifted after payment with outstanding fees less or equal than 5:</p>"
		78	- "<pre>Another debarment:</pre>
		79	<pre> outstanding: 5.00</pre>"
69	-	80	-
70	- pref: EnhancedMessagingPreferences	81	- pref: EnhancedMessagingPreferences
71	choices:	82	choices:

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" );