misc/cronjobs/delete_patrons.pl

   1 #!/usr/bin/perl
   2
   3 use Modern::Perl;
   4
   5 use Pod::Usage;
   6 use Getopt::Long;
   7
   8 use Koha::Script -cron;
   9 use C4::Members;
  10 use Koha::DateUtils;
  11 use Koha::Patrons;
  12 use C4::Log;
  13
  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);
  27
  28 if ($help) {
  29     pod2usage(1);
  30 }
  31
  32 $not_borrowed_since = dt_from_string( $not_borrowed_since, 'iso' )
  33   if $not_borrowed_since;
  34
  35 $expired_before = dt_from_string( $expired_before, 'iso' )
  36   if $expired_before;
  37
  38 if ( $last_seen and not C4::Context->preference('TrackLastPatronActivity') ) {
  39     pod2usage(q{The --last_seen option cannot be used with TrackLastPatronActivity turned off});
  40 }
  41
  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});
  44 }
  45
  46 cronlogaction();
  47
  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;
  56     }
  57     close $fh;
  58 }
  59
  60 my $members;
  61 if ( $not_borrowed_since or $expired_before or $last_seen or $category_code or $branchcode ) {
  62     $members = GetBorrowersToExpunge(
  63         {
  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,
  69         }
  70     );
  71 }
  72
  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;
  79             }
  80         }
  81     }
  82     $members = \@filtered_members;
  83 }
  84
  85 if (!defined $members and @file_members) {
  86    $members = \@file_members;
  87 }
  88
  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;
  93 }
  94
  95 say scalar(@$members) . " patrons to delete" if $verbose;;
  96
  97 my $deleted = 0;
  98 for my $member (@$members) {
  99     print "Trying to delete patron $member->{borrowernumber}... "
 100       if $verbose;
 101
 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;
 107     }
 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;
 111     }
 112
 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;
 118         }
 119
 120         eval { $patron->delete };
 121         if ($@) {
 122             say "Failed to delete patron $borrowernumber: $@)";
 123             next;
 124         }
 125     }
 126     $deleted++;
 127     say "OK" if $verbose;
 128 }
 129
 130 say "$deleted patrons deleted" if $verbose;
 131
 132 =head1 NAME
 133
 134 delete_patrons - This script deletes patrons
 135
 136 =head1 SYNOPSIS
 137
 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]
 139
 140 Dates should be in ISO format, e.g., 2013-07-19, and can be generated
 141 with `date -d '-3 month' --iso-8601`.
 142
 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.
 146
 147 =head1 OPTIONS
 148
 149 =over
 150
 151 =item B<-h|--help>
 152
 153 Print a brief help message
 154
 155 =item B<--not_borrowed_since>
 156
 157 Delete patrons who have not borrowed since this date.
 158
 159 =item B<--expired_before>
 160
 161 Delete patrons with an account expired before this date.
 162
 163 =item B<--last_seen>
 164
 165 Delete patrons who have not been connected since this date.
 166
 167 The system preference TrackLastPatronActivity must be enabled to use this option.
 168
 169 =item B<--category_code>
 170
 171 Delete patrons who have this category code.
 172
 173 =item B<--library>
 174
 175 Delete patrons in this library.
 176
 177 =item B<--file>
 178
 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.
 181
 182 =item B<-c|--confirm>
 183
 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.
 187
 188 =item B<-v|--verbose>
 189
 190 Verbose mode.
 191
 192 =back
 193
 194 =head1 AUTHOR
 195
 196 Jonathan Druart <jonathan.druart@biblibre.com>
 197
 198 =head1 COPYRIGHT
 199
 200 Copyright 2013 BibLibre
 201
 202 =head1 LICENSE
 203
 204 This file is part of Koha.
 205
 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.
 210 #
 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.
 215 #
 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>.
 218
 219 =cut