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 C4::Members;
   9 use C4::VirtualShelves;
  10 use Koha::DateUtils;
  11
  12 my ( $help, $verbose, $not_borrowed_since, $expired_before, $category_code,
  13     $branchcode, $confirm );
  14 GetOptions(
  15     'h|help'                 => \$help,
  16     'v|verbose'              => \$verbose,
  17     'not_borrowed_since:s'   => \$not_borrowed_since,
  18     'expired_before:s'       => \$expired_before,
  19     'category_code:s'        => \$category_code,
  20     'library:s'              => \$branchcode,
  21     'c|confirm'              => \$confirm,
  22 ) || pod2usage(1);
  23
  24 if ($help) {
  25     pod2usage(1);
  26 }
  27
  28 $not_borrowed_since = dt_from_string( $not_borrowed_since, 'iso' )
  29   if $not_borrowed_since;
  30
  31 $expired_before = dt_from_string( $expired_before, 'iso' )
  32   if $expired_before;
  33
  34 unless ( $not_borrowed_since or $expired_before or $category_code or $branchcode ) {
  35     pod2usage(q{At least one filter is mandatory});
  36     exit;
  37 }
  38
  39 my $members = GetBorrowersToExpunge(
  40     {
  41         not_borrowered_since => $not_borrowed_since,
  42         expired_before       => $expired_before,
  43         category_code        => $category_code,
  44         branchcode           => $branchcode,
  45     }
  46 );
  47
  48 unless ($confirm) {
  49     say "Doing a dry run; no patron records will actually be deleted.";
  50     say "Run again with --confirm to delete the records.";
  51 }
  52
  53 say scalar(@$members) . " patrons to delete";
  54
  55 my $dbh = C4::Context->dbh;
  56 $dbh->{RaiseError} = 1;
  57 $dbh->{PrintError} = 0;
  58
  59 $dbh->{AutoCommit} = 0; # use transactions to avoid partial deletes
  60 my $deleted = 0;
  61 for my $member (@$members) {
  62     print "Trying to delete patron $member->{borrowernumber}... "
  63       if $verbose;
  64
  65     my $borrowernumber = $member->{borrowernumber};
  66     my $flags = C4::Members::patronflags( $member );
  67     if ( my $charges = $flags->{CHARGES}{amount} ) {
  68         say "Failed to delete patron $borrowernumber: patron has $charges in fines";
  69         next;
  70     }
  71
  72     eval {
  73         C4::Members::MoveMemberToDeleted( $borrowernumber )
  74           if $confirm;
  75     };
  76     if ($@) {
  77         say "Failed to delete patron $borrowernumber, cannot move it: ($@)";
  78         $dbh->rollback;
  79         next;
  80     }
  81     eval {
  82         C4::VirtualShelves::HandleDelBorrower( $borrowernumber )
  83           if $confirm;
  84     };
  85     if ($@) {
  86         say "Failed to delete patron $borrowernumber, error handling its lists: ($@)";
  87         $dbh->rollback;
  88         next;
  89     }
  90     eval { C4::Members::DelMember( $borrowernumber ) if $confirm; };
  91     if ($@) {
  92         say "Failed to delete patron $borrowernumber: $@)";
  93         $dbh->rollback;
  94         next;
  95     }
  96     $dbh->commit;
  97     $deleted++;
  98     say "OK" if $verbose;
  99 }
 100
 101 say "$deleted patrons deleted";
 102
 103 =head1 NAME
 104
 105 delete_patrons - This script deletes patrons
 106
 107 =head1 SYNOPSIS
 108
 109 delete_patrons.pl [-h -v -c] --not_borrowed_since=2013-07-21 --expired_before=2013-07-21 --category_code=CAT --library=CPL
 110
 111 dates can be generated with `date -d '-3 month' "+%Y-%m-%d"`
 112
 113 Options are cumulatives.
 114
 115 =head1 OPTIONS
 116
 117 =over
 118
 119 =item B<-h|--help>
 120
 121 Print a brief help message
 122
 123 =item B<--not_borrowed_since>
 124
 125 Delete patrons who have not borrowed since this date.
 126
 127 =item B<--expired_before>
 128
 129 Delete patrons with an account expired before this date.
 130
 131 =item B<--category_code>
 132
 133 Delete patrons who have this category code.
 134
 135 =item B<--library>
 136
 137 Delete patrons in this library.
 138
 139 =item B<-c|--confirm>
 140
 141 Without this flag set, this script will do nothing.
 142
 143 =item B<-v|--verbose>
 144
 145 Verbose mode.
 146
 147 =back
 148
 149 =head1 AUTHOR
 150
 151 Jonathan Druart <jonathan.druart@biblibre.com>
 152
 153 =head1 COPYRIGHT
 154
 155 Copyright 2013 BibLibre
 156
 157 =head1 LICENSE
 158
 159 This file is part of Koha.
 160
 161 Koha is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software
 162 Foundation; either version 3 of the License, or (at your option) any later version.
 163
 164 You should have received a copy of the GNU General Public License along
 165 with Koha; if not, write to the Free Software Foundation, Inc.,
 166 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 167
 168 =cut