@@ -, +, @@
after a payment
outstanding: 5
DebarmentsToLiftAfterPayment
---
Koha/Account.pm | 3 +
Koha/Patron/Debarments.pm | 65 +++++++++++++++++++
...y_borrower_debarments_after_a_payment.perl | 10 +++
installer/data/mysql/mandatory/sysprefs.sql | 1 +
.../en/modules/admin/preferences/patrons.pref | 12 +++-
t/db_dependent/Patron/Borrower_Debarments.t | 24 ++++++-
6 files changed, 113 insertions(+), 2 deletions(-)
create mode 100644 installer/data/mysql/atomicupdate/Bug_16223-Automatically_remove_any_borrower_debarments_after_a_payment.perl
--- a/Koha/Account.pm
+++ a/Koha/Account.pm
@@ -37,6 +37,7 @@ use Koha::Account::DebitTypes;
use Koha::DateUtils qw( dt_from_string );
use Koha::Exceptions;
use Koha::Exceptions::Account;
+use Koha::Patron::Debarments;
=head1 NAME
@@ -104,6 +105,8 @@ sub pay {
}
);
+ Koha::Patron::Debarments::DelDebarmentsAfterPayment({ borrowernumber => $self->{patron_id} });
+
# NOTE: Pay historically always applied as much credit as it could to all
# existing outstanding debits, whether passed specific debits or otherwise.
if ( $payment->amountoutstanding ) {
--- a/Koha/Patron/Debarments.pm
+++ a/Koha/Patron/Debarments.pm
@@ -20,7 +20,11 @@ package Koha::Patron::Debarments;
use Modern::Perl;
use C4::Context;
+use C4::Members;
+use Koha::Patrons;
+use Koha::Account::Lines;
+use YAML::XS;
use parent qw( Exporter );
our @EXPORT = qw(
@@ -33,6 +37,7 @@ our @EXPORT = qw(
AddUniqueDebarment
DelUniqueDebarment
+ DelDebarmentsAfterPayment
);
=head1 Koha::Patron::Debarments
@@ -282,6 +287,66 @@ sub UpdateBorrowerDebarmentFlags {
return $dbh->do( "UPDATE borrowers SET debarred = ?, debarredcomment = ? WHERE borrowernumber = ?", {}, ( $expiration, $comment, $borrowernumber ) );
}
+=head2 DelDebarmentsAfterPayment
+
+my $success = DelDebarmentsAfterPayment({
+ borrowernumber => $borrowernumber,
+});
+
+Deletes any debarments from Borrower by following the rules
+defined in system preference DebarmentsToLiftAfterPayment
+
+Debarments are defined in the system preference by comment.
+
+=cut
+
+sub DelDebarmentsAfterPayment {
+ my ($params) = @_;
+
+ my $borrowernumber = $params->{'borrowernumber'};
+ return unless ( $borrowernumber );
+
+ my $debarments = GetDebarments( { borrowernumber => $borrowernumber } );
+ return unless ( $debarments );
+
+ my $liftDebarmentRules = C4::Context->preference("DebarmentsToLiftAfterPayment");
+ return unless ( $liftDebarmentRules );
+
+ my $borrower = Koha::Patrons->find( $borrowernumber );
+ return unless ( $borrower );
+
+ $liftDebarmentRules = YAML::XS::Load(
+ Encode::encode(
+ 'UTF-8',
+ $liftDebarmentRules,
+ Encode::FB_CROAK
+ ));
+
+ my $lines = Koha::Account::Lines->search({ borrowernumber => $borrowernumber });
+ my $total_due = $lines->total_outstanding;
+
+ foreach my $debarment (@{ $debarments }){
+ if (exists $liftDebarmentRules->{$debarment->{'comment'}}) {
+ # Delete debarment IF:
+ # 1. there is no maximum outstanding fines defined for the liftDebarmentRule
+ # and there is no outstanding fines.
+ # 2. there is a maximum outstanding fines amount defined
+ # and total_due is smaller or equal than the defined maximum outstanding amount
+ # Otherwise, do not lift the debarment.
+ if (not defined $liftDebarmentRules->{$debarment->{'comment'}}->{'outstanding'}){
+ if ($total_due <= 0) {
+ DelDebarment($debarment->{'borrower_debarment_id'});
+ }
+ }
+ else {
+ if ($total_due <= $liftDebarmentRules->{$debarment->{'comment'}}->{'outstanding'}) {
+ DelDebarment($debarment->{'borrower_debarment_id'});
+ }
+ }
+ }
+ }
+}
+
=head2 _GetBorrowernumberByDebarmentId
my $borrowernumber = _GetBorrowernumberByDebarmentId( $borrower_debarment_id );
--- a/installer/data/mysql/atomicupdate/Bug_16223-Automatically_remove_any_borrower_debarments_after_a_payment.perl
+++ a/installer/data/mysql/atomicupdate/Bug_16223-Automatically_remove_any_borrower_debarments_after_a_payment.perl
@@ -0,0 +1,10 @@
+$DBversion = 'XXX'; # will be replaced by the RM
+if( CheckVersion( $DBversion ) ) {
+ # you can use $dbh here like:
+ # $dbh->do( "ALTER TABLE biblio ADD COLUMN badtaste int" );
+
+ $dbh->do("INSERT INTO systempreferences (variable, value, options, explanation, type) VALUES ('DebarmentsToLiftAfterPayment', '', '', 'Lift these debarments after Borrower has paid his/her fees', 'textarea')");
+
+ # Always end with this (adjust the bug info)
+ NewVersion( $DBversion, 16223, "Automatically remove any borrower debarments after a payment");
+}
--- a/installer/data/mysql/mandatory/sysprefs.sql
+++ a/installer/data/mysql/mandatory/sysprefs.sql
@@ -148,6 +148,7 @@ INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, `
('CustomCoverImages','0',NULL,'If enabled, the custom cover images will be displayed in the staff interface. CustomCoverImagesURL must be defined.','YesNo'),
('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'),
('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'),
+('DebarmentsToLiftAfterPayment', '', '', 'Lift these debarments after Borrower has paid his/her fees', 'textarea'),
('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'),
('decreaseLoanHighHolds','0','','Decreases the loan period for items with number of holds above the threshold specified in decreaseLoanHighHoldsValue','YesNo'),
('decreaseLoanHighHoldsControl', 'static', 'static|dynamic', "Chooses between static and dynamic high holds checking", 'Choice'),
--- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/patrons.pref
+++ a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/patrons.pref
@@ -106,7 +106,17 @@ Patrons:
class: integer
- days. Leave empty to disable this behavior.
- "
NOTE: This system preference requires the misc/cronjobs/cleanup_database.pl cronjob. Ask your system administrator to schedule it."
-
+ -
+ - pref: DebarmentsToLiftAfterPayment
+ type: textarea
+ class: code
+ - Lift these debarments after Borrower has paid his/her fees
+ - "
Example, debarment is lifted after all fees are paid:
" + - "Debarment message:+
outstanding: 0" + - "
Example, debarment is lifted after payment with outstanding fees less or equal than 5:
" + - "Another debarment:+
outstanding: 5.00" Membership expiry: - - When renewing borrowers, base the new expiry date on --- a/t/db_dependent/Patron/Borrower_Debarments.t +++ a/t/db_dependent/Patron/Borrower_Debarments.t @@ -8,7 +8,7 @@ use Koha::Patrons; use t::lib::TestBuilder; -use Test::More tests => 33; +use Test::More tests => 35; use_ok('Koha::Patron::Debarments'); @@ -194,3 +194,25 @@ is( Koha::Patrons->find($borrowernumber3)->debarred, $debarreddate2, 'Koha::Patron->merge_with() transfers well debarred' ); is( Koha::Patrons->find($borrowernumber3)->debarredcomment, $debarredcomment2, 'Koha::Patron->merge_with() transfers well debarredcomment' ); + +# Test removing debartments after payment +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" ); --