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 |
- |
|
|