From 402f2ed49fb313e0f1f9c928f18b17b204322a0a Mon Sep 17 00:00:00 2001 From: Martin Renvoize Date: Wed, 15 Sep 2021 15:27:45 +0100 Subject: [PATCH] Bug 15157: Modernise and Update for bug 15156 This patch updates the script to use filter_by_amount_owed, renames it to debar_patrons_with_fines.pl and moves it to the cronjobs directory whilst also adding a copyright notice and POD. We could add a series of options to the script to allow more fine grained control. --- misc/cronjobs/debar_patrons_with_fines.pl | 118 ++++++++++++++++++++++ misc/debarrBorrowersWithFines.pl | 91 ----------------- 2 files changed, 118 insertions(+), 91 deletions(-) create mode 100755 misc/cronjobs/debar_patrons_with_fines.pl delete mode 100644 misc/debarrBorrowersWithFines.pl diff --git a/misc/cronjobs/debar_patrons_with_fines.pl b/misc/cronjobs/debar_patrons_with_fines.pl new file mode 100755 index 0000000000..f41987e989 --- /dev/null +++ b/misc/cronjobs/debar_patrons_with_fines.pl @@ -0,0 +1,118 @@ +#!/usr/bin/perl + +# Copyright 2022 PTFS Europe +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . + +=head1 NAME + +debar_patrons_with_fines.pl - Creates a debarment for all Patrons who have outstanding fines. + +=head1 SYNOPSIS + + debar_patrons_with_fines.pl --help + debar_patrons_with_fines.pl -m "Message for user" + debar_patrons_with_fines.pl -f "/var/lib/koha/site/debar_message.txt" + debar_patrons_with_fines.pl -m "Message for user" -e '2022-12-31' + +=head1 DESCRIPTION + +This script can be used to automatically debar patrons who have an outstanding +debt to the library. + +=head1 OPTIONS + +=over 8 + +=item B<-h|--help> + +Display the help message and exit + +=item B<-m|--message> + +Add the passed message in the debarment comment + +=item B<-f|--messagefile> + +Add the content of the passed file in the debarment comment + +=item B<-e|--expiration> + +Expire the added debarment on the passed date + +=item B<-c|--confirm> + +Confirm that the script should actually undertake the debarments + +=back + +=cut + +use strict; +use warnings; +use Getopt::Long qw( GetOptions ); +use Pod::Usage qw( pod2usage ); + +use Koha::Script -cron; +use Koha::Patrons; +use Koha::Patron::Debarments; + +use C4::Log qw( cronlogaction ); + +my ( $help, $confirm, $message, $expiration, $file ); +GetOptions( + 'h|help' => \$help, + 'c|confirm:s' => \$confirm, + 'm|message:s' => \$message, + 'f|file:s' => \$file, + 'e|expiration:s' => \$expiration, +) || pod2usage(2); +pod2usage(1) if $help; +pod2usage(1) unless ( $confirm && ( $message || $file )); + +cronlogaction(); +my $badBorrowers = Koha::Patrons->filter_by_amount_owed( { more_than => 0 } ); +$message = getMessageContent(); + +while ( my $bb = $badBorrowers->next ) { + + #Don't crash, but keep debarring as long as you can! + eval { + my $success = Koha::Patron::Debarments::AddDebarment( + { + borrowernumber => $bb->borrowernumber, + expiration => $expiration, + type => 'MANUAL', + comment => $message, + } + ); + }; + if ($@) { + print $@. "\n"; + } +} + +sub getMessageContent { + return $message if ($message); + open( my $FH, "<:encoding(UTF-8)", $file ) or die "$!\n"; + my @msg = <$FH>; + close $FH; + return join( "", @msg ); +} + +1; + +__END__ diff --git a/misc/debarrBorrowersWithFines.pl b/misc/debarrBorrowersWithFines.pl deleted file mode 100644 index fb46a6f351..0000000000 --- a/misc/debarrBorrowersWithFines.pl +++ /dev/null @@ -1,91 +0,0 @@ -#!/usr/bin/perl - -use Modern::Perl; -use Getopt::Long; - -use C4::Accounts; -use Koha::Patrons; -use Koha::Patron::Debarments; - -my ($help, $confirm, $message, $expiration, $file); -GetOptions( - 'h|help' => \$help, - 'c|confirm:s' => \$confirm, - 'm|message:s' => \$message, - 'f|file:s' => \$file, - 'e|expiration:s' => \$expiration, -); - -my $HELP = < 20)) { - print $HELP; - print "\nYour --message is too short. A proper message to your end-users must be longer than 20 characters.\n"; - exit 1; -} - -my $badBorrowers = Koha::Patrons->search->search_patrons_with_unpaid_fines(); -$message = getMessageContent(); - -foreach my $bb (@$badBorrowers) { - #Don't crash, but keep debarring as long as you can! - eval { - my $success = Koha::Patron::Debarments::AddDebarment({ - borrowernumber => $bb->{borrowernumber}, - expiration => $expiration, - type => 'MANUAL', - comment => $message, - }); - }; - if ($@) { - print $@."\n"; - } -} - -=head getMessageContent -Gets either the textual message or slurps a file. -=cut - -sub getMessageContent { - return $message if ($message); - open(my $FH, "<:encoding(UTF-8)", $file) or die "$!\n"; - my @msg = <$FH>; - close $FH; - return join("",@msg); -} \ No newline at end of file -- 2.20.1