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

(-)a/C4/Accounts.pm (+7 lines)
Lines 25-30 use C4::Stats; Link Here
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
(-)a/Koha/Patron/Debarments.pm (+64 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;
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 );
(-)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 103-108 INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, ` Link Here
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'),
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/patrons.pref (+11 lines)
Lines 50-55 Patrons: Link Here
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
(-)a/t/db_dependent/Patron/Borrower_Debarments.t (-2 / +23 lines)
Lines 8-14 use Koha::Database; 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( 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

Return to bug 16223