misc/cronjobs/staticfines.pl

   1 #!/usr/bin/perl
   2
   3 #  This script loops through each overdue item, determines the fine,
   4 #  and updates the total amount of fines due by each user.  It relies on
   5 #  the existence of /tmp/fines, which is created by ???
   6 # Doesnt really rely on it, it relys on being able to write to /tmp/
   7 # It creates the fines file
   8 #
   9 #  This script is meant to be run nightly out of cron.
  10
  11 # Copyright 2000-2002 Katipo Communications
  12 #
  13 # This file is part of Koha.
  14 #
  15 # Koha is free software; you can redistribute it and/or modify it under the
  16 # terms of the GNU General Public License as published by the Free Software
  17 # Foundation; either version 2 of the License, or (at your option) any later
  18 # version.
  19 #
  20 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  21 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  22 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  23 #
  24 # You should have received a copy of the GNU General Public License along
  25 # with Koha; if not, write to the Free Software Foundation, Inc.,
  26 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  27
  28 # FIXME: use FinesMode as described or change syspref description
  29 use strict;
  30
  31 #use warnings; FIXME - Bug 2505
  32
  33 BEGIN {
  34
  35     # find Koha's Perl modules
  36     # test carefully before changing this
  37     use FindBin;
  38     eval { require "$FindBin::Bin/kohalib.pl" };
  39 }
  40
  41 use Date::Calc qw/Date_to_Days/;
  42
  43 use C4::Context;
  44 use C4::Circulation;
  45 use C4::Overdues;
  46 use C4::Calendar qw();    # don't need any exports from Calendar
  47 use C4::Biblio;
  48 use C4::Debug;            # supplying $debug and $cgi_debug
  49 use Getopt::Long;
  50 use List::MoreUtils qw/none/;
  51
  52 my $help    = 0;
  53 my $verbose = 0;
  54 my $output_dir;
  55 my @pcategories;
  56 my @categories;
  57 my %catamounts;
  58 my @libraries;
  59 my $delay;
  60 my $useborrowerlibrary;
  61 my $borrowersalreadyapplied; # hashref of borrowers for whom we already applied the fine, so it's only applied once
  62 my $debug = $ENV{'DEBUG'} || 0;
  63 my $bigdebug = 0;
  64
  65 GetOptions(
  66     'h|help'      => \$help,
  67     'v|verbose'   => \$verbose,
  68     'o|out:s'     => \$output_dir,
  69     'c|category:s'=> \@pcategories,
  70     'l|library:s' => \@libraries,
  71     'd|delay:i'   => \$delay,
  72     'u|use-borrower-library' => \$useborrowerlibrary
  73 );
  74 my $usage = << 'ENDUSAGE';
  75
  76 This script calculates and charges overdue fines to patron accounts.
  77
  78 If the Koha System Preference 'finesMode' is set to 'production', the fines are charged to the patron accounts.
  79 If set to 'test', the fines are calculated but not applied.
  80
  81 Please note that the fines won't be applied on a holiday.
  82
  83 This script has the following parameters :
  84     -h --help: this message
  85     -o --out:  ouput directory for logs (defaults to env or /tmp if !exist)
  86     -v --verbose
  87     -c --category borrower_category,amount (repeatable)
  88     -l --library (repeatable)
  89     -d --delay
  90     -u --use-borrower-library: use borrower's library, regardless of the CircControl syspref
  91
  92 ENDUSAGE
  93 die $usage if $help;
  94
  95 # Processing categories
  96 foreach (@pcategories) {
  97     my ($category, $amount) = split(',', $_);
  98     push @categories, $category;
  99     $catamounts{$category} = $amount;
 100 }
 101
 102 use vars qw(@borrower_fields @item_fields @other_fields);
 103 use vars qw($fldir $libname $control $mode $delim $dbname $today $today_iso $today_days);
 104 use vars qw($filename);
 105
 106 CHECK {
 107     @borrower_fields = qw(cardnumber categorycode surname firstname email phone address citystate);
 108     @item_fields     = qw(itemnumber barcode date_due);
 109     @other_fields    = qw(type days_overdue fine);
 110     $libname         = C4::Context->preference('LibraryName');
 111     $control         = C4::Context->preference('CircControl');
 112     $mode            = C4::Context->preference('finesMode');
 113     $dbname          = C4::Context->config('database');
 114     $delim           = "\t";                                                                          # ?  C4::Context->preference('delimiter') || "\t";
 115
 116 }
 117
 118 INIT {
 119     $debug and print "Each line will contain the following fields:\n",
 120       "From borrowers : ", join( ', ', @borrower_fields ), "\n",
 121       "From items : ",     join( ', ', @item_fields ),     "\n",
 122       "Per overdue: ",     join( ', ', @other_fields ),    "\n",
 123       "Delimiter: '$delim'\n";
 124 }
 125
 126 my $data                = Getoverdues();
 127 my $overdueItemsCounted = 0;
 128 my %calendars           = ();
 129 $today      = C4::Dates->new();
 130 $today_iso  = $today->output('iso');
 131 $today_days = Date_to_Days( split( /-/, $today_iso ) );
 132
 133
 134
 135 if ($output_dir) {
 136     $fldir = $output_dir if ( -d $output_dir );
 137 } else {
 138     $fldir = $ENV{TMPDIR} || "/tmp";
 139 }
 140 if ( !-d $fldir ) {
 141     warn "Could not write to $fldir ... does not exist!";
 142 }
 143 $filename = $dbname;
 144 $filename =~ s/\W//;
 145 $filename = $fldir . '/' . $filename . '_' . $today_iso . ".log";
 146 print "writing to $filename\n" if $verbose;
 147 open my $FILE, ">", $filename or die "Cannot write file $filename: $!";
 148 print $FILE join $delim, ( @borrower_fields, @item_fields, @other_fields );
 149 print $FILE "\n";
 150
 151 for ( my $i = 0 ; $i < scalar(@$data) ; $i++ ) {
 152     my $datedue;
 153     my $datedue_days;
 154     eval {
 155         $datedue = C4::Dates->new( $data->[$i]->{'date_due'}, 'iso' );
 156         $datedue_days = Date_to_Days( split( /-/, $datedue->output('iso') ) );
 157     };
 158     if ($@) {
 159         warn "Error on date for borrower " . $data->[$i]->{'borrowernumber'} .  ": $@date_due: " . $data->[$i]->{'date_due'} . "\ndatedue_days: " . $datedue_days . "\nSkipping";
 160         next;
 161     }
 162     my $due_str = $datedue->output();
 163     unless ( defined $data->[$i]->{'borrowernumber'} ) {
 164         print STDERR "ERROR in Getoverdues line $i: issues.borrowernumber IS NULL.  Repair 'issues' table now!  Skipping record.\n";
 165         next;    # Note: this doesn't solve everything.  After NULL borrowernumber, multiple issues w/ real borrowernumbers can pile up.
 166     }
 167     my $borrower = BorType( $data->[$i]->{'borrowernumber'} );
 168
 169     # Skipping borrowers that are not in @categories
 170     $bigdebug and warn "Skipping borrower from category " . $borrower->{categorycode} if none { $borrower->{categorycode} eq $_ } @categories;
 171     next if none { $borrower->{categorycode} eq $_ } @categories;
 172
 173     my $branchcode =
 174         ( $useborrowerlibrary )           ? $borrower->{branchcode}
 175       : ( $control eq 'ItemHomeLibrary' ) ? $data->[$i]->{homebranch}
 176       : ( $control eq 'PatronLibrary' )   ? $borrower->{branchcode}
 177       :                                     $data->[$i]->{branchcode};
 178     # In final case, CircControl must be PickupLibrary. (branchcode comes from issues table here).
 179
 180     # Skipping branchcodes that are not in @libraries
 181     $bigdebug and warn "Skipping library $branchcode" if none { $branchcode eq $_ } @libraries;
 182     next if none { $branchcode eq $_ } @libraries;
 183
 184     my $calendar;
 185     unless ( defined( $calendars{$branchcode} ) ) {
 186         $calendars{$branchcode} = C4::Calendar->new( branchcode => $branchcode );
 187     }
 188     $calendar = $calendars{$branchcode};
 189     my $isHoliday = $calendar->isHoliday( split '/', $today->output('metric') );
 190
 191     # Reassing datedue_days if -delay specified in commandline
 192     $bigdebug and warn "Using commandline supplied delay : $delay" if ($delay);
 193     $datedue_days += $delay if ($delay);
 194
 195     ( $datedue_days <= $today_days ) or next;    # or it's not overdue, right?
 196
 197     $overdueItemsCounted++;
 198     my ( $amount, $type, $daycounttotal, $daycount ) = CalcFine( $data->[$i], $borrower->{'categorycode'}, $branchcode, undef, undef, $datedue, $today );
 199
 200     # Reassign fine's amount if specified in command-line
 201     $amount = $catamounts{$borrower->{'categorycode'}} if (defined $catamounts{$borrower->{'categorycode'}});
 202
 203     # FIXME: $type NEVER gets populated by anything.
 204     ( defined $type ) or $type = '';
 205
 206
 207     # Don't update the fine if today is a holiday.
 208     # This ensures that dropbox mode will remove the correct amount of fine.
 209     if ( $mode eq 'production' and !$borrowersalreadyapplied->{$data->[$i]->{'borrowernumber'}}) {
 210         # If we're on a holiday, warn the user (if debug) that no fine will be applied
 211         if($isHoliday) {
 212             $debug and warn "Today is a holiday. The fine for borrower " . $data->[$i]->{'borrowernumber'} . " will not be applied";
 213         } else {
 214             $debug and warn "Updating fine for borrower " . $data->[$i]->{'borrowernumber'} . " with amount : $amount";
 215             UpdateFine( $data->[$i]->{'itemnumber'}, $data->[$i]->{'borrowernumber'}, $amount, $type, $due_str ) if ( $amount > 0 );
 216             $borrowersalreadyapplied->{$data->[$i]->{'borrowernumber'}} = 1;
 217         }
 218     }
 219     my @cells = ();
 220     push @cells, map { $borrower->{$_} } @borrower_fields;
 221     push @cells, map { $data->[$i]->{$_} } @item_fields;
 222     push @cells, $type, $daycounttotal, $amount;
 223     print FILE join( $delim, @cells ), "\n";
 224 }
 225
 226 my $numOverdueItems = scalar(@$data);
 227 if ($verbose) {
 228     print <<EOM;
 229 Fines assessment -- $today_iso -- Saved to $filename
 230 Number of Overdue Items:
 231      counted $overdueItemsCounted
 232     reported $numOverdueItems
 233
 234 EOM
 235 }
 236
 237 close FILE;