misc/cronjobs/longoverdue.pl

   1 #!/usr/bin/perl
   2 #-----------------------------------
   3 # Copyright 2008 LibLime
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19 #-----------------------------------
  20
  21 =head1 NAME
  22
  23 longoverdue.pl  cron script to set lost statuses on overdue materials.
  24                 Execute without options for help.
  25
  26 =cut
  27
  28 use strict;
  29 use warnings;
  30 BEGIN {
  31     # find Koha's Perl modules
  32     # test carefully before changing this
  33     use FindBin;
  34     eval { require "$FindBin::Bin/../kohalib.pl" };
  35 }
  36
  37 use Getopt::Long;
  38 use Pod::Usage;
  39
  40 use C4::Circulation qw/LostItem MarkIssueReturned/;
  41 use C4::Context;
  42 use C4::Items;
  43 use C4::Log;
  44 use Koha::ItemTypes;
  45 use Koha::Patron::Categories;
  46 use Koha::Patrons;
  47 use Koha::Script -cron;
  48
  49 my  $lost;  #  key=lost value,  value=num days.
  50 my ($charge, $verbose, $confirm, $quiet);
  51 my $endrange = 366;
  52 my $mark_returned;
  53 my $borrower_category = [];
  54 my $skip_borrower_category = [];
  55 my $itemtype = [];
  56 my $skip_itemtype = [];
  57 my $help=0;
  58 my $man=0;
  59 my $list_categories = 0;
  60 my $list_itemtypes = 0;
  61 my @skip_lost_values;
  62
  63 GetOptions(
  64     'l|lost=s%'         => \$lost,
  65     'c|charge=s'        => \$charge,
  66     'confirm'           => \$confirm,
  67     'v|verbose'         => \$verbose,
  68     'quiet'             => \$quiet,
  69     'maxdays=s'         => \$endrange,
  70     'mark-returned'     => \$mark_returned,
  71     'h|help'            => \$help,
  72     'man|manual'        => \$man,
  73     'category=s'        => $borrower_category,
  74     'skip-category=s'   => $skip_borrower_category,
  75     'list-categories'   => \$list_categories,
  76     'itemtype=s'        => $itemtype,
  77     'skip-itemtype=s'   => $skip_itemtype,
  78     'list-itemtypes'    => \$list_itemtypes,
  79     'skip-lost-value=s' => \@skip_lost_values,
  80 );
  81
  82 if ( $man ) {
  83     pod2usage( -verbose => 2
  84                -exitval => 0
  85             );
  86 }
  87
  88 if ( $help ) {
  89     pod2usage( -verbose => 1,
  90                -exitval => 0
  91             );
  92 }
  93
  94 if ( scalar @$borrower_category && scalar @$skip_borrower_category) {
  95     pod2usage( -verbose => 1,
  96                -message => "The options --category and --skip-category are mutually exclusive.\n"
  97                            . "Use one or the other.",
  98                -exitval => 1
  99             );
 100 }
 101
 102 if ( scalar @$itemtype && scalar @$skip_itemtype) {
 103     pod2usage( -verbose => 1,
 104                -message => "The options --itemtype and --skip-itemtype are mutually exclusive.\n"
 105                            . "Use one or the other.",
 106                -exitval => 1
 107             );
 108 }
 109
 110 if ( $list_categories ) {
 111
 112     my @categories = Koha::Patron::Categories->search()->get_column('categorycode');
 113     print "\nBorrower Categories: " . join( " ", @categories ) . "\n\n";
 114     exit 0;
 115 }
 116
 117 if ( $list_itemtypes ) {
 118     my @itemtypes = Koha::ItemTypes->search()->get_column('itemtype');
 119     print "\nItemtypes: " . join( " ", @itemtypes ) . "\n\n";
 120     exit 0;
 121 }
 122
 123 =head1 SYNOPSIS
 124
 125    longoverdue.pl [ --help | -h | --man | --list-categories ]
 126    longoverdue.pl --lost | -l DAYS=LOST_CODE [ --charge | -c CHARGE_CODE ] [ --verbose | -v ] [ --quiet ]
 127                   [ --maxdays MAX_DAYS ] [ --mark-returned ] [ --category BORROWER_CATEGORY ] ...
 128                   [ --skip-category BORROWER_CATEGORY ] ...
 129                   [ --skip-lost-value LOST_VALUE [ --skip-lost-value LOST_VALUE ] ]
 130                   [ --commit ]
 131
 132
 133 WARNING:  Flippant use of this script could set all or most of the items in your catalog to Lost and charge your
 134           patrons for them!
 135
 136 WARNING:  This script is known to be faulty.  It is NOT recommended to use multiple --lost options.
 137           See http://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=2883
 138
 139 =cut
 140
 141 =head1 OPTIONS
 142
 143 This script takes the following parameters :
 144
 145 =over 8
 146
 147 =item B<--lost | -l>
 148
 149 This option takes the form of n=lv, where n is num days overdue, and lv is the lost value.  See warning above.
 150
 151 =item B<--charge | -c>
 152
 153 This specifies what lost value triggers Koha to charge the account for the lost item.  Replacement costs are not charged if this is not specified.
 154
 155 =item B<--verbose | -v>
 156
 157 verbose.
 158
 159 =item B<--confirm>
 160
 161 confirm.  without this option, the script will report the number of affected items and return without modifying any records.
 162
 163 =item B<--quiet>
 164
 165 suppress summary output.
 166
 167 =item B<--maxdays>
 168
 169 Specifies the end of the range of overdue days to deal with (defaults to 366).  This value is universal to all lost num days overdue passed.
 170
 171 =item B<--mark-returned>
 172
 173 When an item is marked lost, remove it from the borrowers issued items.
 174 If not provided, the value of the system preference 'MarkLostItemsAsReturned' will be used.
 175
 176 =item B<--category>
 177
 178 Act on the listed borrower category code (borrowers.categorycode).
 179 Exclude all others. This may be specified multiple times to include multiple categories.
 180 May not be used with B<--skip-category>
 181
 182 =item B<--skip-category>
 183
 184 Act on all available borrower category codes, except those listed.
 185 This may be specified multiple times, to exclude multiple categories.
 186 May not be used with B<--category>
 187
 188 =item B<--list-categories>
 189
 190 List borrower categories available for use by B<--category> or
 191 B<--skip-category>, and exit.
 192
 193 =item B<--itemtype>
 194
 195 Act on the listed itemtype code.
 196 Exclude all others. This may be specified multiple times to include multiple itemtypes.
 197 May not be used with B<--skip-itemtype>
 198
 199 =item B<--skip-itemtype>
 200
 201 Act on all available itemtype codes, except those listed.
 202 This may be specified multiple times, to exclude multiple itemtypes.
 203 May not be used with B<--itemtype>
 204
 205 =item B<--skip-lost-value>
 206
 207 Act on all available lost values, except those listed.
 208 This may be specified multiple times, to exclude multiple lost values.
 209
 210 =item B<--list-itemtypes>
 211
 212 List itemtypes available for use by B<--itemtype> or
 213 B<--skip-itemtype>, and exit.
 214
 215 =item B<--help | -h>
 216
 217 Display short help message an exit.
 218
 219 =item B<--man | --manual >
 220
 221 Display entire manual and exit.
 222
 223 =back
 224
 225 =cut
 226
 227 =head1 Description
 228
 229 This cron script set lost values on overdue items and optionally sets charges the patron's account
 230 for the item's replacement price.  It is designed to be run as a nightly job.  The command line options that globally
 231 define this behavior for this script  will likely be moved into Koha's core circulation / issuing rules code in a
 232 near-term release, so this script is not intended to have a long lifetime.
 233
 234
 235 =cut
 236
 237 =head1 Examples
 238
 239   $PERL5LIB/misc/cronjobs/longoverdue.pl --lost 30=1
 240     Would set LOST=1 after 30 days (up to one year), but not charge the account.
 241     This would be suitable for the Koha default LOST authorized value of 1 -> 'Lost'.
 242
 243   $PERL5LIB/misc/cronjobs/longoverdue.pl --lost 60=2 --charge 2
 244     Would set LOST=2 after 60 days (up to one year), and charge the account when setting LOST=2.
 245     This would be suitable for the Koha default LOST authorized value of 2 -> 'Long Overdue'
 246
 247 =cut
 248
 249 # FIXME: We need three pieces of data to operate:
 250 #         ~ lower bound (number of days),
 251 #         ~ upper bound (number of days),
 252 #         ~ new lost value.
 253 #        Right now we get only two, causing the endrange hack.  This is a design-level failure.
 254 # FIXME: do checks on --lost ranges to make sure they are exclusive.
 255 # FIXME: do checks on --lost ranges to make sure the authorized values exist.
 256 # FIXME: do checks on --lost ranges to make sure don't go past endrange.
 257 #
 258
 259 unless ( scalar @skip_lost_values ) {
 260     my $preference = C4::Context->preference( 'DefaultLongOverdueSkipLostStatuses' );
 261     @skip_lost_values = split( ',', $preference );
 262 }
 263
 264 if ( ! defined($lost) ) {
 265     my $longoverdue_value = C4::Context->preference('DefaultLongOverdueLostValue');
 266     my $longoverdue_days = C4::Context->preference('DefaultLongOverdueDays');
 267     if(defined($longoverdue_value) and defined($longoverdue_days) and $longoverdue_value ne '' and $longoverdue_days ne '' and $longoverdue_days >= 0) {
 268         $lost->{$longoverdue_days} = $longoverdue_value;
 269     }
 270     else {
 271         pod2usage( {
 272                 -exitval => 1,
 273                 -msg => q|ERROR: No --lost (-l) option defined|,
 274         } );
 275     }
 276 }
 277 if ( ! defined($charge) ) {
 278     my $charge_value = C4::Context->preference('DefaultLongOverdueChargeValue');
 279     if(defined($charge_value) and $charge_value ne '') {
 280         $charge = $charge_value;
 281     }
 282 }
 283 unless ($confirm) {
 284     $verbose = 1;     # If you're not running it for real, then the whole point is the print output.
 285     print "### TEST MODE -- NO ACTIONS TAKEN ###\n";
 286 }
 287
 288 cronlogaction();
 289
 290 # In my opinion, this line is safe SQL to have outside the API. --atz
 291 our $bounds_sth = C4::Context->dbh->prepare("SELECT DATE_SUB(CURDATE(), INTERVAL ? DAY)");
 292
 293 sub bounds {
 294     $bounds_sth->execute(shift);
 295     return $bounds_sth->fetchrow;
 296 }
 297
 298 # FIXME - This sql should be inside the API.
 299 sub longoverdue_sth {
 300     my ( $params ) = @_;
 301     my $skip_lost_values = $params->{skip_lost_values};
 302
 303     my $skip_lost_values_sql = q{};
 304     if ( @$skip_lost_values ) {
 305         my $values = join( ',', map { qq{'$_'} } @$skip_lost_values );
 306         $skip_lost_values_sql = "AND itemlost NOT IN ( $values )"
 307     }
 308
 309     my $query = "
 310     SELECT items.itemnumber, borrowernumber, date_due, itemlost
 311       FROM issues, items
 312      WHERE items.itemnumber = issues.itemnumber
 313       AND  DATE_SUB(CURDATE(), INTERVAL ? DAY)  > date_due
 314       AND  DATE_SUB(CURDATE(), INTERVAL ? DAY) <= date_due
 315       AND  itemlost <> ?
 316       $skip_lost_values_sql
 317      ORDER BY date_due
 318     ";
 319     return C4::Context->dbh->prepare($query);
 320 }
 321
 322 my $dbh = C4::Context->dbh;
 323
 324 my @available_categories = Koha::Patron::Categories->search()->get_column('categorycode');
 325 $borrower_category = [ map { uc $_ } @$borrower_category ];
 326 $skip_borrower_category = [ map { uc $_} @$skip_borrower_category ];
 327 my %category_to_process;
 328 for my $cat ( @$borrower_category ) {
 329     unless ( grep { $_ eq $cat } @available_categories ) {
 330         pod2usage(
 331             '-exitval' => 1,
 332             '-message' => "The category $cat does not exist in the database",
 333         );
 334     }
 335     $category_to_process{$cat} = 1;
 336 }
 337 if ( @$skip_borrower_category ) {
 338     for my $cat ( @$skip_borrower_category ) {
 339         unless ( grep { $_ eq $cat } @available_categories ) {
 340             pod2usage(
 341                 '-exitval' => 1,
 342                 '-message' => "The category $cat does not exist in the database",
 343             );
 344         }
 345     }
 346     %category_to_process = map { $_ => 1 } @available_categories;
 347     %category_to_process = ( %category_to_process, map { $_ => 0 } @$skip_borrower_category );
 348 }
 349
 350 my $filter_borrower_categories = ( scalar @$borrower_category || scalar @$skip_borrower_category );
 351
 352 my @available_itemtypes = Koha::ItemTypes->search()->get_column('itemtype');
 353 $itemtype = [ map { uc $_ } @$itemtype ];
 354 $skip_itemtype = [ map { uc $_} @$skip_itemtype ];
 355 my %itemtype_to_process;
 356 for my $it ( @$itemtype ) {
 357     unless ( grep { $_ eq $it } @available_itemtypes ) {
 358         pod2usage(
 359             '-exitval' => 1,
 360             '-message' => "The itemtype $it does not exist in the database",
 361         );
 362     }
 363     $itemtype_to_process{$it} = 1;
 364 }
 365 if ( @$skip_itemtype ) {
 366     for my $it ( @$skip_itemtype ) {
 367         unless ( grep { $_ eq $it } @available_itemtypes ) {
 368             pod2usage(
 369                 '-exitval' => 1,
 370                 '-message' => "The itemtype $it does not exist in the database",
 371             );
 372         }
 373     }
 374     %itemtype_to_process = map { $_ => 1 } @available_itemtypes;
 375     %itemtype_to_process = ( %itemtype_to_process, map { $_ => 0 } @$skip_itemtype );
 376 }
 377
 378 my $filter_itemtypes = ( scalar @$itemtype || scalar @$skip_itemtype );
 379
 380 my $count;
 381 my @report;
 382 my $total = 0;
 383 my $i = 0;
 384
 385 # FIXME - The item is only marked returned if you supply --charge .
 386 #         We need a better way to handle this.
 387 #
 388 my $sth_items = longoverdue_sth({ skip_lost_values => \@skip_lost_values });
 389
 390 foreach my $startrange (sort keys %$lost) {
 391     if( my $lostvalue = $lost->{$startrange} ) {
 392         my ($date1) = bounds($startrange);
 393         my ($date2) = bounds(  $endrange);
 394         # print "\nRange ", ++$i, "\nDue $startrange - $endrange days ago ($date2 to $date1), lost => $lostvalue\n" if($verbose);
 395         $verbose and
 396             printf "\nRange %s\nDue %3s - %3s days ago (%s to %s), lost => %s\n", ++$i,
 397             $startrange, $endrange, $date2, $date1, $lostvalue;
 398         $sth_items->execute($startrange, $endrange, $lostvalue);
 399         $count=0;
 400         ITEM: while (my $row=$sth_items->fetchrow_hashref) {
 401             if( $filter_borrower_categories ) {
 402                 my $category = uc Koha::Patrons->find( $row->{borrowernumber} )->categorycode();
 403                 next ITEM unless ( $category_to_process{ $category } );
 404             }
 405             if ($filter_itemtypes) {
 406                 my $it = uc Koha::Items->find( $row->{itemnumber} )->effective_itemtype();
 407                 next ITEM unless ( $itemtype_to_process{$it} );
 408             }
 409             printf ("Due %s: item %5s from borrower %5s to lost: %s\n", $row->{date_due}, $row->{itemnumber}, $row->{borrowernumber}, $lostvalue) if($verbose);
 410             if($confirm) {
 411                 Koha::Items->find( $row->{itemnumber} )->itemlost($lostvalue)
 412                   ->store;
 413                 if ( $charge && $charge eq $lostvalue ) {
 414                     LostItem( $row->{'itemnumber'}, 'cronjob', $mark_returned );
 415                 } elsif ( $mark_returned ) {
 416                     my $patron = Koha::Patrons->find( $row->{borrowernumber} );
 417                     MarkIssueReturned($row->{borrowernumber},$row->{itemnumber},undef,$patron->privacy)
 418                 }
 419             }
 420             $count++;
 421         }
 422         push @report, {
 423            startrange => $startrange,
 424              endrange => $endrange,
 425                 range => "$startrange - $endrange",
 426                 date1 => $date1,
 427                 date2 => $date2,
 428             lostvalue => $lostvalue,
 429                 count => $count,
 430         };
 431         $total += $count;
 432     }
 433     $endrange = $startrange;
 434 }
 435
 436 sub summarize {
 437     my $arg = shift;    # ref to array
 438     my $got_items = shift || 0;     # print "count" line for items
 439     my @report = @$arg or return;
 440     my $i = 0;
 441     for my $range (@report) {
 442         printf "\nRange %s\nDue %3s - %3s days ago (%s to %s), lost => %s\n", ++$i,
 443             map {$range->{$_}} qw(startrange endrange date2 date1 lostvalue);
 444         $got_items and printf "  %4s items\n", $range->{count};
 445     }
 446 }
 447
 448 if (!$quiet){
 449     print "\n### LONGOVERDUE SUMMARY ###";
 450     summarize (\@report, 1);
 451     print "\nTOTAL: $total items\n";
 452 }