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 under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  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 Getopt::Long;
  39
  40 my  $lost;  #  key=lost value,  value=num days.
  41 my ($charge, $verbose, $confirm, $quiet);
  42 my $endrange = 366;
  43
  44 GetOptions(
  45     'lost=s%'    => \$lost,
  46     'c|charge=s' => \$charge,
  47     'confirm'    => \$confirm,
  48     'verbose'    => \$verbose,
  49     'quiet'      => \$quiet,
  50     'maxdays=s'  => \$endrange
  51 );
  52
  53 my $usage = << 'ENDUSAGE';
  54 longoverdue.pl : This cron script set lost values on overdue items and optionally sets charges the patron's account
  55 for the item's replacement price.  It is designed to be run as a nightly job.  The command line options that globally
  56 define this behavior for this script  will likely be moved into Koha's core circulation / issuing rules code in a
  57 near-term release, so this script is not intended to have a long lifetime.
  58
  59 This script takes the following parameters :
  60
  61     --lost | -l         This option takes the form of n=lv,
  62                         where n is num days overdue, and lv is the lost value.  See warning below.
  63
  64     --charge | -c       This specifies what lost value triggers Koha to charge the account for the
  65                         lost item.  Replacement costs are not charged if this is not specified.
  66
  67     --verbose | v       verbose.
  68
  69     --confirm           confirm.  without this option, the script will report the number of affected items and
  70                         return without modifying any records.
  71
  72     --quiet             suppress summary output.
  73
  74     --maxdays           Specifies the end of the range of overdue days to deal with (defaults to 366).  This
  75                         value is universal to all lost num days overdue passed.
  76
  77   examples :
  78   $PERL5LIB/misc/cronjobs/longoverdue.pl --lost 30=1
  79     Would set LOST=1 after 30 days (up to one year), but not charge the account.
  80     This would be suitable for the Koha default LOST authorized value of 1 -> 'Lost'.
  81
  82   $PERL5LIB/misc/cronjobs/longoverdue.pl --lost 60=2 --charge 1
  83     Would set LOST=2 after 60 days (up to one year), and charge the account when setting LOST=2.
  84     This would be suitable for the Koha default LOST authorized value of 2 -> 'Long Overdue'
  85
  86 WARNING:  Flippant use of this script could set all or most of the items in your catalog to Lost and charge your
  87 patrons for them!
  88
  89 WARNING:  This script is known to be faulty.  It is NOT recommended to use multiple --lost options.
  90           See http://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=2883
  91
  92 ENDUSAGE
  93
  94 # FIXME: We need three pieces of data to operate:
  95 #         ~ lower bound (number of days),
  96 #         ~ upper bound (number of days),
  97 #         ~ new lost value.
  98 #        Right now we get only two, causing the endrange hack.  This is a design-level failure.
  99 # FIXME: do checks on --lost ranges to make sure they are exclusive.
 100 # FIXME: do checks on --lost ranges to make sure the authorized values exist.
 101 # FIXME: do checks on --lost ranges to make sure don't go past endrange.
 102 # FIXME: convert to using pod2usage
 103 # FIXME: allow --help or -h
 104 #
 105 if ( ! defined($lost) ) {
 106     print $usage;
 107     die "ERROR: No --lost (-l) option defined";
 108 }
 109 unless ($confirm) {
 110     $verbose = 1;     # If you're not running it for real, then the whole point is the print output.
 111     print "### TEST MODE -- NO ACTIONS TAKEN ###\n";
 112 }
 113
 114 # In my opinion, this line is safe SQL to have outside the API. --atz
 115 our $bounds_sth = C4::Context->dbh->prepare("SELECT DATE_SUB(CURDATE(), INTERVAL ? DAY)");
 116
 117 sub bounds ($) {
 118     $bounds_sth->execute(shift);
 119     return $bounds_sth->fetchrow;
 120 }
 121
 122 # FIXME - This sql should be inside the API.
 123 sub longoverdue_sth {
 124     my $query = "
 125     SELECT items.itemnumber, borrowernumber, date_due
 126       FROM issues, items
 127      WHERE items.itemnumber = issues.itemnumber
 128       AND  DATE_SUB(CURDATE(), INTERVAL ? DAY)  > date_due
 129       AND  DATE_SUB(CURDATE(), INTERVAL ? DAY) <= date_due
 130       AND  itemlost <> ?
 131      ORDER BY date_due
 132     ";
 133     return C4::Context->dbh->prepare($query);
 134 }
 135
 136 #FIXME - Should add a 'system' user and get suitable userenv for it for logging, etc.
 137
 138 my $count;
 139 # my @ranges = map {
 140 my @report;
 141 my $total = 0;
 142 my $i = 0;
 143
 144 # FIXME - The item is only marked returned if you supply --charge .
 145 #         We need a better way to handle this.
 146 #
 147 my $sth_items = longoverdue_sth();
 148
 149 foreach my $startrange (sort keys %$lost) {
 150     if( my $lostvalue = $lost->{$startrange} ) {
 151         my ($date1) = bounds($startrange);
 152         my ($date2) = bounds(  $endrange);
 153         # print "\nRange ", ++$i, "\nDue $startrange - $endrange days ago ($date2 to $date1), lost => $lostvalue\n" if($verbose);
 154         $verbose and
 155             printf "\nRange %s\nDue %3s - %3s days ago (%s to %s), lost => %s\n", ++$i,
 156             $startrange, $endrange, $date2, $date1, $lostvalue;
 157         $sth_items->execute($startrange, $endrange, $lostvalue);
 158         $count=0;
 159         while (my $row=$sth_items->fetchrow_hashref) {
 160             printf ("Due %s: item %5s from borrower %5s to lost: %s\n", $row->{date_due}, $row->{itemnumber}, $row->{borrowernumber}, $lostvalue) if($verbose);
 161             if($confirm) {
 162                 ModItem({ itemlost => $lostvalue }, $row->{'biblionumber'}, $row->{'itemnumber'});
 163                 LostItem($row->{'itemnumber'}, undef, 'CHARGE FEE') if( $charge && $charge eq $lostvalue);
 164             }
 165             $count++;
 166         }
 167         push @report, {
 168            startrange => $startrange,
 169              endrange => $endrange,
 170                 range => "$startrange - $endrange",
 171                 date1 => $date1,
 172                 date2 => $date2,
 173             lostvalue => $lostvalue,
 174                 count => $count,
 175         };
 176         $total += $count;
 177     }
 178     $endrange = $startrange;
 179 }
 180
 181 sub summarize ($$) {
 182     my $arg = shift;    # ref to array
 183     my $got_items = shift || 0;     # print "count" line for items
 184     my @report = @$arg or return undef;
 185     my $i = 0;
 186     for my $range (@report) {
 187         printf "\nRange %s\nDue %3s - %3s days ago (%s to %s), lost => %s\n", ++$i,
 188             map {$range->{$_}} qw(startrange endrange date2 date1 lostvalue);
 189         $got_items and printf "  %4s items\n", $range->{count};
 190     }
 191 }
 192
 193 if (!$quiet){
 194     print "\n### LONGOVERDUE SUMMARY ###";
 195     summarize (\@report, 1);
 196     print "\nTOTAL: $total items\n";
 197 }