Bug 21395: Make perlcritic happy
[koha.git] / misc / cronjobs / delete_patrons.pl
blob3d25cb743abed87c5f2c21bc9577721abda9811e
1 #!/usr/bin/perl
3 use Modern::Perl;
5 use Pod::Usage;
6 use Getopt::Long;
8 use Koha::Script -cron;
9 use C4::Members;
10 use Koha::DateUtils;
11 use Koha::Patrons;
12 use C4::Log;
14 my ( $help, $verbose, $not_borrowed_since, $expired_before, $last_seen,
15 $category_code, $branchcode, $file, $confirm );
16 GetOptions(
17 'h|help' => \$help,
18 'v|verbose' => \$verbose,
19 'not_borrowed_since:s' => \$not_borrowed_since,
20 'expired_before:s' => \$expired_before,
21 'last_seen:s' => \$last_seen,
22 'category_code:s' => \$category_code,
23 'library:s' => \$branchcode,
24 'file:s' => \$file,
25 'c|confirm' => \$confirm,
26 ) || pod2usage(1);
28 if ($help) {
29 pod2usage(1);
32 $not_borrowed_since = dt_from_string( $not_borrowed_since, 'iso' )
33 if $not_borrowed_since;
35 $expired_before = dt_from_string( $expired_before, 'iso' )
36 if $expired_before;
38 if ( $last_seen and not C4::Context->preference('TrackLastPatronActivity') ) {
39 pod2usage(q{The --last_seen option cannot be used with TrackLastPatronActivity turned off});
42 unless ( $not_borrowed_since or $expired_before or $last_seen or $category_code or $branchcode or $file ) {
43 pod2usage(q{At least one filter is mandatory});
46 cronlogaction();
48 my @file_members;
49 if ($file) {
50 open(my $fh, '<:encoding(UTF-8)', $file) or die "Could not open file $file' $!";
51 while (my $line = <$fh>) {
52 chomp($line);
53 my %fm = ('borrowernumber' => $line);
54 my $fm_ref = \%fm;
55 push @file_members, $fm_ref;
57 close $fh;
60 my $members;
61 if ( $not_borrowed_since or $expired_before or $last_seen or $category_code or $branchcode ) {
62 $members = GetBorrowersToExpunge(
64 not_borrowed_since => $not_borrowed_since,
65 expired_before => $expired_before,
66 last_seen => $last_seen,
67 category_code => $category_code,
68 branchcode => $branchcode,
73 if ($members and @file_members) {
74 my @filtered_members;
75 for my $member (@$members) {
76 for my $fm (@file_members) {
77 if ($member->{borrowernumber} eq $fm->{borrowernumber}) {
78 push @filtered_members, $fm;
82 $members = \@filtered_members;
85 if (!defined $members and @file_members) {
86 $members = \@file_members;
89 unless ($confirm) {
90 say "Doing a dry run; no patron records will actually be deleted.";
91 say "Run again with --confirm to delete the records.";
92 $verbose ||= 1;
95 say scalar(@$members) . " patrons to delete" if $verbose;;
97 my $deleted = 0;
98 for my $member (@$members) {
99 print "Trying to delete patron $member->{borrowernumber}... "
100 if $verbose;
102 my $borrowernumber = $member->{borrowernumber};
103 my $patron = Koha::Patrons->find( $borrowernumber );
104 unless ( $patron ) {
105 say "Patron with borrowernumber $borrowernumber does not exist";
106 next;
108 if ( my $charges = $patron->account->non_issues_charges ) { # And what if we owe to this patron?
109 say "Failed to delete patron $borrowernumber: patron has $charges in fines" if $verbose;
110 next;
113 if ( $confirm ) {
114 my $deleted = eval { $patron->move_to_deleted; };
115 if ($@ or not $deleted) {
116 say "Failed to delete patron $borrowernumber, cannot move it" . ( $@ ? ": ($@)" : "" ) if $verbose;
117 next;
120 eval { $patron->delete };
121 if ($@) {
122 say "Failed to delete patron $borrowernumber: $@)";
123 next;
126 $deleted++;
127 say "OK" if $verbose;
130 say "$deleted patrons deleted" if $verbose;
132 =head1 NAME
134 delete_patrons - This script deletes patrons
136 =head1 SYNOPSIS
138 delete_patrons.pl [-h|--help] [-v|--verbose] [-c|--confirm] [--not_borrowed_since=DATE] [--expired_before=DATE] [--last-seen=DATE] [--category_code=CAT] [--library=LIBRARY] [--file=FILE]
140 Dates should be in ISO format, e.g., 2013-07-19, and can be generated
141 with `date -d '-3 month' --iso-8601`.
143 The options to select the patron records to delete are cumulative. For
144 example, supplying both --expired_before and --library specifies that
145 that patron records must meet both conditions to be selected for deletion.
147 =head1 OPTIONS
149 =over
151 =item B<-h|--help>
153 Print a brief help message
155 =item B<--not_borrowed_since>
157 Delete patrons who have not borrowed since this date.
159 =item B<--expired_before>
161 Delete patrons with an account expired before this date.
163 =item B<--last_seen>
165 Delete patrons who have not been connected since this date.
167 The system preference TrackLastPatronActivity must be enabled to use this option.
169 =item B<--category_code>
171 Delete patrons who have this category code.
173 =item B<--library>
175 Delete patrons in this library.
177 =item B<--file>
179 Delete patrons whose borrower numbers are in this file. If other criteria are defined
180 it will only delete those in the file that match those criteria.
182 =item B<-c|--confirm>
184 This flag must be provided in order for the script to actually
185 delete patron records. If it is not supplied, the script will
186 only report on the patron records it would have deleted.
188 =item B<-v|--verbose>
190 Verbose mode.
192 =back
194 =head1 AUTHOR
196 Jonathan Druart <jonathan.druart@biblibre.com>
198 =head1 COPYRIGHT
200 Copyright 2013 BibLibre
202 =head1 LICENSE
204 This file is part of Koha.
206 # Koha is free software; you can redistribute it and/or modify it
207 # under the terms of the GNU General Public License as published by
208 # the Free Software Foundation; either version 3 of the License, or
209 # (at your option) any later version.
211 # Koha is distributed in the hope that it will be useful, but
212 # WITHOUT ANY WARRANTY; without even the implied warranty of
213 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
214 # GNU General Public License for more details.
216 # You should have received a copy of the GNU General Public License
217 # along with Koha; if not, see <http://www.gnu.org/licenses>.
219 =cut