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 =item B<--expired_before>
 174
 175 Delete patrons with an account expired before this date.
 176
 177 =item B<--last_seen>
 178
 179 Delete patrons who have not been connected since this date.
 180
 181 The system preference TrackLastPatronActivity must be enabled to use this option.
 182
 183 =item B<--category_code>
 184
 185 Delete patrons who have this category code.
 186
 187 Can be used multiple times for additional category codes.
 188
 189 =item B<--library>
 190
 191 Delete patrons in this library.
 192
 193 =item B<--file>
 194
 195 Delete patrons whose borrower numbers are in this file.  If other criteria are defined
 196 it will only delete those in the file that match those criteria.
 197
 198 =item B<-c|--confirm>
 199
 200 This flag must be provided in order for the script to actually
 201 delete patron records.  If it is not supplied, the script will
 202 only report on the patron records it would have deleted.
 203
 204 =item B<-v|--verbose>
 205
 206 Verbose mode.
 207
 208 =back
 209
 210 =head1 AUTHOR
 211
 212 Jonathan Druart <jonathan.druart@biblibre.com>
 213
 214 =head1 COPYRIGHT
 215
 216 Copyright 2013 BibLibre
 217
 218 =head1 LICENSE
 219
 220 This file is part of Koha.
 221
 222 # Koha is free software; you can redistribute it and/or modify it
 223 # under the terms of the GNU General Public License as published by
 224 # the Free Software Foundation; either version 3 of the License, or
 225 # (at your option) any later version.
 226 #
 227 # Koha is distributed in the hope that it will be useful, but
 228 # WITHOUT ANY WARRANTY; without even the implied warranty of
 229 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
 230 # GNU General Public License for more details.
 231 #
 232 # You should have received a copy of the GNU General Public License
 233 # along with Koha; if not, see <http://www.gnu.org/licenses>.
 234
 235 =cut