Attachment #50078 for bug #16223

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




use C4::Members;
use C4::Circulation qw(ReturnLostItem);
use C4::Log qw(logaction);
use Koha::Patron::Debarments;

use Data::Dumper qw(Dumper);


                borrowernumber => $borrowernumber,
                accountno => $nextaccntno }
    );
    Koha::Patron::Debarments::DelDebarmentsAfterPayment({ borrowernumber => $borrowernumber });

    if ( C4::Context->preference("FinesLog") ) {
        $accdata->{'amountoutstanding_new'} = $newamtos;

        borrowernumber => $borrowernumber,
        accountno => $accountno
    });
    Koha::Patron::Debarments::DelDebarmentsAfterPayment({ borrowernumber => $borrowernumber });

    #check to see what accounttype
    if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {

        }));

    }
    Koha::Patron::Debarments::DelDebarmentsAfterPayment({ borrowernumber => $row->{'borrowernumber'} });

}


                borrowernumber => $borrowernumber,
                accountno => $nextaccntno}
    );
    Koha::Patron::Debarments::DelDebarmentsAfterPayment({ borrowernumber => $borrowernumber });

    if ( C4::Context->preference("FinesLog") ) {
        logaction("FINES", 'CREATE',$borrowernumber,Dumper({

        borrowernumber => $borrowernumber,
        accountno => $accountno
    });
    Koha::Patron::Debarments::DelDebarmentsAfterPayment({ borrowernumber => $borrowernumber });

    if ( C4::Context->preference("FinesLog") ) {
        logaction("FINES", 'CREATE',$borrowernumber,Dumper({

                amount => $amount,
                borrowernumber => $borrowernumber}
    );
    Koha::Patron::Debarments::DelDebarmentsAfterPayment({ borrowernumber => $borrowernumber });

}


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

(-)a/Koha/Patron/Debarments.pm (+64 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;
23		25
		26	use YAML::XS;
24	use parent qw( Exporter );	27	use parent qw( Exporter );
25		28
26	our @EXPORT = qw(	29	our @EXPORT = qw(
Lines 34-39 our @EXPORT = qw( Link Here
34	DelUniqueDebarment	37	DelUniqueDebarment
35		38
36	IsDebarred	39	IsDebarred
		40
		41	DelDebarmentsAfterPayment
37	);	42	);
38		43
39	=head1 Koha::Patron::Debarments	44	=head1 Koha::Patron::Debarments
Lines 268-273 sub DelUniqueDebarment { Link Here
268	return DelDebarment( $debarment->{'borrower_debarment_id'} );	273	return DelDebarment( $debarment->{'borrower_debarment_id'} );
269	}	274	}
270		275
		276	=head2 DelDebarmentsAfterPayment
		277
		278	my $success = DelDebarmentsAfterPayment({
		279	borrowernumber => $borrowernumber,
		280	});
		281
		282	Deletes any debarments from Borrower by following the rules
		283	defined in system preference DebarmentsToLiftAfterPayment
		284
		285	Debarments are defined in the system preference by comment.
		286
		287	=cut
		288
		289	sub DelDebarmentsAfterPayment {
		290	my ($params) = @_;
		291
		292	my $borrowernumber = $params->{'borrowernumber'};
		293	return unless ( $borrowernumber );
		294
		295	my $debarments = GetDebarments( { borrowernumber => $borrowernumber } );
		296	return unless ( $debarments );
		297
		298	my $liftDebarmentRules = C4::Context->preference("DebarmentsToLiftAfterPayment");
		299	return unless ( $liftDebarmentRules );
		300
		301	my $borrower = Koha::Patrons->find( $borrowernumber );
		302	return unless ( $borrower );
		303
		304	$liftDebarmentRules = YAML::XS::Load(
		305	Encode::encode(
		306	'UTF-8',
		307	$liftDebarmentRules,
		308	Encode::FB_CROAK
		309	));
		310
		311	my ( $total_due, $accts, $numaccts ) = C4::Members::GetMemberAccountRecords($borrowernumber);
		312
		313	foreach my $debarment (@{ $debarments }){
		314	if (exists $liftDebarmentRules->{$debarment->{'comment'}}) {
		315	# Delete debarment IF:
		316	# 1. there is no maximum outstanding fines defined for the liftDebarmentRule
		317	# and there is no outstanding fines.
		318	# 2. there is a maximum outstanding fines amount defined
		319	# and total_due is smaller or equal than the defined maximum outstanding amount
		320	# Otherwise, do not lift the debarment.
		321	if (not defined $liftDebarmentRules->{$debarment->{'comment'}}->{'outstanding'}){
		322	if ($total_due <= 0) {
		323	DelDebarment($debarment->{'borrower_debarment_id'});
		324	}
		325	}
		326	else {
		327	if ($total_due <= $liftDebarmentRules->{$debarment->{'comment'}}->{'outstanding'}) {
		328	DelDebarment($debarment->{'borrower_debarment_id'});
		329	}
		330	}
		331	}
		332	}
		333	}
		334
271	=head2 _UpdateBorrowerDebarmentFlags	335	=head2 _UpdateBorrowerDebarmentFlags
272		336
273	my $success = _UpdateBorrowerDebarmentFlags( $borrowernumber );	337	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 103-108 INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, ` Link Here

(-)a/installer/data/mysql/sysprefs.sql (+1 lines)
103	('CronjobLog','0',NULL,'If ON, log information from cron jobs.','YesNo'),	103	('CronjobLog','0',NULL,'If ON, log information from cron jobs.','YesNo'),
104	('CurrencyFormat','US','US\|FR','Determines the display format of currencies. eg: \'36000\' is displayed as \'360 000,00\' in \'FR\' or \'360,000.00\' in \'US\'.','Choice'),	104	('CurrencyFormat','US','US\|FR','Determines the display format of currencies. eg: \'36000\' is displayed as \'360 000,00\' in \'FR\' or \'360,000.00\' in \'US\'.','Choice'),
105	('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'),	105	('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'),
		106	('DebarmentsToLiftAfterPayment', '', '', 'Lift these debarments after Borrower has paid his/her fees', 'textarea'),
106	('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'),	107	('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'),
107	('decreaseLoanHighHolds',NULL,'','Decreases the loan period for items with number of holds above the threshold specified in decreaseLoanHighHoldsValue','YesNo'),	108	('decreaseLoanHighHolds',NULL,'','Decreases the loan period for items with number of holds above the threshold specified in decreaseLoanHighHoldsValue','YesNo'),
108	('decreaseLoanHighHoldsControl', 'static', 'static\|dynamic', "Chooses between static and dynamic high holds checking", 'Choice'),	109	('decreaseLoanHighHoldsControl', 'static', 'static\|dynamic', "Chooses between static and dynamic high holds checking", 'Choice'),




               katipo: Do
         - check and construct borrower card numbers in the Katipo style. This overrides <code>autoMemberNum</code> if on.
     -
         - 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:
               yes: Allow





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( IsDebarred( $borrowernumber ), '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

Lines 25-30 use C4::Stats; Link Here

(-)a/C4/Accounts.pm (+7 lines)
25	use C4::Members;	25	use C4::Members;
26	use C4::Circulation qw(ReturnLostItem);	26	use C4::Circulation qw(ReturnLostItem);
27	use C4::Log qw(logaction);	27	use C4::Log qw(logaction);
		28	use Koha::Patron::Debarments;
28		29
29	use Data::Dumper qw(Dumper);	30	use Data::Dumper qw(Dumper);
30		31
Lines 164-169 sub recordpayment { Link Here
164	borrowernumber => $borrowernumber,	165	borrowernumber => $borrowernumber,
165	accountno => $nextaccntno }	166	accountno => $nextaccntno }
166	);	167	);
		168	Koha::Patron::Debarments::DelDebarmentsAfterPayment({ borrowernumber => $borrowernumber });
167		169
168	if ( C4::Context->preference("FinesLog") ) {	170	if ( C4::Context->preference("FinesLog") ) {
169	$accdata->{'amountoutstanding_new'} = $newamtos;	171	$accdata->{'amountoutstanding_new'} = $newamtos;
Lines 281-286 sub makepayment { Link Here
281	borrowernumber => $borrowernumber,	283	borrowernumber => $borrowernumber,
282	accountno => $accountno	284	accountno => $accountno
283	});	285	});
		286	Koha::Patron::Debarments::DelDebarmentsAfterPayment({ borrowernumber => $borrowernumber });
284		287
285	#check to see what accounttype	288	#check to see what accounttype
286	if ( $data->{'accounttype'} eq 'Rep' \|\| $data->{'accounttype'} eq 'L' ) {	289	if ( $data->{'accounttype'} eq 'Rep' \|\| $data->{'accounttype'} eq 'L' ) {
Lines 574-579 sub ReversePayment { Link Here
574	}));	577	}));
575		578
576	}	579	}
		580	Koha::Patron::Debarments::DelDebarmentsAfterPayment({ borrowernumber => $row->{'borrowernumber'} });
577		581
578	}	582	}
579		583
Lines 664-669 sub recordpayment_selectaccts { Link Here
664	borrowernumber => $borrowernumber,	668	borrowernumber => $borrowernumber,
665	accountno => $nextaccntno}	669	accountno => $nextaccntno}
666	);	670	);
		671	Koha::Patron::Debarments::DelDebarmentsAfterPayment({ borrowernumber => $borrowernumber });
667		672
668	if ( C4::Context->preference("FinesLog") ) {	673	if ( C4::Context->preference("FinesLog") ) {
669	logaction("FINES", 'CREATE',$borrowernumber,Dumper({	674	logaction("FINES", 'CREATE',$borrowernumber,Dumper({
Lines 731-736 sub makepartialpayment { Link Here
731	borrowernumber => $borrowernumber,	736	borrowernumber => $borrowernumber,
732	accountno => $accountno	737	accountno => $accountno
733	});	738	});
		739	Koha::Patron::Debarments::DelDebarmentsAfterPayment({ borrowernumber => $borrowernumber });
734		740
735	if ( C4::Context->preference("FinesLog") ) {	741	if ( C4::Context->preference("FinesLog") ) {
736	logaction("FINES", 'CREATE',$borrowernumber,Dumper({	742	logaction("FINES", 'CREATE',$borrowernumber,Dumper({
Lines 820-825 sub WriteOffFee { Link Here
820	amount => $amount,	826	amount => $amount,
821	borrowernumber => $borrowernumber}	827	borrowernumber => $borrowernumber}
822	);	828	);
		829	Koha::Patron::Debarments::DelDebarmentsAfterPayment({ borrowernumber => $borrowernumber });
823		830
824	}	831	}
825		832

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 50-55 Patrons: Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/patrons.pref (+11 lines)
50	katipo: Do	50	katipo: Do
51	- check and construct borrower card numbers in the Katipo style. This overrides <code>autoMemberNum</code> if on.	51	- check and construct borrower card numbers in the Katipo style. This overrides <code>autoMemberNum</code> if on.
52	-	52	-
		53	- pref: DebarmentsToLiftAfterPayment
		54	type: textarea
		55	class: code
		56	- Lift these debarments after Borrower has paid his/her fees
		57	- "<p>Example, debarment is lifted after all fees are paid:</p>"
		58	- "<pre>Debarment message:</pre>
		59	<pre> outstanding: 0</pre>"
		60	- "<p>Example, debarment is lifted after payment with outstanding fees less or equal than 5:</p>"
		61	- "<pre>Another debarment:</pre>
		62	<pre> outstanding: 5.00</pre>"
		63	-
53	- pref: EnhancedMessagingPreferences	64	- pref: EnhancedMessagingPreferences
54	choices:	65	choices:
55	yes: Allow	66	yes: Allow

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

(-)a/t/db_dependent/Patron/Borrower_Debarments.t (-2 / +23 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( IsDebarred( $borrowernumber ), undef, 'A patron without a debarred date is n 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( IsDebarred( $borrowernumber ), '9999-12-31', 'A patron with a debarred date in the future is debarred' );	163	is( IsDebarred( $borrowernumber ), '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" );
		185