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
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 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
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.
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.
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
47 use List
::MoreUtils qw
/none/;
57 my $useborrowerlibrary;
58 my $borrowernumberlimit;
59 my $borrowersalreadyapplied; # hashref of borrowers for whom we already applied the fine, so it's only applied once
60 my $debug = $ENV{'DEBUG'} || 0;
65 'v|verbose' => \
$verbose,
66 'c|category:s'=> \
@pcategories,
67 'l|library:s' => \
@libraries,
68 'd|delay:i' => \
$delay,
69 'u|use-borrower-library' => \
$useborrowerlibrary,
70 'b|borrower:i' => \
$borrowernumberlimit
72 my $usage = << 'ENDUSAGE';
74 This script calculates
and charges overdue fines to patron accounts
.
76 If the Koha System Preference
'finesMode' is set to
'production', the fines are charged to the patron accounts
.
77 If set to
'test', the fines are calculated but
not applied
.
79 Please note that the fines won
't be applied on a holiday.
81 This script has the following parameters :
82 -h --help: this message
84 -c --category borrower_category,amount (repeatable)
85 -l --library (repeatable)
87 -u --use-borrower-library: use borrower's library
, regardless of the CircControl syspref
88 -b
--borrower borrowernumber
: only
for one
given borrower
93 my $dbh = C4
::Context
->dbh;
95 # Processing categories
96 foreach (@pcategories) {
97 my ($category, $amount) = split(',', $_);
98 push @categories, $category;
99 $catamounts{$category} = $amount;
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);
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";
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";
125 $debug and (defined $borrowernumberlimit) and print "--borrower limitation: borrower $borrowernumberlimit\n";
126 my ($numOverdueItems, $data);
127 if (defined $borrowernumberlimit) {
128 ($numOverdueItems, $data) = checkoverdues
($borrowernumberlimit);
130 $data = Getoverdues
();
131 $numOverdueItems = scalar @
$data;
133 my $overdueItemsCounted = 0;
135 $today = C4
::Dates
->new();
136 $today_iso = $today->output('iso');
137 my ($tyear, $tmonth, $tday) = split( /-/, $today_iso );
138 $today_days = Date_to_Days
( $tyear, $tmonth, $tday );
140 for ( my $i = 0 ; $i < scalar(@
$data) ; $i++ ) {
144 $datedue = C4
::Dates
->new( $data->[$i]->{'date_due'}, 'iso' );
145 $datedue_days = Date_to_Days
( split( /-/, $datedue->output('iso') ) );
148 warn "Error on date for borrower " . $data->[$i]->{'borrowernumber'} . ": $@date_due: " . $data->[$i]->{'date_due'} . "\ndatedue_days: " . $datedue_days . "\nSkipping";
151 my $due_str = $datedue->output();
152 unless ( defined $data->[$i]->{'borrowernumber'} ) {
153 print STDERR
"ERROR in Getoverdues line $i: issues.borrowernumber IS NULL. Repair 'issues' table now! Skipping record.\n";
154 next; # Note: this doesn't solve everything. After NULL borrowernumber, multiple issues w/ real borrowernumbers can pile up.
156 my $borrower = BorType
( $data->[$i]->{'borrowernumber'} );
158 # Skipping borrowers that are not in @categories
159 $bigdebug and warn "Skipping borrower from category " . $borrower->{categorycode
} if none
{ $borrower->{categorycode
} eq $_ } @categories;
160 next if none
{ $borrower->{categorycode
} eq $_ } @categories;
163 ( $useborrowerlibrary ) ?
$borrower->{branchcode
}
164 : ( $control eq 'ItemHomeLibrary' ) ?
$data->[$i]->{homebranch
}
165 : ( $control eq 'PatronLibrary' ) ?
$borrower->{branchcode
}
166 : $data->[$i]->{branchcode
};
167 # In final case, CircControl must be PickupLibrary. (branchcode comes from issues table here).
169 # Skipping branchcodes that are not in @libraries
170 $bigdebug and warn "Skipping library $branchcode" if none
{ $branchcode eq $_ } @libraries;
171 next if none
{ $branchcode eq $_ } @libraries;
174 unless ( defined( $calendars{$branchcode} ) ) {
175 $calendars{$branchcode} = C4
::Calendar
->new( branchcode
=> $branchcode );
177 $calendar = $calendars{$branchcode};
178 my $isHoliday = $calendar->isHoliday( $tday, $tmonth, $tyear );
180 # Reassing datedue_days if -delay specified in commandline
181 $bigdebug and warn "Using commandline supplied delay : $delay" if ($delay);
182 $datedue_days += $delay if ($delay);
184 ( $datedue_days <= $today_days ) or next; # or it's not overdue, right?
186 $overdueItemsCounted++;
187 my ( $amount, $type, $unitcounttotal, $unitcount ) = CalcFine
(
189 $borrower->{'categorycode'},
191 dt_from_string
($datedue->output('iso')),
192 dt_from_string
($today->output('iso')),
195 # Reassign fine's amount if specified in command-line
196 $amount = $catamounts{$borrower->{'categorycode'}} if (defined $catamounts{$borrower->{'categorycode'}});
198 # We check if there is already a fine for the given borrower
199 my $fine = GetFine
($data->[$i]->{'borrowernumber'});
201 $debug and warn "There is already a fine for borrower " . $data->[$i]->{'borrowernumber'} . ". Nothing to do here. Skipping this borrower";
205 # FIXME: $type NEVER gets populated by anything.
206 ( defined $type ) or $type = '';
208 # Don't update the fine if today is a holiday.
209 # This ensures that dropbox mode will remove the correct amount of fine.
210 if ( $mode eq 'production' and !$borrowersalreadyapplied->{$data->[$i]->{'borrowernumber'}}) {
211 # If we're on a holiday, warn the user (if debug) that no fine will be applied
213 $debug and warn "Today is a holiday. The fine for borrower " . $data->[$i]->{'borrowernumber'} . " will not be applied";
215 $debug and warn "Creating fine for borrower " . $data->[$i]->{'borrowernumber'} . " with amount : $amount";
217 # We mark this borrower as already processed
218 $borrowersalreadyapplied->{$data->[$i]->{'borrowernumber'}} = 1;
220 my $borrowernumber = $data->[$i]->{'borrowernumber'};
221 my $itemnumber = $data->[$i]->{'itemnumber'};
223 # And we create the fine
224 my $sth4 = $dbh->prepare( "SELECT title FROM biblio LEFT JOIN items ON biblio.biblionumber=items.biblionumber WHERE items.itemnumber=?" );
225 $sth4->execute($itemnumber);
226 my $title = $sth4->fetchrow;
228 my $nextaccntno = C4
::Accounts
::getnextacctno
($borrowernumber);
229 my $desc = "staticfine";
230 my $query = "INSERT INTO accountlines
231 (borrowernumber,itemnumber,date,amount,description,accounttype,amountoutstanding,lastincrement,accountno)
232 VALUES (?,?,now(),?,?,'F',?,?,?)";
233 my $sth2 = $dbh->prepare($query);
234 $bigdebug and warn "query: $query\nw/ args: $borrowernumber, $itemnumber, $amount, $desc, $amount, $amount, $nextaccntno\n";
235 $sth2->execute( $borrowernumber, $itemnumber, $amount, $desc, $amount, $amount, $nextaccntno );
243 Fines assessment -- $today_iso
244 Number of Overdue Items:
245 counted $overdueItemsCounted
246 reported $numOverdueItems