misc/cronjobs/update_patrons_category.pl

   1 #!/usr/bin/perl
   2
   3 # This file is part of Koha.
   4 #
   5 # Koha is free software; you can redistribute it and/or modify it
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  17
  18 use Modern::Perl;
  19
  20 BEGIN {
  21     # find Koha's Perl modules
  22     # test carefully before changing this
  23     use FindBin;
  24     eval { require "$FindBin::Bin/../kohalib.pl" };
  25 }
  26
  27 use C4::Context;
  28 use Getopt::Long;
  29 use Pod::Usage;
  30 use Koha::Logger;
  31 use Koha::Patrons;
  32 use Koha::Patron::Categories;
  33 use Koha::DateUtils;
  34 use Data::Dumper;
  35
  36 =head1 NAME
  37
  38 update_patrons_category.pl - Given a set of parameters update selected patrons from one catgeory to another. Options are cumulative.
  39
  40 =head1 SYNOPSIS
  41
  42 update_patrons_category.pl -f=categorycode -t=categorycode
  43                           [-b=branchcode] [-au] [-ao] [-fo=X] [-fu=X]
  44                           [-rb=date] [-ra=date] [-v]
  45                           [--field column=value ...]
  46
  47 update_patrons_category.pl --help | --man
  48
  49 Options:
  50    --help       brief help message
  51    --man        full documentation
  52    -ao          update if over  maximum age for current category
  53    -au          update if under minimuum age  current category
  54    -fo=X        update if fines over  X amount
  55    -fu=X        update if fines under X amount
  56    -rb=date     update if registration date is before given date
  57    -ra=date     update if registration date is after a given date
  58    --field name=value  where <name> is a column in the borrowers table, patrons will be updated if the field is equal to given <value>
  59    -v           verbose mode
  60    -confirm     commit changes to db, no action will be taken unless this switch is included
  61    -b           <branchname>       only deal with patrons from this library/branch
  62    -f           <categorycode>     change patron category from this category
  63    -t           <categorycode>     change patron category to this category
  64
  65 =head1 OPTIONS
  66
  67 =over 8
  68
  69 =item B<--help>
  70
  71 Print a brief help message and exits.
  72
  73 =item B<--man>
  74
  75 Prints the manual page and exits.
  76
  77 =item B<-v>
  78
  79 Verbose. Without this flag set, only fatal errors are reported.
  80
  81 =item B<--confirm>
  82
  83 Commit changes. Unless this flag set is, the script will report changes but not actually execute them on the database.
  84
  85 =item B<-b>
  86
  87 changes patrons for one specific branch. Use the value in the
  88 branches.branchcode table.
  89
  90 =item B<-f>
  91
  92 *required* defines the category to update. Expects the code from categories.categorycode.
  93
  94 =item B<-t>
  95
  96 *required* defines the category patrons will be converted to. Expects the code from categories.categorycode.
  97
  98 =item B<-ao>
  99
 100 Update patron only if they are above the maximum age range specified for the 'from' category.
 101
 102 =item B<-au>
 103
 104 Update patron only if they are below the minimum age range specified for the 'from' category.
 105
 106 =item B<-fo=X>
 107
 108 Supply a number and only account with fines over this number will be updated.
 109
 110 =item B<-fu=X>
 111
 112 Supply a number and only account with fines under this number will be updated.
 113
 114 =item B<-rb=date>
 115
 116 Enter a date in ISO format YYYY-MM-DD and only patrons registered before this date wil be updated.
 117
 118 =item B<-ra=date>
 119
 120 Enter a date in ISO format YYYY-MM-DD and only patrons registered after this date wil be updated.
 121
 122 =item B<--field column=value>
 123
 124 Use this flag to specify a column in the borrowers table and update only patrons whose value in that column matches the value supplied (repeatable)
 125
 126 e.g.
 127 --field dateexpiry=2016-01-01
 128 will update all patrons who expired on that date, useful for schools etc.
 129
 130 =back
 131
 132 =head1 DESCRIPTION
 133
 134 This script is designed to update patrons from one category to another.
 135
 136 =head1 USAGE EXAMPLES
 137
 138 C<update_patron_categories.pl> - Suggests that you read this help. :)
 139
 140 C<update_patron_categories.pl> -b=<branchcode> -f=<categorycode> -t=<categorycode> --confirm  - Processes a single branch, and updates the patron categories from fromcat to tocat.
 141
 142 C<update_patron_categories.pl> -b=<branchcode> -f=<categorycode> -t=<categorycode>  -a --confirm  - Processes a single branch, and updates the patron categories from fromcat to tocat for patrons outside the age range of fromcat.
 143
 144 C<update_patron_categories.pl> -f=<categorycode> -t=<categorycode> -v  - Processes all branches, shows all messages, and reports the patrons who would be affected. Takes no action on the database.
 145
 146 =cut
 147
 148 # These variables are set by command line options.
 149 # They are initially set to default values.
 150
 151 my $help     = 0;
 152 my $man      = 0;
 153 my $verbose  = 0;
 154 my $doit = 0;
 155 my $au;
 156 my $ao;
 157 my $min_dob;
 158 my $max_dob;
 159 my $remove_guarantors = 0;
 160 my $fine_min;
 161 my $fine_max;
 162 my $fromcat;
 163 my $tocat;
 164 my $reg_bef;
 165 my $reg_aft;
 166 my $branch_lim;
 167 my %fields;
 168
 169 GetOptions(
 170     'help|?'  => \$help,
 171     'man'     => \$man,
 172     'v'       => \$verbose,
 173     'confirm' => \$doit,
 174     'f=s'     => \$fromcat,
 175     't=s'     => \$tocat,
 176     'ao'       => \$ao,
 177     'au'       => \$au,
 178     'fo=s'    => \$fine_min,
 179     'fu=s'    => \$fine_max,
 180     'rb=s'    => \$reg_bef,
 181     'ra=s'    => \$reg_aft,
 182     'b=s'     => \$branch_lim,
 183     'field=s' => \%fields
 184 ) or pod2usage(2);
 185 pod2usage(1) if $help;
 186 pod2usage( -verbose => 2 ) if $man;
 187
 188 if ( not $fromcat && $tocat ) {    #make sure we've specified the info we need.
 189     print "Must supply category from and to (-f & -t) please specify -help for usage tips.\n";
 190     exit;
 191 }
 192
 193 ($verbose && !$doit) and print "No actions will be taken (test mode)\n";
 194
 195 $verbose and print "Will update patrons from $fromcat to $tocat with conditions below (if any)\n";
 196
 197 my %params;
 198
 199 if ( $reg_bef || $reg_aft ){
 200     my $date_bef;
 201     my $date_aft;
 202     if (defined $reg_bef) {eval { $date_bef = dt_from_string( $reg_bef, 'iso' ); };}
 203     die "$reg_bef is not a valid date before, aborting! Use a date in format YYYY-MM-DD.$@"
 204     if $@;
 205     if (defined $reg_aft) {eval { $date_aft = dt_from_string( $reg_aft, 'iso' ); };}
 206     die "$reg_bef is not a valid date after, aborting! Use a date in format YYYY-MM-DD.$@"
 207     if $@;
 208     $params{dateenrolled}{'<='}=$reg_bef if defined $date_bef;
 209     $params{dateenrolled}{'>='}=$reg_aft if defined $date_aft;
 210 }
 211
 212 my $cat_from = Koha::Patron::Categories->find($fromcat);
 213 my $cat_to   = Koha::Patron::Categories->find($tocat);
 214 die "Categories not found" unless $cat_from && $cat_to;
 215
 216 $params{"me.categorycode"} = $fromcat;
 217 $params{"me.branchcode"} = $branch_lim if $branch_lim;
 218
 219 if ($verbose) {
 220     print "Conditions:\n";
 221     print "    Registered before $reg_bef\n" if $reg_bef;
 222     print "    Registered after  $reg_aft\n" if $reg_aft;
 223     print "    Total fines more than $fine_min\n" if $fine_min;
 224     print "    Total fines less than $fine_max\n" if $fine_max;
 225     print "    Age below minimum for ".$cat_from->description."\n" if $au;
 226     print "    Age above maximum for ".$cat_from->description."\n" if $ao;
 227     if (defined $branch_lim) {
 228         print "    Branchcode of patron is $branch_lim\n";
 229     }
 230 }
 231
 232 while (my ($key,$value) = each %fields ) {
 233     $verbose and print "    Borrower column $key is equal to $value\n";
 234     $params{"me.".$key} = $value;
 235 }
 236
 237 my $target_patrons = Koha::Patrons->search_patrons_to_update({
 238         from => $fromcat,
 239         search_params => \%params,
 240         au => $au,
 241         ao => $ao,
 242         fine_min => $fine_min,
 243         fine_max => $fine_max,
 244     });
 245 my $patrons_found = $target_patrons->count;
 246 my $actually_updated = 0;
 247 my $testdisplay  = $doit ? "" : "WOULD HAVE ";
 248 if ( $verbose ) {
 249     while ( my $target_patron = $target_patrons->next() ){
 250     my $target = Koha::Patrons->find( $target_patron->borrowernumber );
 251     $verbose and print $testdisplay."Updated ".$target->firstname." ".$target->surname." from $fromcat to $tocat\n";
 252     }
 253     $target_patrons->reset;
 254 }
 255 if ( $doit ) {
 256     $actually_updated = $target_patrons->update_category({to=>$tocat});
 257 }
 258
 259 $verbose and print "$patrons_found found, $actually_updated updated\n";