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

(-)a/misc/cronjobs/debar_patrons_with_fines.pl (-13 / +27 lines)
Lines 66-73 Confirm that the script should actually undertake the debarments Link Here
66
66
67
=cut
67
=cut
68
68
69
use strict;
69
use Modern::Perl;
70
use warnings;
71
use Getopt::Long qw( GetOptions );
70
use Getopt::Long qw( GetOptions );
72
use Pod::Usage   qw( pod2usage );
71
use Pod::Usage   qw( pod2usage );
73
72
Lines 77-83 use Koha::Patron::Debarments; Link Here
77
76
78
use C4::Log qw( cronlogaction );
77
use C4::Log qw( cronlogaction );
79
78
80
my ( $amount, $help, $confirm, $message, $expiration, $file );
79
my ( $amount, $help, $confirm, $message, $expiration, $file, $verbose );
81
GetOptions(
80
GetOptions(
82
    'a|amount:i'     => \$amount,
81
    'a|amount:i'     => \$amount,
83
    'h|help'         => \$help,
82
    'h|help'         => \$help,
Lines 85-119 GetOptions( Link Here
85
    'm|message:s'    => \$message,
84
    'm|message:s'    => \$message,
86
    'f|file:s'       => \$file,
85
    'f|file:s'       => \$file,
87
    'e|expiration:s' => \$expiration,
86
    'e|expiration:s' => \$expiration,
87
    'v|verbose'      => \$verbose,
88
) || pod2usage(2);
88
) || pod2usage(2);
89
pod2usage(1) if $help;
89
pod2usage(1) if $help;
90
pod2usage(1) unless ( $confirm && ( $message || $file ) );
90
pod2usage(1) unless $message || $file;
91
91
92
cronlogaction();
92
cronlogaction();
93
my $badBorrowers = Koha::Patrons->filter_by_amount_owed( { more_than => $amount // 0 } );
93
my $patrons = Koha::Patrons->filter_by_amount_owed( { more_than => $amount // 0 } );
94
$message = getMessageContent();
94
$message = getMessageContent();
95
95
96
while ( my $bb = $badBorrowers->next ) {
96
my $count_patrons = 0;
97
my $errors        = 0;
98
while ( my $patron = $patrons->next ) {
99
    print "Found patron " . $patron->id . "\n" if $verbose;
100
    if ( !$confirm ) {
101
        $count_patrons++;
102
        next;
103
    }
97
104
98
    #Don't crash, but keep debarring as long as you can!
105
    # Don't crash, but keep debarring as long as you can!
99
    eval {
106
    eval {
100
        my $success = Koha::Patron::Debarments::AddDebarment(
107
        Koha::Patron::Debarments::AddDebarment(
101
            {
108
            {
102
                borrowernumber => $bb->borrowernumber,
109
                borrowernumber => $patron->id,
103
                expiration     => $expiration,
110
                expiration     => $expiration,
104
                type           => 'MANUAL',
111
                type           => 'MANUAL',
105
                comment        => $message,
112
                comment        => $message,
106
            }
113
            }
107
        );
114
        );
108
    };
115
    };
109
    if ($@) {
116
    if ( my $error = $@ ) {
110
        print $@. "\n";
117
        warn 'debarment failed for patron ' . $patron->id . ": $error";
118
        $errors++;
119
        next;
111
    }
120
    }
121
    $count_patrons++;
112
}
122
}
113
123
124
# Print totals
125
my $verb = $confirm ? 'Debarred' : 'Found';
126
print "debar_patrons_with_fines: $verb $count_patrons patrons";
127
print( $errors ? ", had $errors failures\n" : "\n" );
128
114
sub getMessageContent {
129
sub getMessageContent {
115
    return $message if ($message);
130
    return $message if ($message);
116
    open( my $FH, "<:encoding(UTF-8)", $file ) or die "$!\n";
131
    open( my $FH, "<:encoding(UTF-8)", $file ) or die "Could not open $file: $!\n";
117
    my @msg = <$FH>;
132
    my @msg = <$FH>;
118
    close $FH;
133
    close $FH;
119
    return join( "", @msg );
134
    return join( "", @msg );
120
- 

Return to bug 15157