View | Details | Raw Unified | Return to bug 6858
Collapse All | Expand All

(-)a/misc/cronjobs/staticfines.pl (-1 / +227 lines)
Line 0 Link Here
0
- 
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 = 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
77
to patron accounts.  If the Koha System Preference
78
'finesMode' is set to 'production', the fines are charged
79
to the patron accounts.  If set to 'test', the fines are
80
calculated but not applied.
81
82
This script has the following parameters :
83
    -h --help: this message
84
    -o --out:  ouput directory for logs (defaults to env or /tmp if !exist)
85
    -v --verbose
86
    -c --category borrower_category,amount (repeatable)
87
    -l --library  (repeatable)
88
    -d --delay
89
    -u --use-borrower-libraray: use borrower's libraray, regardless of the CircControl syspref
90
91
ENDUSAGE
92
die $usage if $help;
93
94
# Processing categories
95
foreach (@pcategories) {
96
    my ($category, $amount) = split(',', $_);
97
    push @categories, $category;
98
    $catamounts{$category} = $amount;
99
}
100
101
use vars qw(@borrower_fields @item_fields @other_fields);
102
use vars qw($fldir $libname $control $mode $delim $dbname $today $today_iso $today_days);
103
use vars qw($filename);
104
105
CHECK {
106
    @borrower_fields = qw(cardnumber categorycode surname firstname email phone address citystate);
107
    @item_fields     = qw(itemnumber barcode date_due);
108
    @other_fields    = qw(type days_overdue fine);
109
    $libname         = C4::Context->preference('LibraryName');
110
    $control         = C4::Context->preference('CircControl');
111
    $mode            = C4::Context->preference('finesMode');
112
    $dbname          = C4::Context->config('database');
113
    $delim           = "\t";                                                                          # ?  C4::Context->preference('delimiter') || "\t";
114
115
}
116
117
INIT {
118
    $debug and print "Each line will contain the following fields:\n",
119
      "From borrowers : ", join( ', ', @borrower_fields ), "\n",
120
      "From items : ",     join( ', ', @item_fields ),     "\n",
121
      "Per overdue: ",     join( ', ', @other_fields ),    "\n",
122
      "Delimiter: '$delim'\n";
123
}
124
125
my $data                = Getoverdues();
126
my $overdueItemsCounted = 0;
127
my %calendars           = ();
128
$today      = C4::Dates->new();
129
$today_iso  = $today->output('iso');
130
$today_days = Date_to_Days( split( /-/, $today_iso ) );
131
if ($output_dir) {
132
    $fldir = $output_dir if ( -d $output_dir );
133
} else {
134
    $fldir = $ENV{TMPDIR} || "/tmp";
135
}
136
if ( !-d $fldir ) {
137
    warn "Could not write to $fldir ... does not exist!";
138
}
139
$filename = $dbname;
140
$filename =~ s/\W//;
141
$filename = $fldir . '/' . $filename . '_' . $today_iso . ".log";
142
print "writing to $filename\n" if $verbose;
143
open( FILE, ">$filename" ) or die "Cannot write file $filename: $!";
144
print FILE join $delim, ( @borrower_fields, @item_fields, @other_fields );
145
print FILE "\n";
146
147
for ( my $i = 0 ; $i < scalar(@$data) ; $i++ ) {
148
    my $datedue;
149
    my $datedue_days;
150
    eval {
151
	$datedue = C4::Dates->new( $data->[$i]->{'date_due'}, 'iso' );
152
	$datedue_days = Date_to_Days( split( /-/, $datedue->output('iso') ) );
153
    };
154
    if ($@) {
155
	warn "Error on date for borrower " . $data->[$i]->{'borrowernumber'} .  ": $@date_due: " . $data->[$i]->{'date_due'} . "\ndatedue_days: " . $datedue_days . "\nSkipping";
156
	next;
157
    }
158
    my $due_str = $datedue->output();
159
    unless ( defined $data->[$i]->{'borrowernumber'} ) {
160
        print STDERR "ERROR in Getoverdues line $i: issues.borrowernumber IS NULL.  Repair 'issues' table now!  Skipping record.\n";
161
        next;    # Note: this doesn't solve everything.  After NULL borrowernumber, multiple issues w/ real borrowernumbers can pile up.
162
    }
163
    my $borrower = BorType( $data->[$i]->{'borrowernumber'} );
164
    
165
    # Skipping borrowers that are not in @categories
166
    $bigdebug and warn "Skipping borrower from category " . $borrower->{categorycode} if none { $borrower->{categorycode} eq $_ } @categories;
167
    next if none { $borrower->{categorycode} eq $_ } @categories;
168
169
    my $branchcode =
170
        ( $useborrowerlibrary )           ? $borrower->{branchcode}
171
      : ( $control eq 'ItemHomeLibrary' ) ? $data->[$i]->{homebranch}
172
      : ( $control eq 'PatronLibrary' )   ? $borrower->{branchcode}
173
      :                                     $data->[$i]->{branchcode};
174
    # In final case, CircControl must be PickupLibrary. (branchcode comes from issues table here).
175
176
    # Skipping branchcodes that are not in @libraries
177
    $bigdebug and warn "Skipping library $branchcode" if none { $branchcode eq $_ } @libraries;
178
    next if none { $branchcode eq $_ } @libraries;
179
180
    my $calendar;
181
    unless ( defined( $calendars{$branchcode} ) ) {
182
        $calendars{$branchcode} = C4::Calendar->new( branchcode => $branchcode );
183
    }
184
    $calendar = $calendars{$branchcode};
185
    my $isHoliday = $calendar->isHoliday( split '/', $today->output('metric') );
186
187
    # Reassing datedue_days if -delay specified in commandline
188
    $bigdebug and warn "Using commandline supplied delay : $delay" if ($delay);
189
    $datedue_days += $delay if ($delay);
190
191
    ( $datedue_days <= $today_days ) or next;    # or it's not overdue, right?
192
193
    $overdueItemsCounted++;
194
    my ( $amount, $type, $daycounttotal, $daycount ) = CalcFine( $data->[$i], $borrower->{'categorycode'}, $branchcode, undef, undef, $datedue, $today );
195
196
    # Reassign fine's amount if specified in command-line
197
    $amount = %catamounts->{$borrower->{'categorycode'}} if (defined %catamounts->{$borrower->{'categorycode'}});
198
199
    # FIXME: $type NEVER gets populated by anything.
200
    ( defined $type ) or $type = '';
201
202
    # Don't update the fine if today is a holiday.
203
    # This ensures that dropbox mode will remove the correct amount of fine.
204
    if ( $mode eq 'production' and !$isHoliday and !$borrowersalreadyapplied->{$data->[$i]->{'borrowernumber'}}) {
205
	$debug and warn "Updating fine for borrower " . $data->[$i]->{'borrowernumber'} . " with amount : $amount";
206
        UpdateFine( $data->[$i]->{'itemnumber'}, $data->[$i]->{'borrowernumber'}, $amount, $type, $due_str ) if ( $amount > 0 );
207
	$borrowersalreadyapplied->{$data->[$i]->{'borrowernumber'}} = 1;
208
    }
209
    my @cells = ();
210
    push @cells, map { $borrower->{$_} } @borrower_fields;
211
    push @cells, map { $data->[$i]->{$_} } @item_fields;
212
    push @cells, $type, $daycounttotal, $amount;
213
    print FILE join( $delim, @cells ), "\n";
214
}
215
216
my $numOverdueItems = scalar(@$data);
217
if ($verbose) {
218
    print <<EOM;
219
Fines assessment -- $today_iso -- Saved to $filename
220
Number of Overdue Items:
221
     counted $overdueItemsCounted
222
    reported $numOverdueItems
223
224
EOM
225
}
226
227
close FILE;

Return to bug 6858