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