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 @$members = ( { borrowernumber => 19 } );
  60
  61 $dbh->{AutoCommit} = 0; # use transactions to avoid partial deletes
  62 for my $member (@$members) {
  63     print "Trying to delete patron $member->{borrowernumber}... "
  64       if $verbose;
  65     eval {
  66         C4::Members::MoveMemberToDeleted( $member->{borrowernumber} )
  67           if $confirm;
  68     };
  69     if ($@) {
  70         say "Failed to delete patron $member->{borrowernumber}, cannot move it: ($@)";
  71         $dbh->rollback;
  72         next;
  73     }
  74     eval {
  75         C4::VirtualShelves::HandleDelBorrower( $member->{borrowernumber} )
  76           if $confirm;
  77     };
  78     if ($@) {
  79         say "Failed to delete patron $member->{borrowernumber}, error handling its lists: ($@)";
  80         $dbh->rollback;
  81         next;
  82     }
  83     eval { C4::Members::DelMember( $member->{borrowernumber} ) if $confirm; };
  84     if ($@) {
  85         say "Failed to delete patron $member->{borrowernumber}: $@)";
  86         $dbh->rollback;
  87         next;
  88     }
  89     $dbh->commit;
  90     say "OK" if $verbose;
  91 }
  92
  93 =head1 NAME
  94
  95 delete_patrons - This script deletes patrons
  96
  97 =head1 SYNOPSIS
  98
  99 delete_patrons.pl [-h -v -c] --not_borrowed_since=2013-07-21 --expired_before=2013-07-21 --category_code=CAT --branchcode=CPL
 100
 101 dates can be generated with `date -d '-3 month' "+%Y-%m-%d"`
 102
 103 Options are cumulatives.
 104
 105 =head1 OPTIONS
 106
 107 =over
 108
 109 =item B<-h|--help>
 110
 111 Print a brief help message
 112
 113 =item B<--not_borrowed_since>
 114
 115 Delete patrons who have not borrowed since this date.
 116
 117 =item B<--expired_date>
 118
 119 Delete patrons with an account expired before this date.
 120
 121 =item B<--category_code>
 122
 123 Delete patrons who have this category code.
 124
 125 =item B<--branchcode>
 126
 127 Delete patrons in this library.
 128
 129 =item B<-c|--confirm>
 130
 131 Without this flag set, this script will do nothing.
 132
 133 =item B<-v|--verbose>
 134
 135 Verbose mode.
 136
 137 =back
 138
 139 =head1 AUTHOR
 140
 141 Jonathan Druart <jonathan.druart@biblibre.com>
 142
 143 =head1 COPYRIGHT
 144
 145 Copyright 2013 BibLibre
 146
 147 =head1 LICENSE
 148
 149 This file is part of Koha.
 150
 151 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
 152 Foundation; either version 3 of the License, or (at your option) any later version.
 153
 154 You should have received a copy of the GNU General Public License along
 155 with Koha; if not, write to the Free Software Foundation, Inc.,
 156 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 157
 158 =cut