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