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