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

(-)a/misc/debarrBorrowersWithFines.pl (-1 / +90 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, $file);
10
GetOptions(
11
    'h|help'         => \$help,
12
    'c|confirm:s'    => \$confirm,
13
    'm|message:s'    => \$message,
14
    'f|file:s'       => \$file,
15
    'e|expiration:s' => \$expiration,
16
);
17
18
my $HELP = <<HELP;
19
20
debarrBorrowersWithFines.pl
21
22
Creates a debarment for all Borrowers who have fines.
23
24
    -h --help       This friendly reminder!
25
26
    -c --confirm    Confirm that you want to make your Patrons MAD by barring
27
                    them from your library because they have ANY unpaid fines.
28
29
    -m --message     MANDATORY. The description of the debarment visible to the end-user.
30
                     or
31
    -f --messagefile MANDATORY. The file from which to read the message content.
32
33
    -e --expiration OPTIONAL. When does the debarment expire?
34
                    As ISO8601 date, eg  '2015-12-31'
35
36
37
EXAMPLE:
38
39
    debarrBorrowersWithFines.pl --confirm -m "This is a description of you bad deeds"
40
That did almost work.
41
42
    debarrBorrowersWithFines.pl -c MAD -m "You didn't play by our rules!" -e '2015-12-31'
43
    debarrBorrowersWithFines.pl -c MAD -f "/home/koha/kohaclone/messagefile"
44
This works. Always RTFM.
45
46
HELP
47
48
if ($help) {
49
    print $HELP;
50
    exit 0;
51
}
52
elsif (not($confirm) || $confirm ne 'MAD' || (not($message || $file) )) {
53
    print $HELP;
54
    exit 1;
55
}
56
elsif (not($file) && not(length($message) > 20)) {
57
    print $HELP;
58
    print "\nYour --message is too short. A proper message to your end-users must be longer than 20 characters.\n";
59
    exit 1;
60
}
61
62
my $badBorrowers = C4::Accounts::GetAllBorrowersWithUnpaidFines();
63
$message = getMessageContent();
64
65
foreach my $bb (@$badBorrowers) {
66
    #Don't crash, but keep debarring as long as you can!
67
    eval {
68
        my $success = Koha::Borrower::Debarments::AddDebarment({
69
            borrowernumber => $bb->{borrowernumber},
70
            expiration     => $expiration,
71
            type           => 'MANUAL',
72
            comment        => $message,
73
        });
74
    };
75
    if ($@) {
76
        print $@."\n";
77
    }
78
}
79
80
=head getMessageContent
81
Gets either the textual message or slurps a file.
82
=cut
83
84
sub getMessageContent {
85
    return $message if ($message);
86
    open(my $FH, "<:encoding(UTF-8)", $file) or die "$!\n";
87
    my @msg = <$FH>;
88
    close $FH;
89
    return join("",@msg);
90
}

Return to bug 15157