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