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