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

(-)a/Koha/Account.pm (+3 lines)
Lines 37-42 use Koha::Account::DebitTypes; Link Here
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',
(-)a/Koha/Patron/Debarments.pm (+65 lines)
Lines 20-26 package Koha::Patron::Debarments; Link Here
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 );
(-)a/installer/data/mysql/atomicupdate/Bug_16223_-_Automatically_remove_any_borrower_debarments_after_a_payment.pl (+17 lines)
Line 0 Link Here
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
}
(-)a/installer/data/mysql/sysprefs.sql (+1 lines)
Lines 140-145 INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, ` Link Here
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'),
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/patrons.pref (+11 lines)
Lines 85-90 Patrons: Link Here
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
(-)a/t/db_dependent/Patron/Borrower_Debarments.t (-2 / +22 lines)
Lines 8-14 use Koha::Patrons; Link Here
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" );

Return to bug 16223