[Koha-patches] [PATCH] Add a working fines script, some changes to CalcFine and Circulation.pm
Ryan Higgins
rch at liblime.com
Mon Apr 7 10:28:01 CEST 2008
diff --git a/C4/Circulation.pm b/C4/Circulation.pm
index 0add08e..86ee1b4 100644
--- a/C4/Circulation.pm
+++ b/C4/Circulation.pm
@@ -69,6 +69,7 @@ BEGIN {
&GetItemIssues
&GetBorrowerIssues
&GetIssuingCharges
+ &GetIssuingRule
&GetBiblioIssues
&AnonymiseIssueHistory
);
@@ -1094,6 +1095,60 @@ sub GetLoanLength {
return 21;
}
+=head2 GetIssuingRule
+
+FIXME - This is a copy-paste of GetLoanLength
+as a stop-gap. Do not wish to change API for GetLoanLength
+this close to release, however, Overdues::GetIssuingRules is broken.
+
+Get the issuing rule for an itemtype, a borrower type and a branch
+Returns a hashref from the issuingrules table.
+
+my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
+
+=cut
+
+sub GetIssuingRule {
+ my ( $borrowertype, $itemtype, $branchcode ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null" );
+
+ $sth->execute( $borrowertype, $itemtype, $branchcode );
+ my $irule = $sth->fetchrow_hashref;
+ return $irule if defined($irule) ;
+
+ $sth->execute( $borrowertype, $itemtype, "*" );
+ my $irule = $sth->fetchrow_hashref;
+ return $irule if defined($irule) ;
+
+ $sth->execute( $borrowertype, "*", $branchcode );
+ my $irule = $sth->fetchrow_hashref;
+ return $irule if defined($irule) ;
+
+ $sth->execute( "*", $itemtype, $branchcode );
+ my $irule = $sth->fetchrow_hashref;
+ return $irule if defined($irule) ;
+
+ $sth->execute( $borrowertype, "*", "*" );
+ my $irule = $sth->fetchrow_hashref;
+ return $irule if defined($irule) ;
+
+ $sth->execute( "*", "*", $branchcode );
+ my $irule = $sth->fetchrow_hashref;
+ return $irule if defined($irule) ;
+
+ $sth->execute( "*", $itemtype, "*" );
+ my $irule = $sth->fetchrow_hashref;
+ return $irule if defined($irule) ;
+
+ $sth->execute( "*", "*", "*" );
+ my $irule = $sth->fetchrow_hashref;
+ return $irule if defined($irule) ;
+
+ # if no rule matches,
+ return undef;
+}
+
=head2 AddReturn
($doreturn, $messages, $iteminformation, $borrower) =
diff --git a/C4/Overdues.pm b/C4/Overdues.pm
index 0457090..1e4fd69 100644
--- a/C4/Overdues.pm
+++ b/C4/Overdues.pm
@@ -21,6 +21,7 @@ package C4::Overdues;
use strict;
use Date::Calc qw/Today/;
use Date::Manip qw/UnixDate/;
+use C4::Circulation;
use C4::Context;
use C4::Accounts;
use C4::Log; # logaction
@@ -66,9 +67,12 @@ BEGIN {
# subs to move to Circulation.pm
push @EXPORT, qw(
- &GetIssuingRules
&GetIssuesIteminfo
);
+ #
+ # &GetIssuingRules - delete.
+ # use C4::Circulation::GetIssuingRule instead.
+
# subs to move to Members.pm
push @EXPORT, qw(
&CheckBorrowerDebarred
@@ -174,8 +178,8 @@ sub checkoverdues {
=item CalcFine
- ($amount, $chargename, $message) =
- &CalcFine($itemnumber, $borrowercode, $days_overdue);
+ ($amount, $chargename, $message, $daycounttotal, $daycount) =
+ &CalcFine($itemnumber, $categorycode, $branch, $days_overdue, $description);
Calculates the fine for a book.
@@ -185,29 +189,18 @@ standard fine for books might be $0.50, but $1.50 for DVDs, or staff
members might get a longer grace period between the first and second
reminders that a book is overdue).
-The fine is calculated as follows: if it is time for the first
-reminder, the fine is the value listed for the given (branch, item type,
-borrower code) combination. If it is time for the second reminder, the
-fine is doubled. Finally, if it is time to send the account to a
-collection agency, the fine is set to 5 local monetary units (a really
-good deal for the patron if the library is in Italy). Otherwise, the
-fine is 0.
-
-Note that the way this function is currently implemented, it only
-returns a nonzero value on the notable days listed above. That is, if
-the categoryitems entry says to send a first reminder 7 days after the
-book is due, then if you call C<&CalcFine> 7 days after the book is
-due, it will give a nonzero fine. If you call C<&CalcFine> the next
-day, however, it will say that the fine is 0.
C<$itemnumber> is the book's item number.
-C<$borrowercode> is the borrower code of the patron who currently has
+C<$categorycode> is the category code of the patron who currently has
the book.
+C<$branchcode> is the library whose issuingrules govern this transaction.
+
C<$days_overdue> is the number of days elapsed since the book's due
date.
+
C<&CalcFine> returns a list of three values:
C<$amount> is the fine owed by the patron (see above).
@@ -222,7 +215,7 @@ or "Final Notice".
#'
sub CalcFine {
- my ( $item, $bortype, $difference , $dues ) = @_;
+ my ( $item, $bortype, $branchcode, $difference , $dues ) = @_;
my $dbh = C4::Context->dbh;
my $amount = 0;
my $printout;
@@ -232,7 +225,7 @@ sub CalcFine {
my $countalldayclosed = $countspecialday + $countrepeatableday;
my $daycount = $difference - $countalldayclosed;
# get issuingrules (fines part will be used)
- my $data = GetIssuingRules($item->{'itemtype'},$bortype);
+ my $data = C4::Circulation::GetIssuingRule($item->{'itemtype'},$bortype,$branchcode);
my $daycounttotal = $daycount - $data->{'firstremind'};
if ($data->{'chargeperiod'} >0) { # if there is a rule for this bortype
if ($data->{'firstremind'} < $daycount)
@@ -240,18 +233,11 @@ sub CalcFine {
$amount = int($daycounttotal/$data->{'chargeperiod'})*$data->{'fine'};
}
} else {
- # get fines default rules
- my $data = GetIssuingRules($item->{'itemtype'},'*');
- $daycounttotal = $daycount - $data->{'firstremind'};
- if ($data->{'firstremind'} < $daycount)
- {
- if ($data->{'chargeperiod'} >0) { # if there is a rule for this bortype
- $amount = int($daycounttotal/$data->{'chargeperiod'})*$data->{'fine'};
- }
- }
+ # a zero (or null) chargeperiod means no charge.
+ #
}
- warn "Calc Fine for $item->{'itemnumber'}, $bortype, $difference , $dues = $amount / $daycount";
+# warn "Calc Fine: " . join(", ", ($item->{'itemnumber'}, $bortype, $difference , $data->{'fine'} . " * " . $daycount . " days = \$ " . $amount , "desc: $dues")) ;
return ( $amount, $data->{'chargename'}, $printout ,$daycounttotal ,$daycount );
}
@@ -598,6 +584,9 @@ sub GetFine {
=item GetIssuingRules
+FIXME - This sub should be deprecated and removed.
+It ignores branch and defaults.
+
$data = &GetIssuingRules($itemtype,$categorycode);
Looks up for all issuingrules an item info
diff --git a/misc/cronjobs/fines-ll.pl b/misc/cronjobs/fines-ll.pl
new file mode 100755
index 0000000..ff964ad
--- /dev/null
+++ b/misc/cronjobs/fines-ll.pl
@@ -0,0 +1,186 @@
+#!/usr/bin/perl
+
+# This script loops through each overdue item, determines the fine,
+# and updates the total amount of fines due by each user. It relies on
+# the existence of /tmp/fines, which is created by ???
+# Doesnt really rely on it, it relys on being able to write to /tmp/
+# It creates the fines file
+#
+# This script is meant to be run nightly out of cron.
+
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+
+use strict;
+BEGIN {
+ # find Koha's Perl modules
+ # test carefully before changing this
+ use FindBin;
+ eval { require "$FindBin::Bin/kohalib.pl" };
+}
+use C4::Context;
+use C4::Circulation;
+use C4::Overdues;
+use Date::Manip qw/Date_DaysSince1BC/;
+use C4::Biblio;
+
+my $fldir = "/tmp";
+
+my $libname=C4::Context->preference('LibraryName');
+my $dbname= C4::Context->config('database');
+
+my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =localtime(time);
+$mon++;
+$year=$year+1900;
+my $date=Date_DaysSince1BC($mon,$mday,$year);
+my $datestr = $year . sprintf("-%02d-%02d",$mon,$mday);
+my $filename= $dbname;
+$filename =~ s/\W//;
+$filename = $fldir . '/'. $filename . $datestr . ".log";
+open (FILE,">$filename") || die "Can't open LOG";
+print FILE "cardnumber\tcategory\tsurname\tfirstname\temail\tphone\taddress\tcitystate\tbarcode\tdate_due\ttype\tdays_overdue\tfine\n";
+
+# FIXME
+# it looks like $count is just a counter, would it be
+# better to rely on the length of the array @$data and turn the
+# for loop below into a foreach loop?
+#
+my $DEBUG =1;
+my $data=Getoverdues();
+# warn "Overdues : = ".scalar(@$data)." => ".Data::Dumper::Dumper($data);
+my $overdueItemsCounted=0 if $DEBUG;
+my $reference = $year."".$mon;
+my $borrowernumber;
+
+for (my $i=0;$i<scalar(@$data);$i++){
+ my @dates=split('-',$data->[$i]->{'date_due'});
+ my $date2=Date_DaysSince1BC($dates[1],$dates[2],$dates[0]);
+ my $datedue=$data->[$i]->{'date_due'};
+ my $due="$dates[1]/$dates[2]/$dates[0]";
+ my $borrower=BorType($data->[$i]->{'borrowernumber'});
+ my $branchcode;
+ if ( C4::Context->preference('CircControl') eq 'ItemHomeLibrary' ) {
+ $branchcode = $data->[$i]->{'homebranch'};
+ } elsif ( C4::Context->preference('CircControl') eq 'PatronLibrary' ) {
+ $branchcode = $borrower->{'branchcode'};
+ } else {
+ # CircControl must be PickupLibrary. (branchcode comes from issues table here).
+ $branchcode = $data->[$i]->{'branchcode'};
+ }
+
+ my $starter;
+
+ if ($date2 <= $date){
+ $overdueItemsCounted++ if $DEBUG;
+ my $difference=$date-$date2;
+ my ($amount,$type,$printout,$daycounttotal,$daycount)=
+ CalcFine($data->[$i], $borrower->{'categorycode'}, $branchcode,
+ $difference, $datedue);
+
+
+ my ($delays1,$delays2,$delays3)=GetOverdueDelays($borrower->{'categorycode'});
+ my $issuingrules=GetIssuingRule($data->[$i]->{'itemnumber'},$borrower->{'categorycode'},$branchcode);
+
+ UpdateFine($data->[$i]->{'itemnumber'},$data->[$i]->{'borrowernumber'},$amount,$type,$due);
+
+ if($delays1 and $delays2 and $delays3) {
+
+ my $debarredstatus=CheckBorrowerDebarred($borrower->{'borrowernumber'});
+
+ #DELAYS 1##########################################
+ if ($amount > 0 && $daycount >= $delays1 && $daycount < $delays2){
+ # FIXME : already in GetIssuingRules ?
+ my $debarred1=GetOverduerules($borrower->{'categorycode'},1);
+ (UpdateBorrowerDebarred($borrower->{'borrowernumber'}))if(($debarred1 eq '1' ) and ($debarredstatus eq '0'));
+ # is there an open "dossier" for this date & borrower
+ my $getnotifyid=CheckExistantNotifyid($borrower->{'borrowernumber'},$datedue);
+ my $update=CheckAccountLineLevelInfo($borrower->{'borrowernumber'},$data->[$i]->{'itemnumber'},1,$datedue);
+ if ($update eq '0'){
+ if ($getnotifyid eq '0'){
+ $starter=GetNextIdNotify($reference,$borrower->{'borrowernumber'});
+ } else {
+ $starter=$getnotifyid;
+ }
+ }
+ UpdateAccountLines($starter,1,$borrower->{'borrowernumber'},$data->[$i]->{'itemnumber'});
+ }
+
+ #DELAYS 2#################################
+
+ if ($daycount >= $delays2 && $daycount < $delays3){
+ my $debarred2=GetOverduerules($borrower->{'categorycode'},2);
+ (UpdateBorrowerDebarred($borrower->{'borrowernumber'}))if(($debarred2 eq '1' ) and ($debarredstatus eq '0'));
+ my $update=CheckAccountLineLevelInfo($borrower->{'borrowernumber'},$data->[$i]->{'itemnumber'},2,$datedue);
+ if ($update eq '0'){
+ UpdateAccountLines(undef,2,$borrower->{'borrowernumber'},$data->[$i]->{'itemnumber'});
+ }
+ }
+ ###############################################
+
+ #DELAYS 3###################################
+ if ($daycount >= $delays3 ){
+ my $debarred3=GetOverduerules($borrower->{'categorycode'},3);
+ (UpdateBorrowerDebarred($borrower->{'borrowernumber'}))if(($debarred3 eq '1' ) and ($debarredstatus eq '0'));
+ my $update=CheckAccountLineLevelInfo($borrower->{'borrowernumber'},$data->[$i]->{'itemnumber'},3,$datedue);
+ if ($update eq '0'){
+ UpdateAccountLines(undef,3,$borrower->{'borrowernumber'},$data->[$i]->{'itemnumber'});
+ }
+ my $items=GetItems($data->[$i]->{'itemnumber'});
+ my $todaydate=$year."-".$mon."-".$mday;
+ # add item price, the item is considered as lost.
+ my $description="Item Price";
+ my $typeaccount="IP";
+ my $level="3";
+ my $notifyid=GetNotifyId($borrower->{'borrowernumber'},$data->[$i]->{'itemnumber'});
+ my $timestamp=$todaydate." ".$hour."\:".$min."\:".$sec;
+ my $create=CheckAccountLineItemInfo($borrower->{'borrowernumber'},$data->[$i]->{'itemnumber'},$typeaccount,$notifyid);
+ if ($create eq '0'){
+ CreateItemAccountLine($borrower->{'borrowernumber'},$data->[$i]->{'itemnumber'},$todaydate,$items->{'price'},$description,$typeaccount,
+ $items->{'price'},$timestamp,$notifyid,$level);
+ }
+ }
+ ###############################################
+ }
+
+
+ if ($borrower->{'category_type'} eq 'C'){
+ my $query=qq| SELECT *
+ FROM borrowers
+ WHERE borrowernumber=?|;
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrower->{'guarantorid'});
+ my $tdata=$sth->fetchrow_hashref;
+ $sth->finish;
+ $borrower->{'phone'}=$tdata->{'phone'};
+ }
+ print FILE "$printout\t$borrower->{'cardnumber'}\t$borrower->{'categorycode'}\t$borrower->{'surname'}\t$borrower->{'firstname'}\t$borrower->{'email'}\t$borrower->{'phone'}\t$borrower->{'address'}\t$borrower->{'city'}\t$data->[$i]->{'barcode'}\t$data->[$i]->{'date_due'}\t$type\t$difference\t$amount\n";
+ }
+}
+
+my $numOverdueItems=scalar(@$data);
+if ($DEBUG) {
+ print <<EOM
+
+Number of Overdue Items counted $overdueItemsCounted
+Number of Overdue Items reported $numOverdueItems
+
+EOM
+}
+
+close FILE;
--
1.5.2.1
More information about the Koha-patches
mailing list