Bug 17057: (follow-up) Replace onsubmit attributes
[koha.git] / misc / cronjobs / delete_patrons.pl
blobe8e90dd00e91ce23c6d623452990f5f6e48c7a05
1 #!/usr/bin/perl
3 use Modern::Perl;
5 use Pod::Usage;
6 use Getopt::Long;
8 use Koha::Script -cron;
9 use C4::Members;
10 use Koha::DateUtils;
11 use Koha::Patrons;
12 use C4::Log;
14 my ( $help, $verbose, $not_borrowed_since, $expired_before, $last_seen,
15 $category_code, $branchcode, $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 'c|confirm' => \$confirm,
25 ) || pod2usage(1);
27 if ($help) {
28 pod2usage(1);
31 $not_borrowed_since = dt_from_string( $not_borrowed_since, 'iso' )
32 if $not_borrowed_since;
34 $expired_before = dt_from_string( $expired_before, 'iso' )
35 if $expired_before;
37 if ( $last_seen and not C4::Context->preference('TrackLastPatronActivity') ) {
38 pod2usage(q{The --last_seen option cannot be used with TrackLastPatronActivity turned off});
41 unless ( $not_borrowed_since or $expired_before or $last_seen or $category_code or $branchcode ) {
42 pod2usage(q{At least one filter is mandatory});
45 cronlogaction();
47 my $members = GetBorrowersToExpunge(
49 not_borrowed_since => $not_borrowed_since,
50 expired_before => $expired_before,
51 last_seen => $last_seen,
52 category_code => $category_code,
53 branchcode => $branchcode,
57 unless ($confirm) {
58 say "Doing a dry run; no patron records will actually be deleted.";
59 say "Run again with --confirm to delete the records.";
62 say scalar(@$members) . " patrons to delete";
64 my $deleted = 0;
65 for my $member (@$members) {
66 print "Trying to delete patron $member->{borrowernumber}... "
67 if $verbose;
69 my $borrowernumber = $member->{borrowernumber};
70 my $patron = Koha::Patrons->find( $borrowernumber );
71 unless ( $patron ) {
72 say "Patron with borrowernumber $borrowernumber does not exist";
73 next;
75 if ( my $charges = $patron->account->non_issues_charges ) { # And what if we owe to this patron?
76 say "Failed to delete patron $borrowernumber: patron has $charges in fines";
77 next;
80 if ( $confirm ) {
81 my $deleted = eval { $patron->move_to_deleted; };
82 if ($@ or not $deleted) {
83 say "Failed to delete patron $borrowernumber, cannot move it" . ( $@ ? ": ($@)" : "" );
84 next;
87 eval { $patron->delete };
88 if ($@) {
89 say "Failed to delete patron $borrowernumber: $@)";
90 next;
93 $deleted++;
94 say "OK" if $verbose;
97 say "$deleted patrons deleted";
99 =head1 NAME
101 delete_patrons - This script deletes patrons
103 =head1 SYNOPSIS
105 delete_patrons.pl [-h|--help] [-v|--verbose] [-c|--confirm] [--not_borrowed_since=DATE] [--expired_before=DATE] [--last-seen=DATE] [--category_code=CAT] [--library=LIBRARY]
107 Dates should be in ISO format, e.g., 2013-07-19, and can be generated
108 with `date -d '-3 month' --iso-8601`.
110 The options to select the patron records to delete are cumulative. For
111 example, supplying both --expired_before and --library specifies that
112 that patron records must meet both conditions to be selected for deletion.
114 =head1 OPTIONS
116 =over
118 =item B<-h|--help>
120 Print a brief help message
122 =item B<--not_borrowed_since>
124 Delete patrons who have not borrowed since this date.
126 =item B<--expired_before>
128 Delete patrons with an account expired before this date.
130 =item B<--last_seen>
132 Delete patrons who have not been connected since this date.
134 The system preference TrackLastPatronActivity must be enabled to use this option.
136 =item B<--category_code>
138 Delete patrons who have this category code.
140 =item B<--library>
142 Delete patrons in this library.
144 =item B<-c|--confirm>
146 This flag must be provided in order for the script to actually
147 delete patron records. If it is not supplied, the script will
148 only report on the patron records it would have deleted.
150 =item B<-v|--verbose>
152 Verbose mode.
154 =back
156 =head1 AUTHOR
158 Jonathan Druart <jonathan.druart@biblibre.com>
160 =head1 COPYRIGHT
162 Copyright 2013 BibLibre
164 =head1 LICENSE
166 This file is part of Koha.
168 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
169 Foundation; either version 3 of the License, or (at your option) any later version.
171 You should have received a copy of the GNU General Public License along
172 with Koha; if not, write to the Free Software Foundation, Inc.,
173 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
175 =cut