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