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
  46 my  $lost;  #  key=lost value,  value=num days.
  47 my ($charge, $verbose, $confirm, $quiet);
  48 my $endrange = 366;
  49 my $mark_returned;
  50 my $borrower_category = [];
  51 my $skip_borrower_category = [];
  52 my $itemtype = [];
  53 my $skip_itemtype = [];
  54 my $help=0;
  55 my $man=0;
  56 my $list_categories = 0;
  57 my $list_itemtypes = 0;
  58
  59 GetOptions(
  60     'l|lost=s%'       => \$lost,
  61     'c|charge=s'      => \$charge,
  62     'confirm'         => \$confirm,
  63     'v|verbose'       => \$verbose,
  64     'quiet'           => \$quiet,
  65     'maxdays=s'       => \$endrange,
  66     'mark-returned'   => \$mark_returned,
  67     'h|help'          => \$help,
  68     'man|manual'      => \$man,
  69     'category=s'      => $borrower_category,
  70     'skip-category=s' => $skip_borrower_category,
  71     'list-categories' => \$list_categories,
  72     'itemtype=s'      => \$itemtype,
  73     'skip-itemtype=s' => \$skip_itemtype,
  74     'list-itemtypes'  => \$list_itemtypes,
  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 mually exclusive.\n"
 100                            . "Use one or the other.",
 101                -exitval => 1
 102             );
 103 }
 104
 105 if ( $list_categories ) {
 106     my @categories = sort map { uc $_->[0] } @{ C4::Context->dbh->selectall_arrayref(q|SELECT categorycode FROM categories|) };
 107     print "\nBorrower Categories: " . join( " ", @categories ) . "\n\n";
 108     exit 0;
 109 }
 110
 111 if ( $list_itemtypes ) {
 112     my @itemtypes = sort map { uc $_->[0] } @{ C4::Context->dbh->selectall_arrayref(q|SELECT itemtype FROM itemtypes|) };
 113     print "\nItemtypes: " . join( " ", @itemtypes ) . "\n\n";
 114     exit 0;
 115 }
 116
 117 =head1 SYNOPSIS
 118
 119    longoverdue.pl [ --help | -h | --man | --list-categories ]
 120    longoverdue.pl --lost | -l DAYS=LOST_CODE [ --charge | -c CHARGE_CODE ] [ --verbose | -v ] [ --quiet ]
 121                   [ --maxdays MAX_DAYS ] [ --mark-returned ] [ --category BORROWER_CATEGORY ] ...
 122                   [ --skip-category BORROWER_CATEGORY ] ...
 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<--list-itemtypes>
 199
 200 List itemtypes available for use by B<--itemtype> or
 201 B<--skip-itemtype>, and exit.
 202
 203 =item B<--help | -h>
 204
 205 Display short help message an exit.
 206
 207 =item B<--man | --manual >
 208
 209 Display entire manual and exit.
 210
 211 =back
 212
 213 =cut
 214
 215 =head1 Description
 216
 217 This cron script set lost values on overdue items and optionally sets charges the patron's account
 218 for the item's replacement price.  It is designed to be run as a nightly job.  The command line options that globally
 219 define this behavior for this script  will likely be moved into Koha's core circulation / issuing rules code in a
 220 near-term release, so this script is not intended to have a long lifetime.
 221
 222
 223 =cut
 224
 225 =head1 Examples
 226
 227   $PERL5LIB/misc/cronjobs/longoverdue.pl --lost 30=1
 228     Would set LOST=1 after 30 days (up to one year), but not charge the account.
 229     This would be suitable for the Koha default LOST authorized value of 1 -> 'Lost'.
 230
 231   $PERL5LIB/misc/cronjobs/longoverdue.pl --lost 60=2 --charge 2
 232     Would set LOST=2 after 60 days (up to one year), and charge the account when setting LOST=2.
 233     This would be suitable for the Koha default LOST authorized value of 2 -> 'Long Overdue'
 234
 235 =cut
 236
 237 # FIXME: We need three pieces of data to operate:
 238 #         ~ lower bound (number of days),
 239 #         ~ upper bound (number of days),
 240 #         ~ new lost value.
 241 #        Right now we get only two, causing the endrange hack.  This is a design-level failure.
 242 # FIXME: do checks on --lost ranges to make sure they are exclusive.
 243 # FIXME: do checks on --lost ranges to make sure the authorized values exist.
 244 # FIXME: do checks on --lost ranges to make sure don't go past endrange.
 245 #
 246 if ( ! defined($lost) ) {
 247     my $longoverdue_value = C4::Context->preference('DefaultLongOverdueLostValue');
 248     my $longoverdue_days = C4::Context->preference('DefaultLongOverdueDays');
 249     if(defined($longoverdue_value) and defined($longoverdue_days) and $longoverdue_value ne '' and $longoverdue_days ne '' and $longoverdue_days >= 0) {
 250         $lost->{$longoverdue_days} = $longoverdue_value;
 251     }
 252     else {
 253         pod2usage( {
 254                 -exitval => 1,
 255                 -msg => q|ERROR: No --lost (-l) option defined|,
 256         } );
 257     }
 258 }
 259 if ( ! defined($charge) ) {
 260     my $charge_value = C4::Context->preference('DefaultLongOverdueChargeValue');
 261     if(defined($charge_value) and $charge_value ne '') {
 262         $charge = $charge_value;
 263     }
 264 }
 265 unless ($confirm) {
 266     $verbose = 1;     # If you're not running it for real, then the whole point is the print output.
 267     print "### TEST MODE -- NO ACTIONS TAKEN ###\n";
 268 }
 269
 270 cronlogaction();
 271
 272 # In my opinion, this line is safe SQL to have outside the API. --atz
 273 our $bounds_sth = C4::Context->dbh->prepare("SELECT DATE_SUB(CURDATE(), INTERVAL ? DAY)");
 274
 275 sub bounds ($) {
 276     $bounds_sth->execute(shift);
 277     return $bounds_sth->fetchrow;
 278 }
 279
 280 # FIXME - This sql should be inside the API.
 281 sub longoverdue_sth {
 282     my $query = "
 283     SELECT items.itemnumber, borrowernumber, date_due
 284       FROM issues, items
 285      WHERE items.itemnumber = issues.itemnumber
 286       AND  DATE_SUB(CURDATE(), INTERVAL ? DAY)  > date_due
 287       AND  DATE_SUB(CURDATE(), INTERVAL ? DAY) <= date_due
 288       AND  itemlost <> ?
 289      ORDER BY date_due
 290     ";
 291     return C4::Context->dbh->prepare($query);
 292 }
 293
 294 my $dbh = C4::Context->dbh;
 295
 296 my @available_categories = map { uc $_->[0] } @{ $dbh->selectall_arrayref(q|SELECT categorycode FROM categories|) };
 297 $borrower_category = [ map { uc $_ } @$borrower_category ];
 298 $skip_borrower_category = [ map { uc $_} @$skip_borrower_category ];
 299 my %category_to_process;
 300 for my $cat ( @$borrower_category ) {
 301     unless ( grep { /^$cat$/ } @available_categories ) {
 302         pod2usage(
 303             '-exitval' => 1,
 304             '-message' => "The category $cat does not exist in the database",
 305         );
 306     }
 307     $category_to_process{$cat} = 1;
 308 }
 309 if ( @$skip_borrower_category ) {
 310     for my $cat ( @$skip_borrower_category ) {
 311         unless ( grep { /^$cat$/ } @available_categories ) {
 312             pod2usage(
 313                 '-exitval' => 1,
 314                 '-message' => "The category $cat does not exist in the database",
 315             );
 316         }
 317     }
 318     %category_to_process = map { $_ => 1 } @available_categories;
 319     %category_to_process = ( %category_to_process, map { $_ => 0 } @$skip_borrower_category );
 320 }
 321
 322 my $filter_borrower_categories = ( scalar @$borrower_category || scalar @$skip_borrower_category );
 323
 324 my @available_itemtypes = map { uc $_->[0] } @{ $dbh->selectall_arrayref(q|SELECT itemtype FROM itemtypes|) };
 325 $itemtype = [ map { uc $_ } @$itemtype ];
 326 $skip_itemtype = [ map { uc $_} @$skip_itemtype ];
 327 my %itemtype_to_process;
 328 for my $it ( @$itemtype ) {
 329     unless ( grep { /^$it$/ } @available_itemtypes ) {
 330         pod2usage(
 331             '-exitval' => 1,
 332             '-message' => "The itemtype $it does not exist in the database",
 333         );
 334     }
 335     $itemtype_to_process{$it} = 1;
 336 }
 337 if ( @$skip_itemtype ) {
 338     for my $it ( @$skip_itemtype ) {
 339         unless ( grep { /^$it$/ } @available_itemtypes ) {
 340             pod2usage(
 341                 '-exitval' => 1,
 342                 '-message' => "The itemtype $it does not exist in the database",
 343             );
 344         }
 345     }
 346     %itemtype_to_process = map { $_ => 1 } @available_itemtypes;
 347     %itemtype_to_process = ( %itemtype_to_process, map { $_ => 0 } @$skip_itemtype );
 348 }
 349
 350 my $filter_itemtypes = ( scalar @$itemtype || scalar @$skip_itemtype );
 351
 352 my $count;
 353 my @report;
 354 my $total = 0;
 355 my $i = 0;
 356
 357 # FIXME - The item is only marked returned if you supply --charge .
 358 #         We need a better way to handle this.
 359 #
 360 my $sth_items = longoverdue_sth();
 361
 362 foreach my $startrange (sort keys %$lost) {
 363     if( my $lostvalue = $lost->{$startrange} ) {
 364         my ($date1) = bounds($startrange);
 365         my ($date2) = bounds(  $endrange);
 366         # print "\nRange ", ++$i, "\nDue $startrange - $endrange days ago ($date2 to $date1), lost => $lostvalue\n" if($verbose);
 367         $verbose and
 368             printf "\nRange %s\nDue %3s - %3s days ago (%s to %s), lost => %s\n", ++$i,
 369             $startrange, $endrange, $date2, $date1, $lostvalue;
 370         $sth_items->execute($startrange, $endrange, $lostvalue);
 371         $count=0;
 372         ITEM: while (my $row=$sth_items->fetchrow_hashref) {
 373             if( $filter_borrower_categories ) {
 374                 my $category = uc Koha::Patrons->find( $row->{borrowernumber} )->categorycode();
 375                 next ITEM unless ( $category_to_process{ $category } );
 376             }
 377             if ($filter_itemtypes) {
 378                 my $it = uc Koha::Items->find( $row->{itemnumber} )->effective_itemtype();
 379                 next ITEM unless ( $itemtype_to_process{$it} );
 380             }
 381             printf ("Due %s: item %5s from borrower %5s to lost: %s\n", $row->{date_due}, $row->{itemnumber}, $row->{borrowernumber}, $lostvalue) if($verbose);
 382             if($confirm) {
 383                 ModItem({ itemlost => $lostvalue }, $row->{'biblionumber'}, $row->{'itemnumber'});
 384                 if ( $charge && $charge eq $lostvalue ) {
 385                     LostItem( $row->{'itemnumber'}, 'cronjob', $mark_returned );
 386                 } elsif ( $mark_returned ) {
 387                     my $patron = Koha::Patrons->find( $row->{borrowernumber} );
 388                     MarkIssueReturned($row->{borrowernumber},$row->{itemnumber},undef,$patron->privacy)
 389                 }
 390             }
 391             $count++;
 392         }
 393         push @report, {
 394            startrange => $startrange,
 395              endrange => $endrange,
 396                 range => "$startrange - $endrange",
 397                 date1 => $date1,
 398                 date2 => $date2,
 399             lostvalue => $lostvalue,
 400                 count => $count,
 401         };
 402         $total += $count;
 403     }
 404     $endrange = $startrange;
 405 }
 406
 407 sub summarize ($$) {
 408     my $arg = shift;    # ref to array
 409     my $got_items = shift || 0;     # print "count" line for items
 410     my @report = @$arg or return undef;
 411     my $i = 0;
 412     for my $range (@report) {
 413         printf "\nRange %s\nDue %3s - %3s days ago (%s to %s), lost => %s\n", ++$i,
 414             map {$range->{$_}} qw(startrange endrange date2 date1 lostvalue);
 415         $got_items and printf "  %4s items\n", $range->{count};
 416     }
 417 }
 418
 419 if (!$quiet){
 420     print "\n### LONGOVERDUE SUMMARY ###";
 421     summarize (\@report, 1);
 422     print "\nTOTAL: $total items\n";
 423 }