misc/cronjobs/delete_patrons.pl

   1 #!/usr/bin/perl
   2
   3 use Modern::Perl;
   4
   5 use Pod::Usage qw( pod2usage );
   6 use Getopt::Long qw( GetOptions );
   7
   8 use Koha::Script -cron;
   9 use C4::Members qw( GetBorrowersToExpunge );
  10 use Koha::DateUtils qw( dt_from_string );
  11 use Koha::Patrons;
  12 use C4::Log qw( cronlogaction );
  13
  14 my ( $help, $verbose, $not_borrowed_since, $expired_before, $last_seen,
  15     @category_code, $branchcode, $file, $confirm );
  16
  17 my $command_line_options = join(" ",@ARGV);
  18
  19 GetOptions(
  20     'h|help'                 => \$help,
  21     'v|verbose'              => \$verbose,
  22     'not_borrowed_since:s'   => \$not_borrowed_since,
  23     'expired_before:s'       => \$expired_before,
  24     'last_seen:s'            => \$last_seen,
  25     'category_code:s'        => \@category_code,
  26     'library:s'              => \$branchcode,
  27     'file:s'                 => \$file,
  28     'c|confirm'              => \$confirm,
  29 ) || pod2usage(1);
  30
  31 if ($help) {
  32     pod2usage(1);
  33 }
  34
  35 $not_borrowed_since = dt_from_string( $not_borrowed_since, 'iso' )
  36   if $not_borrowed_since;
  37
  38 $expired_before = dt_from_string( $expired_before, 'iso' )
  39   if $expired_before;
  40
  41 if ( $last_seen and not C4::Context->preference('TrackLastPatronActivity') ) {
  42     pod2usage(q{The --last_seen option cannot be used with TrackLastPatronActivity turned off});
  43 }
  44
  45 unless ( $not_borrowed_since or $expired_before or $last_seen or @category_code or $branchcode or $file ) {
  46     pod2usage(q{At least one filter is mandatory});
  47 }
  48
  49 cronlogaction({ info => $command_line_options });
  50
  51 my @file_members;
  52 if ($file) {
  53     open(my $fh, '<:encoding(UTF-8)', $file) or die "Could not open file $file' $!";
  54     while (my $line = <$fh>) {
  55         chomp($line);
  56         my %fm = ('borrowernumber' => $line);
  57         my $fm_ref = \%fm;
  58         push @file_members, $fm_ref;
  59     }
  60     close $fh;
  61 }
  62
  63 my $members;
  64 if ( $not_borrowed_since or $expired_before or $last_seen or @category_code or $branchcode ) {
  65     $members = GetBorrowersToExpunge(
  66         {
  67             not_borrowed_since   => $not_borrowed_since,
  68             expired_before       => $expired_before,
  69             last_seen            => $last_seen,
  70             category_code        => \@category_code,
  71             branchcode           => $branchcode,
  72         }
  73     );
  74 }
  75
  76 if ($members and @file_members) {
  77     my @filtered_members;
  78     for my $member (@$members) {
  79         for my $fm (@file_members) {
  80             if ($member->{borrowernumber} eq $fm->{borrowernumber}) {
  81                 push @filtered_members, $fm;
  82             }
  83         }
  84     }
  85     $members = \@filtered_members;
  86 }
  87
  88 if (!defined $members and @file_members) {
  89    $members = \@file_members;
  90 }
  91
  92 unless ($confirm) {
  93     say "Doing a dry run; no patron records will actually be deleted.";
  94     say "Run again with --confirm to delete the records.";
  95     $verbose ||= 1;
  96 }
  97
  98 say scalar(@$members) . " patrons match conditions" if $verbose;;
  99
 100 my $anonymous_patron = C4::Context->preference("AnonymousPatron");
 101 my $deleted = 0;
 102 for my $member (@$members) {
 103     print "Testing that we can delete patron $member->{borrowernumber}... "
 104       if $verbose;
 105
 106     my $borrowernumber = $member->{borrowernumber};
 107     my $patron = Koha::Patrons->find( $borrowernumber );
 108     unless ( $patron ) {
 109         say "Cannot delete: Patron with borrowernumber $borrowernumber does not exist";
 110         next;
 111     }
 112     if ( my $charges = $patron->account->non_issues_charges ) { # And what if we owe to this patron?
 113         say "Cannot delete patron $borrowernumber: patron has $charges in fines" if $verbose;
 114         next;
 115     }
 116
 117     if ( $anonymous_patron ) {
 118         if ( $patron->id eq $anonymous_patron ) {
 119             say "Cannot delete patron $borrowernumber: patron is AnonymousPatron";
 120             next;
 121         }
 122     }
 123
 124     if ( $confirm ) {
 125         my $deleted = eval { $patron->move_to_deleted; };
 126         if ($@ or not $deleted) {
 127             say "Cannot delete patron $borrowernumber, cannot move it" . ( $@ ? ": ($@)" : "" ) if $verbose;
 128             next;
 129         }
 130
 131         eval { $patron->delete };
 132         if ($@) {
 133             say "Cannot delete patron $borrowernumber: $@)";
 134             next;
 135         }
 136     }
 137     $deleted++;
 138     say "OK" if $verbose;
 139 }
 140
 141
 142 say $confirm ? "$deleted patrons deleted" : "$deleted patrons would have been deleted" if $verbose;
 143
 144 cronlogaction({ action => 'End', info => "COMPLETED" });
 145
 146 =head1 NAME
 147
 148 delete_patrons - This script deletes patrons
 149
 150 =head1 SYNOPSIS
 151
 152 delete_patrons.pl [-h|--help] [-v|--verbose] [-c|--confirm] [--not_borrowed_since=DATE] [--expired_before=DATE] [--last-seen=DATE] [--category_code=CAT] [--category_code=CAT ...] [--library=LIBRARY] [--file=FILE]
 153
 154 Dates should be in ISO format, e.g., 2013-07-19, and can be generated
 155 with `date -d '-3 month' --iso-8601`.
 156
 157 The options to select the patron records to delete are cumulative.  For
 158 example, supplying both --expired_before and --library specifies that
 159 that patron records must meet both conditions to be selected for deletion.
 160
 161 =head1 OPTIONS
 162
 163 =over
 164
 165 =item B<-h|--help>
 166
 167 Print a brief help message
 168
 169 =item B<--not_borrowed_since>
 170
 171 Delete patrons who have not borrowed since this date.
 172
 173 NOTE: Patrons who have all their old loans anonymized will
 174 have an empty loan history and be deleted if this option is
 175 used. Anonymization can happen because the patron has
 176 borrowers.privacy = 2, through cronjobs doing anonymization
 177 or by the patron choosing to anonymize their history in the
 178 OPAC.
 179
 180 =item B<--expired_before>
 181
 182 Delete patrons with an account expired before this date.
 183
 184 =item B<--last_seen>
 185
 186 Delete patrons who have not been connected since this date.
 187
 188 The system preference TrackLastPatronActivity must be enabled to use this option.
 189
 190 =item B<--category_code>
 191
 192 Delete patrons who have this category code.
 193
 194 Can be used multiple times for additional category codes.
 195
 196 =item B<--library>
 197
 198 Delete patrons in this library.
 199
 200 =item B<--file>
 201
 202 Delete patrons whose borrower numbers are in this file.  If other criteria are defined
 203 it will only delete those in the file that match those criteria.
 204
 205 =item B<-c|--confirm>
 206
 207 This flag must be provided in order for the script to actually
 208 delete patron records.  If it is not supplied, the script will
 209 only report on the patron records it would have deleted.
 210
 211 =item B<-v|--verbose>
 212
 213 Verbose mode.
 214
 215 =back
 216
 217 =head1 AUTHOR
 218
 219 Jonathan Druart <jonathan.druart@biblibre.com>
 220
 221 =head1 COPYRIGHT
 222
 223 Copyright 2013 BibLibre
 224
 225 =head1 LICENSE
 226
 227 This file is part of Koha.
 228
 229 # Koha is free software; you can redistribute it and/or modify it
 230 # under the terms of the GNU General Public License as published by
 231 # the Free Software Foundation; either version 3 of the License, or
 232 # (at your option) any later version.
 233 #
 234 # Koha is distributed in the hope that it will be useful, but
 235 # WITHOUT ANY WARRANTY; without even the implied warranty of
 236 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
 237 # GNU General Public License for more details.
 238 #
 239 # You should have received a copy of the GNU General Public License
 240 # along with Koha; if not, see <http://www.gnu.org/licenses>.
 241
 242 =cut