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

(-)a/misc/cronjobs/debar_patrons_with_fines.pl (-1 / +118 lines)
Line 0 Link Here
0
- 
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__

Return to bug 15157