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 Koha::Script -cron;
  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] [--too_old] [--too_young] [-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    -too_old                 update if over  maximum age for current category
  53    -too_young               update if under minimuum age  current category
  54    -fo=X --fineover=X       update if fines over  X amount
  55    -fu=X --fineunder=X      update if fines under X amount
  56    -rb=date --regbefore     update if registration date is before given date
  57    -ra=date --regafter      update if registration date is after a given date
  58    -d --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    --where <conditions>     where clause to add to the query
  60    -v -verbose              verbose mode
  61    -c --confirm             commit changes to db, no action will be taken unless this switch is included
  62    -b --branch <branchname> only deal with patrons from this library/branch
  63    -f --from <categorycode> change patron category from this category
  64    -t --to   <categorycode> change patron category to this category
  65
  66 =head1 OPTIONS
  67
  68 =over 8
  69
  70 =item B<--help>
  71
  72 Print a brief help message and exits.
  73
  74 =item B<--man>
  75
  76 Prints the manual page and exits.
  77
  78 =item B<--verbose | -v>
  79
  80 Verbose. Without this flag set, only fatal errors are reported.
  81
  82 =item B<--confirm | -c>
  83
  84 Commit changes. Unless this flag set is, the script will report changes but not actually execute them on the database.
  85
  86 =item B<--branch | -b>
  87
  88 changes patrons for one specific branch. Use the value in the
  89 branches.branchcode table.
  90
  91 =item B<--from | -f>
  92
  93 *required* defines the category to update. Expects the code from categories.categorycode.
  94
  95 =item B<--to | -t>
  96
  97 *required* defines the category patrons will be converted to. Expects the code from categories.categorycode.
  98
  99 =item B<--too_old>
 100
 101 Update patron only if they are above the maximum age range specified for the 'from' category.
 102
 103 =item B<--too_young>
 104
 105 Update patron only if they are below the minimum age range specified for the 'from' category.
 106
 107 =item B<--fineover=X | -fo=X>
 108
 109 Supply a number and only account with fines over this number will be updated.
 110
 111 =item B<--fineunder=X | -fu=X>
 112
 113 Supply a number and only account with fines under this number will be updated.
 114
 115 =item B<--regbefore=date | -rb=date>
 116
 117 Enter a date in ISO format YYYY-MM-DD and only patrons registered before this date wil be updated.
 118
 119 =item B<--regafter=date | -ra=date>
 120
 121 Enter a date in ISO format YYYY-MM-DD and only patrons registered after this date wil be updated.
 122
 123 =item B<--field column=value | -d column=value>
 124
 125 Use this flag to specify a column in the borrowers table and update only patrons whose value in that column equals the value supplied (repeatable)
 126 A value of null will check for a field that is not set.
 127
 128 e.g.
 129 --field dateexpiry=2016-01-01
 130 will update all patrons who expired on that date, useful for schools etc.
 131
 132 =item B<--where $conditions>
 133
 134 Use this option to specify a condition built with columns from the borrowers table
 135
 136 e.g.
 137 --where 'email IS NULL'
 138 will update all patrons with no value for email
 139
 140 --where 'categorycode LIKE "%CHILD"'
 141 will update all patrons with a category ending in CHILD.
 142
 143 --where 'categorycode LIKE RESIDENT%'
 144 will update all patrons whose category does not begin with RESIDENT.
 145
 146 =back
 147
 148 =head1 DESCRIPTION
 149
 150 This script is designed to update patrons from one category to another.
 151
 152 =head1 USAGE EXAMPLES
 153
 154 C<update_patron_categories.pl> - Suggests that you read this help. :)
 155
 156 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.
 157
 158 C<update_patron_categories.pl> -b=<branchcode> -f=<categorycode> -t=<categorycode>  --too_old --confirm  - Processes a single branch, and updates the patron categories from fromcat to tocat for patrons over the age range of fromcat.
 159
 160 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.
 161
 162 =cut
 163
 164 # These variables are set by command line options.
 165 # They are initially set to default values.
 166
 167 my $help    = 0;
 168 my $man     = 0;
 169 my $verbose = 0;
 170 my $doit    = 0;
 171 my $ageunder;
 172 my $ageover;
 173 my $remove_guarantors = 0;
 174 my $fine_min;
 175 my $fine_max;
 176 my $fromcat;
 177 my $tocat;
 178 my $reg_bef;
 179 my $reg_aft;
 180 my $branch_lim;
 181 my %fields;
 182 my @where;
 183
 184 GetOptions(
 185     'help|?'          => \$help,
 186     'man'             => \$man,
 187     'v|verbose'       => \$verbose,
 188     'c|confirm'       => \$doit,
 189     'f|from=s'        => \$fromcat,
 190     't|to=s'          => \$tocat,
 191     'too_old'         => \$ageover,
 192     'too_young'       => \$ageunder,
 193     'fo|finesover=s'  => \$fine_min,
 194     'fu|finesunder=s' => \$fine_max,
 195     'rb|regbefore=s'  => \$reg_bef,
 196     'ra|regafter=s'   => \$reg_aft,
 197     'b|branch=s'      => \$branch_lim,
 198     'd|field=s'       => \%fields,
 199     'where=s'         => \@where,
 200 );
 201
 202 pod2usage(1) if $help;
 203
 204 pod2usage( -verbose => 2 ) if $man;
 205
 206 if ( not $fromcat && $tocat ) {    #make sure we've specified the info we need.
 207     print "Must supply category from and to (-f & -t) please specify -help for usage tips.\n";
 208     pod2usage(1);
 209     exit;
 210 }
 211
 212 ( $verbose && !$doit ) and print "No actions will be taken (test mode)\n";
 213
 214 $verbose and print "Will update patrons from $fromcat to $tocat with conditions below (if any)\n";
 215
 216 my %params;
 217
 218 if ( $reg_bef || $reg_aft ) {
 219     my $date_bef;
 220     my $date_aft;
 221     if ( defined $reg_bef ) {
 222         eval { $date_bef = dt_from_string( $reg_bef, 'iso' ); };
 223     }
 224     die "$reg_bef is not a valid date before, aborting! Use a date in format YYYY-MM-DD.$@"
 225         if $@;
 226     if ( defined $reg_aft ) {
 227         eval { $date_aft = dt_from_string( $reg_aft, 'iso' ); };
 228     }
 229     die "$reg_bef is not a valid date after, aborting! Use a date in format YYYY-MM-DD.$@"
 230         if $@;
 231     $params{dateenrolled}{'<='} = $reg_bef if defined $date_bef;
 232     $params{dateenrolled}{'>='} = $reg_aft if defined $date_aft;
 233 }
 234
 235 my $cat_from = Koha::Patron::Categories->find($fromcat);
 236 my $cat_to   = Koha::Patron::Categories->find($tocat);
 237 die "Categories not found" unless $cat_from && $cat_to;
 238
 239 $params{"me.categorycode"} = $fromcat;
 240 $params{"me.branchcode"} = $branch_lim if $branch_lim;
 241
 242 if ($verbose) {
 243     print "Conditions:\n";
 244     print "    Registered before $reg_bef\n"      if $reg_bef;
 245     print "    Registered after  $reg_aft\n"      if $reg_aft;
 246     print "    Total fines more than $fine_min\n" if $fine_min;
 247     print "    Total fines less than $fine_max\n" if $fine_max;
 248     print "    Age below minimum for " . $cat_from->description . "\n" if $ageunder;
 249     print "    Age above maximum for " . $cat_from->description . "\n" if $ageover;
 250     if ( defined $branch_lim ) {
 251         print "    Branchcode of patron is $branch_lim\n";
 252     }
 253 }
 254
 255 while ( my ( $key, $value ) = each %fields ) {
 256     $verbose and print "    Borrower column $key is $value\n";
 257     $value = undef if lc($value) eq 'null';
 258     $params{ "me." . $key } = $value;
 259 }
 260
 261 my $where_literal = join ' AND ', @where;
 262 my $target_patrons = Koha::Patrons->search( \%params );
 263 $target_patrons = $target_patrons->search( \$where_literal ) if @where;
 264 $target_patrons = $target_patrons->search_patrons_to_update_category(
 265     {
 266         from          => $fromcat,
 267         search_params => \%params,
 268         too_young     => $ageunder,
 269         too_old       => $ageover,
 270         fine_min      => $fine_min,
 271         fine_max      => $fine_max,
 272     }
 273 );
 274
 275 my $patrons_found    = $target_patrons->count;
 276 my $actually_updated = 0;
 277 my $testdisplay      = $doit ? "" : "WOULD HAVE ";
 278 if ($verbose) {
 279     while ( my $target_patron = $target_patrons->next() ) {
 280         $target_patron->discard_changes();
 281         $verbose
 282           and print $testdisplay
 283           . "Updated "
 284           . $target_patron->firstname() . " "
 285           . $target_patron->surname()
 286           . " from $fromcat to $tocat\n";
 287     }
 288     $target_patrons->reset;
 289 }
 290 if ($doit) {
 291     $actually_updated = $target_patrons->update_category_to( { category => $tocat } );
 292 }
 293
 294 $verbose and print "$patrons_found found, $actually_updated updated\n";