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