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 $anonymous_patron = C4::Context->preference("AnonymousPatron");
  98 my $deleted = 0;
  99 for my $member (@$members) {
 100     print "Trying to delete patron $member->{borrowernumber}... "
 101       if $verbose;
 102
 103     my $borrowernumber = $member->{borrowernumber};
 104     my $patron = Koha::Patrons->find( $borrowernumber );
 105     unless ( $patron ) {
 106         say "Patron with borrowernumber $borrowernumber does not exist";
 107         next;
 108     }
 109     if ( my $charges = $patron->account->non_issues_charges ) { # And what if we owe to this patron?
 110         say "Failed to delete patron $borrowernumber: patron has $charges in fines" if $verbose;
 111         next;
 112     }
 113
 114     if ( $anonymous_patron ) {
 115         if ( $patron->id eq $anonymous_patron ) {
 116             say "Failed to delete patron $borrowernumber: patron is AnonymousPatron";
 117             next;
 118         }
 119     }
 120
 121     if ( $confirm ) {
 122         my $deleted = eval { $patron->move_to_deleted; };
 123         if ($@ or not $deleted) {
 124             say "Failed to delete patron $borrowernumber, cannot move it" . ( $@ ? ": ($@)" : "" ) if $verbose;
 125             next;
 126         }
 127
 128         eval { $patron->delete };
 129         if ($@) {
 130             say "Failed to delete patron $borrowernumber: $@)";
 131             next;
 132         }
 133     }
 134     $deleted++;
 135     say "OK" if $verbose;
 136 }
 137
 138 say "$deleted patrons deleted" if $verbose;
 139
 140 =head1 NAME
 141
 142 delete_patrons - This script deletes patrons
 143
 144 =head1 SYNOPSIS
 145
 146 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]
 147
 148 Dates should be in ISO format, e.g., 2013-07-19, and can be generated
 149 with `date -d '-3 month' --iso-8601`.
 150
 151 The options to select the patron records to delete are cumulative.  For
 152 example, supplying both --expired_before and --library specifies that
 153 that patron records must meet both conditions to be selected for deletion.
 154
 155 =head1 OPTIONS
 156
 157 =over
 158
 159 =item B<-h|--help>
 160
 161 Print a brief help message
 162
 163 =item B<--not_borrowed_since>
 164
 165 Delete patrons who have not borrowed since this date.
 166
 167 =item B<--expired_before>
 168
 169 Delete patrons with an account expired before this date.
 170
 171 =item B<--last_seen>
 172
 173 Delete patrons who have not been connected since this date.
 174
 175 The system preference TrackLastPatronActivity must be enabled to use this option.
 176
 177 =item B<--category_code>
 178
 179 Delete patrons who have this category code.
 180
 181 =item B<--library>
 182
 183 Delete patrons in this library.
 184
 185 =item B<--file>
 186
 187 Delete patrons whose borrower numbers are in this file.  If other criteria are defined
 188 it will only delete those in the file that match those criteria.
 189
 190 =item B<-c|--confirm>
 191
 192 This flag must be provided in order for the script to actually
 193 delete patron records.  If it is not supplied, the script will
 194 only report on the patron records it would have deleted.
 195
 196 =item B<-v|--verbose>
 197
 198 Verbose mode.
 199
 200 =back
 201
 202 =head1 AUTHOR
 203
 204 Jonathan Druart <jonathan.druart@biblibre.com>
 205
 206 =head1 COPYRIGHT
 207
 208 Copyright 2013 BibLibre
 209
 210 =head1 LICENSE
 211
 212 This file is part of Koha.
 213
 214 # Koha is free software; you can redistribute it and/or modify it
 215 # under the terms of the GNU General Public License as published by
 216 # the Free Software Foundation; either version 3 of the License, or
 217 # (at your option) any later version.
 218 #
 219 # Koha is distributed in the hope that it will be useful, but
 220 # WITHOUT ANY WARRANTY; without even the implied warranty of
 221 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
 222 # GNU General Public License for more details.
 223 #
 224 # You should have received a copy of the GNU General Public License
 225 # along with Koha; if not, see <http://www.gnu.org/licenses>.
 226
 227 =cut