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