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/;
  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 = 0;
  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
 146 =item B<--category>
 147
 148 Act on the listed borrower category code (borrowers.categorycode).
 149 Exclude all others. This may be specified multiple times to include multiple categories.
 150 May not be used with B<--skip-category>
 151
 152 =item B<--skip-category>
 153
 154 Act on all available borrower category codes, except those listed.
 155 This may be specified multiple times, to exclude multiple categories.
 156 May not be used with B<--category>
 157
 158 =item B<--list-categories>
 159
 160 List borrower categories available for use by B<--category> or
 161 B<--skip-category>, and exit.
 162
 163 =item B<--help | -h>
 164
 165 Display short help message an exit.
 166
 167 =item B<--man | --manual >
 168
 169 Display entire manual and exit.
 170
 171 =back
 172
 173 =cut
 174
 175 =head1 Description
 176
 177 This cron script set lost values on overdue items and optionally sets charges the patron's account
 178 for the item's replacement price.  It is designed to be run as a nightly job.  The command line options that globally
 179 define this behavior for this script  will likely be moved into Koha's core circulation / issuing rules code in a
 180 near-term release, so this script is not intended to have a long lifetime.
 181
 182
 183 =cut
 184
 185 =head1 Examples
 186
 187   $PERL5LIB/misc/cronjobs/longoverdue.pl --lost 30=1
 188     Would set LOST=1 after 30 days (up to one year), but not charge the account.
 189     This would be suitable for the Koha default LOST authorized value of 1 -> 'Lost'.
 190
 191   $PERL5LIB/misc/cronjobs/longoverdue.pl --lost 60=2 --charge 2
 192     Would set LOST=2 after 60 days (up to one year), and charge the account when setting LOST=2.
 193     This would be suitable for the Koha default LOST authorized value of 2 -> 'Long Overdue'
 194
 195 =cut
 196
 197 # FIXME: We need three pieces of data to operate:
 198 #         ~ lower bound (number of days),
 199 #         ~ upper bound (number of days),
 200 #         ~ new lost value.
 201 #        Right now we get only two, causing the endrange hack.  This is a design-level failure.
 202 # FIXME: do checks on --lost ranges to make sure they are exclusive.
 203 # FIXME: do checks on --lost ranges to make sure the authorized values exist.
 204 # FIXME: do checks on --lost ranges to make sure don't go past endrange.
 205 #
 206 if ( ! defined($lost) ) {
 207     my $longoverdue_value = C4::Context->preference('DefaultLongOverdueLostValue');
 208     my $longoverdue_days = C4::Context->preference('DefaultLongOverdueDays');
 209     if(defined($longoverdue_value) and defined($longoverdue_days) and $longoverdue_value ne '' and $longoverdue_days ne '' and $longoverdue_days >= 0) {
 210         $lost->{$longoverdue_days} = $longoverdue_value;
 211     }
 212     else {
 213         pod2usage( {
 214                 -exitval => 1,
 215                 -msg => q|ERROR: No --lost (-l) option defined|,
 216         } );
 217     }
 218 }
 219 if ( ! defined($charge) ) {
 220     my $charge_value = C4::Context->preference('DefaultLongOverdueChargeValue');
 221     if(defined($charge_value) and $charge_value ne '') {
 222         $charge = $charge_value;
 223     }
 224 }
 225 unless ($confirm) {
 226     $verbose = 1;     # If you're not running it for real, then the whole point is the print output.
 227     print "### TEST MODE -- NO ACTIONS TAKEN ###\n";
 228 }
 229
 230 cronlogaction();
 231
 232 # In my opinion, this line is safe SQL to have outside the API. --atz
 233 our $bounds_sth = C4::Context->dbh->prepare("SELECT DATE_SUB(CURDATE(), INTERVAL ? DAY)");
 234
 235 sub bounds ($) {
 236     $bounds_sth->execute(shift);
 237     return $bounds_sth->fetchrow;
 238 }
 239
 240 # FIXME - This sql should be inside the API.
 241 sub longoverdue_sth {
 242     my $query = "
 243     SELECT items.itemnumber, borrowernumber, date_due
 244       FROM issues, items
 245      WHERE items.itemnumber = issues.itemnumber
 246       AND  DATE_SUB(CURDATE(), INTERVAL ? DAY)  > date_due
 247       AND  DATE_SUB(CURDATE(), INTERVAL ? DAY) <= date_due
 248       AND  itemlost <> ?
 249      ORDER BY date_due
 250     ";
 251     return C4::Context->dbh->prepare($query);
 252 }
 253
 254 my $dbh = C4::Context->dbh;
 255 my @available_categories = map { uc $_->[0] } @{ $dbh->selectall_arrayref(q|SELECT categorycode FROM categories|) };
 256 $borrower_category = [ map { uc $_ } @$borrower_category ];
 257 $skip_borrower_category = [ map { uc $_} @$skip_borrower_category ];
 258 my %category_to_process;
 259 for my $cat ( @$borrower_category ) {
 260     unless ( grep { /^$cat$/ } @available_categories ) {
 261         pod2usage(
 262             '-exitval' => 1,
 263             '-message' => "The category $cat does not exist in the database",
 264         );
 265     }
 266     $category_to_process{$cat} = 1;
 267 }
 268 if ( @$skip_borrower_category ) {
 269     for my $cat ( @$skip_borrower_category ) {
 270         unless ( grep { /^$cat$/ } @available_categories ) {
 271             pod2usage(
 272                 '-exitval' => 1,
 273                 '-message' => "The category $cat does not exist in the database",
 274             );
 275         }
 276     }
 277     %category_to_process = map { $_ => 1 } @available_categories;
 278     %category_to_process = ( %category_to_process, map { $_ => 0 } @$skip_borrower_category );
 279 }
 280
 281 my $filter_borrower_categories = ( scalar @$borrower_category || scalar @$skip_borrower_category );
 282
 283 my $count;
 284 my @report;
 285 my $total = 0;
 286 my $i = 0;
 287
 288 # FIXME - The item is only marked returned if you supply --charge .
 289 #         We need a better way to handle this.
 290 #
 291 my $sth_items = longoverdue_sth();
 292
 293 foreach my $startrange (sort keys %$lost) {
 294     if( my $lostvalue = $lost->{$startrange} ) {
 295         my ($date1) = bounds($startrange);
 296         my ($date2) = bounds(  $endrange);
 297         # print "\nRange ", ++$i, "\nDue $startrange - $endrange days ago ($date2 to $date1), lost => $lostvalue\n" if($verbose);
 298         $verbose and
 299             printf "\nRange %s\nDue %3s - %3s days ago (%s to %s), lost => %s\n", ++$i,
 300             $startrange, $endrange, $date2, $date1, $lostvalue;
 301         $sth_items->execute($startrange, $endrange, $lostvalue);
 302         $count=0;
 303         ITEM: while (my $row=$sth_items->fetchrow_hashref) {
 304             if( $filter_borrower_categories ) {
 305                 my $category = uc Koha::Patrons->find( $row->{borrowernumber} )->categorycode();
 306                 next ITEM unless ( $category_to_process{ $category } );
 307             }
 308             printf ("Due %s: item %5s from borrower %5s to lost: %s\n", $row->{date_due}, $row->{itemnumber}, $row->{borrowernumber}, $lostvalue) if($verbose);
 309             if($confirm) {
 310                 ModItem({ itemlost => $lostvalue }, $row->{'biblionumber'}, $row->{'itemnumber'});
 311                 LostItem($row->{'itemnumber'}, $mark_returned) if( $charge && $charge eq $lostvalue);
 312             }
 313             $count++;
 314         }
 315         push @report, {
 316            startrange => $startrange,
 317              endrange => $endrange,
 318                 range => "$startrange - $endrange",
 319                 date1 => $date1,
 320                 date2 => $date2,
 321             lostvalue => $lostvalue,
 322                 count => $count,
 323         };
 324         $total += $count;
 325     }
 326     $endrange = $startrange;
 327 }
 328
 329 sub summarize ($$) {
 330     my $arg = shift;    # ref to array
 331     my $got_items = shift || 0;     # print "count" line for items
 332     my @report = @$arg or return undef;
 333     my $i = 0;
 334     for my $range (@report) {
 335         printf "\nRange %s\nDue %3s - %3s days ago (%s to %s), lost => %s\n", ++$i,
 336             map {$range->{$_}} qw(startrange endrange date2 date1 lostvalue);
 337         $got_items and printf "  %4s items\n", $range->{count};
 338     }
 339 }
 340
 341 if (!$quiet){
 342     print "\n### LONGOVERDUE SUMMARY ###";
 343     summarize (\@report, 1);
 344     print "\nTOTAL: $total items\n";
 345 }