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