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