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 # Doesn't really rely on it, it relies on being able to write to /tmp/
7 # It creates the fines file
9 # This script is meant to be run nightly out of cron.
11 # Copyright 2011-2012 BibLibre
13 # This file is part of Koha.
15 # Koha is free software; you can redistribute it and/or modify it
16 # under the terms of the GNU General Public License as published by
17 # the Free Software Foundation; either version 3 of the License, or
18 # (at your option) any later version.
20 # Koha is distributed in the hope that it will be useful, but
21 # WITHOUT ANY WARRANTY; without even the implied warranty of
22 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 # GNU General Public License for more details.
25 # You should have received a copy of the GNU General Public License
26 # along with Koha; if not, see <http://www.gnu.org/licenses>.
32 # find Koha's Perl modules
33 # test carefully before changing this
35 eval { require "$FindBin::Bin/kohalib.pl" };
38 use Date
::Calc qw
/Date_to_Days/;
43 use C4
::Calendar
qw(); # don't need any exports from Calendar
45 use C4
::Debug
; # supplying $debug and $cgi_debug
48 use List
::MoreUtils qw
/none/;
58 my $useborrowerlibrary;
59 my $borrowernumberlimit;
60 my $borrowersalreadyapplied; # hashref of borrowers for whom we already applied the fine, so it's only applied once
61 my $debug = $ENV{'DEBUG'} || 0;
66 'v|verbose' => \
$verbose,
67 'c|category:s'=> \
@pcategories,
68 'l|library:s' => \
@libraries,
69 'd|delay:i' => \
$delay,
70 'u|use-borrower-library' => \
$useborrowerlibrary,
71 'b|borrower:i' => \
$borrowernumberlimit
73 my $usage = << 'ENDUSAGE';
75 This script calculates
and charges overdue fines to patron accounts
.
77 If the Koha System Preference
'finesMode' is set to
'production', the fines are charged to the patron accounts
.
78 If set to
'test', the fines are calculated but
not applied
.
80 Please note that the fines won
't be applied on a holiday.
82 This script has the following parameters :
83 -h --help: this message
85 -c --category borrower_category,amount (repeatable)
86 -l --library (repeatable)
88 -u --use-borrower-library: use borrower's library
, regardless of the CircControl syspref
89 -b
--borrower borrowernumber
: only
for one
given borrower
96 my $dbh = C4
::Context
->dbh;
98 # Processing categories
99 foreach (@pcategories) {
100 my ($category, $amount) = split(',', $_);
101 push @categories, $category;
102 $catamounts{$category} = $amount;
105 use vars
qw(@borrower_fields @item_fields @other_fields);
106 use vars qw($fldir $libname $control $mode $delim $dbname $today $today_iso $today_days);
107 use vars qw($filename);
110 @borrower_fields = qw(cardnumber categorycode surname firstname email phone address citystate);
111 @item_fields = qw(itemnumber barcode date_due);
112 @other_fields = qw(type days_overdue fine);
113 $libname = C4
::Context
->preference('LibraryName');
114 $control = C4
::Context
->preference('CircControl');
115 $mode = C4
::Context
->preference('finesMode');
116 $dbname = C4
::Context
->config('database');
117 $delim = "\t"; # ? C4::Context->preference('delimiter') || "\t";
122 $debug and print "Each line will contain the following fields:\n",
123 "From borrowers : ", join( ', ', @borrower_fields ), "\n",
124 "From items : ", join( ', ', @item_fields ), "\n",
125 "Per overdue: ", join( ', ', @other_fields ), "\n",
126 "Delimiter: '$delim'\n";
128 $debug and (defined $borrowernumberlimit) and print "--borrower limitation: borrower $borrowernumberlimit\n";
129 my ($numOverdueItems, $data);
130 if (defined $borrowernumberlimit) {
131 ($numOverdueItems, $data) = checkoverdues
($borrowernumberlimit);
133 $data = Getoverdues
();
134 $numOverdueItems = scalar @
$data;
136 my $overdueItemsCounted = 0;
138 $today = dt_from_string
;
139 $today_iso = output_pref
( { dt
=> $today, dateonly
=> 1, dateformat
=> 'iso' } );
140 my ($tyear, $tmonth, $tday) = split( /-/, $today_iso );
141 $today_days = Date_to_Days
( $tyear, $tmonth, $tday );
143 for ( my $i = 0 ; $i < scalar(@
$data) ; $i++ ) {
144 next if $data->[$i]->{'itemlost'};
145 my ( $datedue, $datedue_days );
147 $datedue = dt_from_string
( $data->[$i]->{'date_due'} );
148 my $datedue_iso = output_pref
( { dt
=> $datedue, dateonly
=> 1, dateformat
=> 'iso' } );
149 $datedue_days = Date_to_Days
( split( /-/, $datedue_iso ) );
152 warn "Error on date for borrower " . $data->[$i]->{'borrowernumber'} . ": $@date_due: " . $data->[$i]->{'date_due'} . "\ndatedue_days: " . $datedue_days . "\nSkipping";
155 my $due_str = output_pref
( { dt
=> $datedue, dateonly
=> 1 } );
156 unless ( defined $data->[$i]->{'borrowernumber'} ) {
157 print STDERR
"ERROR in Getoverdues line $i: issues.borrowernumber IS NULL. Repair 'issues' table now! Skipping record.\n";
158 next; # Note: this doesn't solve everything. After NULL borrowernumber, multiple issues w/ real borrowernumbers can pile up.
160 my $borrower = BorType
( $data->[$i]->{'borrowernumber'} );
162 # Skipping borrowers that are not in @categories
163 $bigdebug and warn "Skipping borrower from category " . $borrower->{categorycode
} if none
{ $borrower->{categorycode
} eq $_ } @categories;
164 next if none
{ $borrower->{categorycode
} eq $_ } @categories;
167 ( $useborrowerlibrary ) ?
$borrower->{branchcode
}
168 : ( $control eq 'ItemHomeLibrary' ) ?
$data->[$i]->{homebranch
}
169 : ( $control eq 'PatronLibrary' ) ?
$borrower->{branchcode
}
170 : $data->[$i]->{branchcode
};
171 # In final case, CircControl must be PickupLibrary. (branchcode comes from issues table here).
173 # Skipping branchcodes that are not in @libraries
174 $bigdebug and warn "Skipping library $branchcode" if none
{ $branchcode eq $_ } @libraries;
175 next if none
{ $branchcode eq $_ } @libraries;
178 unless ( defined( $calendars{$branchcode} ) ) {
179 $calendars{$branchcode} = C4
::Calendar
->new( branchcode
=> $branchcode );
181 $calendar = $calendars{$branchcode};
182 my $isHoliday = $calendar->isHoliday( $tday, $tmonth, $tyear );
184 # Reassing datedue_days if -delay specified in commandline
185 $bigdebug and warn "Using commandline supplied delay : $delay" if ($delay);
186 $datedue_days += $delay if ($delay);
188 ( $datedue_days <= $today_days ) or next; # or it's not overdue, right?
190 $overdueItemsCounted++;
191 my ( $amount, $type, $unitcounttotal, $unitcount ) = CalcFine
(
193 $borrower->{'categorycode'},
199 # Reassign fine's amount if specified in command-line
200 $amount = $catamounts{$borrower->{'categorycode'}} if (defined $catamounts{$borrower->{'categorycode'}});
202 # We check if there is already a fine for the given borrower
203 my $fine = GetFine
(undef, $data->[$i]->{'borrowernumber'});
205 $debug and warn "There is already a fine for borrower " . $data->[$i]->{'borrowernumber'} . ". Nothing to do here. Skipping this borrower";
209 # FIXME: $type NEVER gets populated by anything.
210 ( defined $type ) or $type = '';
212 # Don't update the fine if today is a holiday.
213 # This ensures that dropbox mode will remove the correct amount of fine.
214 if ( $mode eq 'production' and !$borrowersalreadyapplied->{$data->[$i]->{'borrowernumber'}}) {
215 # If we're on a holiday, warn the user (if debug) that no fine will be applied
217 $debug and warn "Today is a holiday. The fine for borrower " . $data->[$i]->{'borrowernumber'} . " will not be applied";
219 $debug and warn "Creating fine for borrower " . $data->[$i]->{'borrowernumber'} . " with amount : $amount";
221 # We mark this borrower as already processed
222 $borrowersalreadyapplied->{$data->[$i]->{'borrowernumber'}} = 1;
224 my $borrowernumber = $data->[$i]->{'borrowernumber'};
225 my $itemnumber = $data->[$i]->{'itemnumber'};
227 # And we create the fine
228 my $sth4 = $dbh->prepare( "SELECT title FROM biblio LEFT JOIN items ON biblio.biblionumber=items.biblionumber WHERE items.itemnumber=?" );
229 $sth4->execute($itemnumber);
230 my $title = $sth4->fetchrow;
232 my $nextaccntno = C4
::Accounts
::getnextacctno
($borrowernumber);
233 my $desc = "staticfine";
234 my $query = "INSERT INTO accountlines
235 (borrowernumber,itemnumber,date,amount,description,accounttype,amountoutstanding,lastincrement,accountno)
236 VALUES (?,?,now(),?,?,'F',?,?,?)";
237 my $sth2 = $dbh->prepare($query);
238 $bigdebug and warn "query: $query\nw/ args: $borrowernumber, $itemnumber, $amount, $desc, $amount, $amount, $nextaccntno\n";
239 $sth2->execute( $borrowernumber, $itemnumber, $amount, $desc, $amount, $amount, $nextaccntno );
247 Fines assessment -- $today_iso
248 Number of Overdue Items:
249 counted $overdueItemsCounted
250 reported $numOverdueItems