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

(-)a/misc/debarrBorrowersWithFines.pl (-1 / +73 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
use Modern::Perl;
4
use Getopt::Long;
5
6
use C4::Accounts;
7
use Koha::Borrower::Debarments;
8
9
my ($help, $confirm, $message, $expiration);
10
GetOptions(
11
    'h|help'         => \$help,
12
    'c|confirm:s'    => \$confirm,
13
    'm|message:s'    => \$message,
14
    'e|expiration:s' => \$expiration,
15
);
16
17
my $HELP = <<HELP;
18
19
debarrBorrowersWithFines.pl
20
21
Creates a debarment for all Borrowers who have fines.
22
23
    -h --help       This friendly reminder!
24
25
    -c --confirm    Confirm that you want to make your Patrons MAD by barring
26
                    them from your library because they have ANY unpaid fines.
27
28
    -m --message    MANDATORY. The description of the debarment visible to the end-user.
29
30
    -e --expiration OPTIONAL. When does the debarment expire?
31
                    As ISO8601 date, eg  '2015-12-31'
32
33
34
EXAMPLE:
35
36
    debarrBorrowersWithFines.pl --confirm -m "This is a description of you bad deeds"
37
That did almost work.
38
39
    debarrBorrowersWithFines.pl -c MAD -m "You didn't play by our rules!" -e '2015-12-31'
40
This works. Always RTFM.
41
42
HELP
43
44
if ($help) {
45
    print $HELP;
46
    exit 0;
47
}
48
elsif (not($confirm) || $confirm ne 'MAD' || not($message)) {
49
    print $HELP;
50
    exit 1;
51
}
52
elsif (not(length($message) > 20)) {
53
    print $HELP;
54
    print "\nYour --message is too short. A proper message to your end-users must be longer than 20 characters.\n";
55
    exit 1;
56
}
57
58
my $badBorrowers = C4::Accounts::GetAllBorrowersWithUnpaidFines();
59
60
foreach my $bb (@$badBorrowers) {
61
    #Don't crash, but keep debarring as long as you can!
62
    eval {
63
        my $success = Koha::Borrower::Debarments::AddDebarment({
64
            borrowernumber => $bb->{borrowernumber},
65
            expiration     => $expiration,
66
            type           => 'MANUAL',
67
            comment        => $message,
68
        });
69
    };
70
    if ($@) {
71
        print $@."\n";
72
    }
73
}

Return to bug 15157