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