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

(-)a/misc/cronjobs/debar_patrons_with_fines.pl (+118 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright 2022 PTFS Europe
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
=head1 NAME
21
22
debar_patrons_with_fines.pl - Creates a debarment for all Patrons who have outstanding fines.
23
24
=head1 SYNOPSIS
25
26
    debar_patrons_with_fines.pl --help
27
    debar_patrons_with_fines.pl -m "Message for user"
28
    debar_patrons_with_fines.pl -f "/var/lib/koha/site/debar_message.txt"
29
    debar_patrons_with_fines.pl -m "Message for user" -e '2022-12-31'
30
31
=head1 DESCRIPTION
32
33
This script can be used to automatically debar patrons who have an outstanding
34
debt to the library.
35
36
=head1 OPTIONS
37
38
=over 8
39
40
=item B<-h|--help>
41
42
Display the help message and exit
43
44
=item B<-m|--message>
45
46
Add the passed message in the debarment comment
47
48
=item B<-f|--messagefile>
49
50
Add the content of the passed file in the debarment comment
51
52
=item B<-e|--expiration>
53
54
Expire the added debarment on the passed date
55
56
=item B<-c|--confirm>
57
58
Confirm that the script should actually undertake the debarments
59
60
=back
61
62
=cut
63
64
use strict;
65
use warnings;
66
use Getopt::Long qw( GetOptions );
67
use Pod::Usage qw( pod2usage );
68
69
use Koha::Script -cron;
70
use Koha::Patrons;
71
use Koha::Patron::Debarments;
72
73
use C4::Log qw( cronlogaction );
74
75
my ( $help, $confirm, $message, $expiration, $file );
76
GetOptions(
77
    'h|help'         => \$help,
78
    'c|confirm:s'    => \$confirm,
79
    'm|message:s'    => \$message,
80
    'f|file:s'       => \$file,
81
    'e|expiration:s' => \$expiration,
82
) || pod2usage(2);
83
pod2usage(1) if $help;
84
pod2usage(1) unless ( $confirm && ( $message || $file ));
85
86
cronlogaction();
87
my $badBorrowers = Koha::Patrons->filter_by_amount_owed( { more_than => 0 } );
88
$message = getMessageContent();
89
90
while ( my $bb = $badBorrowers->next ) {
91
92
    #Don't crash, but keep debarring as long as you can!
93
    eval {
94
        my $success = Koha::Patron::Debarments::AddDebarment(
95
            {
96
                borrowernumber => $bb->borrowernumber,
97
                expiration     => $expiration,
98
                type           => 'MANUAL',
99
                comment        => $message,
100
            }
101
        );
102
    };
103
    if ($@) {
104
        print $@. "\n";
105
    }
106
}
107
108
sub getMessageContent {
109
    return $message if ($message);
110
    open( my $FH, "<:encoding(UTF-8)", $file ) or die "$!\n";
111
    my @msg = <$FH>;
112
    close $FH;
113
    return join( "", @msg );
114
}
115
116
1;
117
118
__END__
(-)a/misc/debarrBorrowersWithFines.pl (-92 lines)
Lines 1-91 Link Here
1
#!/usr/bin/perl
2
3
use Modern::Perl;
4
use Getopt::Long;
5
6
use C4::Accounts;
7
use Koha::Patrons;
8
use Koha::Patron::Debarments;
9
10
my ($help, $confirm, $message, $expiration, $file);
11
GetOptions(
12
    'h|help'         => \$help,
13
    'c|confirm:s'    => \$confirm,
14
    'm|message:s'    => \$message,
15
    'f|file:s'       => \$file,
16
    'e|expiration:s' => \$expiration,
17
);
18
19
my $HELP = <<HELP;
20
21
debarrBorrowersWithFines.pl
22
23
Creates a debarment for all Borrowers who have fines.
24
25
    -h --help       This friendly reminder!
26
27
    -c --confirm    Confirm that you want to make your Patrons MAD by barring
28
                    them from your library because they have ANY unpaid fines.
29
30
    -m --message     MANDATORY. The description of the debarment visible to the end-user.
31
                     or
32
    -f --messagefile MANDATORY. The file from which to read the message content.
33
34
    -e --expiration OPTIONAL. When does the debarment expire?
35
                    As ISO8601 date, eg  '2015-12-31'
36
37
38
EXAMPLE:
39
40
    debarrBorrowersWithFines.pl --confirm -m "This is a description of you bad deeds"
41
That did almost work.
42
43
    debarrBorrowersWithFines.pl -c MAD -m "You didn't play by our rules!" -e '2015-12-31'
44
    debarrBorrowersWithFines.pl -c MAD -f "/home/koha/kohaclone/messagefile"
45
This works. Always RTFM.
46
47
HELP
48
49
if ($help) {
50
    print $HELP;
51
    exit 0;
52
}
53
elsif (not($confirm) || $confirm ne 'MAD' || (not($message || $file) )) {
54
    print $HELP;
55
    exit 1;
56
}
57
elsif (not($file) && not(length($message) > 20)) {
58
    print $HELP;
59
    print "\nYour --message is too short. A proper message to your end-users must be longer than 20 characters.\n";
60
    exit 1;
61
}
62
63
my $badBorrowers = Koha::Patrons->search->search_patrons_with_unpaid_fines();
64
$message = getMessageContent();
65
66
foreach my $bb (@$badBorrowers) {
67
    #Don't crash, but keep debarring as long as you can!
68
    eval {
69
        my $success = Koha::Patron::Debarments::AddDebarment({
70
            borrowernumber => $bb->{borrowernumber},
71
            expiration     => $expiration,
72
            type           => 'MANUAL',
73
            comment        => $message,
74
        });
75
    };
76
    if ($@) {
77
        print $@."\n";
78
    }
79
}
80
81
=head getMessageContent
82
Gets either the textual message or slurps a file.
83
=cut
84
85
sub getMessageContent {
86
    return $message if ($message);
87
    open(my $FH, "<:encoding(UTF-8)", $file) or die "$!\n";
88
    my @msg = <$FH>;
89
    close $FH;
90
    return join("",@msg);
91
}
92
- 

Return to bug 15157