misc/cronjobs/fines.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 # Copyright 2011 PTFS-Europe Ltd
  13 #
  14 # This file is part of Koha.
  15 #
  16 # Koha is free software; you can redistribute it and/or modify it under the
  17 # terms of the GNU General Public License as published by the Free Software
  18 # Foundation; either version 2 of the License, or (at your option) any later
  19 # version.
  20 #
  21 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  22 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  23 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  24 #
  25 # You should have received a copy of the GNU General Public License along
  26 # with Koha; if not, write to the Free Software Foundation, Inc.,
  27 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  28
  29 use strict;
  30 use warnings;
  31 use 5.010;
  32
  33 use C4::Context;
  34 use C4::Overdues;
  35 use Getopt::Long;
  36 use Carp;
  37 use File::Spec;
  38
  39 use Koha::Calendar;
  40 use Koha::DateUtils;
  41
  42 my $help;
  43 my $verbose;
  44 my $output_dir;
  45 my $log;
  46
  47 GetOptions(
  48     'h|help'    => \$help,
  49     'v|verbose' => \$verbose,
  50     'l|log'     => \$log,
  51     'o|out:s'   => \$output_dir,
  52 );
  53 my $usage = << 'ENDUSAGE';
  54
  55 This script calculates and charges overdue fines
  56 to patron accounts.  The Koha system preference 'finesMode' controls
  57 whether the fines are calculated and charged to the patron accounts ("Calculate and charge");
  58 calculated and emailed to the admin but not applied ("Calculate (but only for mailing to the admin)"); or not calculated ("Don't calculate").
  59
  60 This script has the following parameters :
  61     -h --help: this message
  62     -l --log: log the output to a file (optional if the -o parameter is given)
  63     -o --out:  ouput directory for logs (defaults to env or /tmp if !exist)
  64     -v --verbose
  65
  66 ENDUSAGE
  67
  68 if ($help) {
  69     print $usage;
  70     exit;
  71 }
  72
  73 my @borrower_fields =
  74   qw(cardnumber categorycode surname firstname email phone address citystate);
  75 my @item_fields  = qw(itemnumber barcode date_due);
  76 my @other_fields = qw(type days_overdue fine);
  77 my $libname      = C4::Context->preference('LibraryName');
  78 my $control      = C4::Context->preference('CircControl');
  79 my $mode         = C4::Context->preference('finesMode');
  80 my $delim = "\t";    # ?  C4::Context->preference('delimiter') || "\t";
  81
  82 my %is_holiday;
  83 my $today = DateTime->now( time_zone => C4::Context->tz() );
  84 my $filename;
  85 if ($log or $output_dir) {
  86     $filename = get_filename($output_dir);
  87 }
  88
  89 my $fh;
  90 if ($filename) {
  91     open $fh, '>>', $filename or croak "Cannot write file $filename: $!";
  92     print {$fh} join $delim, ( @borrower_fields, @item_fields, @other_fields );
  93     print {$fh} "\n";
  94 }
  95 my $counted = 0;
  96 my $overdues = Getoverdues();
  97 for my $overdue ( @{$overdues} ) {
  98     if ( !defined $overdue->{borrowernumber} ) {
  99         carp
 100 "ERROR in Getoverdues : issues.borrowernumber IS NULL.  Repair 'issues' table now!  Skipping record.\n";
 101         next;
 102     }
 103     my $borrower = BorType( $overdue->{borrowernumber} );
 104     my $branchcode =
 105         ( $control eq 'ItemHomeLibrary' ) ? $overdue->{homebranch}
 106       : ( $control eq 'PatronLibrary' )   ? $borrower->{branchcode}
 107       :                                     $overdue->{branchcode};
 108
 109 # In final case, CircControl must be PickupLibrary. (branchcode comes from issues table here).
 110     if ( !exists $is_holiday{$branchcode} ) {
 111         $is_holiday{$branchcode} = set_holiday( $branchcode, $today );
 112     }
 113
 114     my $datedue = dt_from_string( $overdue->{date_due} );
 115     if ( DateTime->compare( $datedue, $today ) == 1 ) {
 116         next;    # not overdue
 117     }
 118     ++$counted;
 119
 120     my ( $amount, $type, $unitcounttotal ) =
 121       CalcFine( $overdue, $borrower->{categorycode},
 122         $branchcode, $datedue, $today );
 123     $type ||= q{};
 124
 125     # Don't update the fine if today is a holiday.
 126     # This ensures that dropbox mode will remove the correct amount of fine.
 127     if ( $mode eq 'production' && !$is_holiday{$branchcode} ) {
 128         if ( $amount > 0 ) {
 129             UpdateFine(
 130                 $overdue->{itemnumber},
 131                 $overdue->{borrowernumber},
 132                 $amount, $type, output_pref($datedue)
 133             );
 134         }
 135     }
 136     if ($filename) {
 137         my @cells;
 138         push @cells,
 139           map { defined $borrower->{$_} ? $borrower->{$_} : q{} }
 140           @borrower_fields;
 141         push @cells, map { $overdue->{$_} } @item_fields;
 142         push @cells, $type, $unitcounttotal, $amount;
 143         say {$fh} join $delim, @cells;
 144     }
 145 }
 146 if ($filename){
 147     close $fh;
 148 }
 149
 150 if ($verbose) {
 151     my $overdue_items = @{$overdues};
 152     print <<"EOM";
 153 Fines assessment -- $today
 154 EOM
 155     if ($filename) {
 156         say "Saved to $filename";
 157     }
 158     print <<"EOM";
 159 Number of Overdue Items:
 160      counted $overdue_items
 161     reported $counted
 162
 163 EOM
 164 }
 165
 166 sub set_holiday {
 167     my ( $branch, $dt ) = @_;
 168
 169     my $calendar = Koha::Calendar->new( branchcode => $branch );
 170     return $calendar->is_holiday($dt);
 171 }
 172
 173 sub get_filename {
 174     my $directory = shift;
 175     if ( !$directory ) {
 176         $directory = File::Spec->tmpdir();
 177     }
 178     if ( !-d $directory ) {
 179         carp "Could not write to $directory ... does not exist!";
 180     }
 181     my $name = C4::Context->config('database');
 182     $name =~ s/\W//;
 183     $name .= join q{}, q{_}, $today->ymd(), '.log';
 184     $name = File::Spec->catfile( $directory, $name );
 185     if ($verbose && $log) {
 186         say "writing to $name";
 187     }
 188     return $name;
 189 }