[Koha-patches] [PATCH] Fines On Return [Resub w/ minor fix]
Kyle Hall
kyle.m.hall at gmail.com
Wed Jan 21 20:46:51 CET 2009
---
C4/Circulation.pm | 11 +
C4/FinesOnReturn.pm | 284 ++++++++++++++++++++
installer/data/mysql/en/mandatory/sysprefs.sql | 1 +
.../1-Obligatoire/unimarc_standard_systemprefs.sql | 2 +-
installer/data/mysql/updatedatabase.pl | 7 +
5 files changed, 304 insertions(+), 1 deletions(-)
create mode 100644 C4/FinesOnReturn.pm
diff --git a/C4/Circulation.pm b/C4/Circulation.pm
index 372b5e8..ef5e6f9 100644
--- a/C4/Circulation.pm
+++ b/C4/Circulation.pm
@@ -30,6 +30,7 @@ use C4::Members;
use C4::Dates;
use C4::Calendar;
use C4::Accounts;
+use C4::FinesOnReturn;
use Date::Calc qw(
Today
Today_and_Now
@@ -1364,6 +1365,10 @@ sub AddReturn {
my $validTransfert = 0;
my $reserveDone = 0;
+ if ( C4::Context->preference("calcFineOnReturn") ) {
+ CreateFineOnReturn( $barcode );
+ }
+
# get information on item
my $iteminformation = GetItemIssue( GetItemnumberFromBarcode($barcode));
my $biblio = GetBiblioItemData($iteminformation->{'biblioitemnumber'});
@@ -2073,6 +2078,12 @@ sub AddRenewal {
$sth->execute( $borrowernumber, $itemnumber );
my $issuedata = $sth->fetchrow_hashref;
$sth->finish;
+
+ # If using FinesOnReturn, we need to create the fine before
+ # updating the issues row
+ if ( C4::Context->preference("calcFineOnReturn") ) {
+ CreateFineOnReturn( my $barcode, $itemnumber );
+ }
# Update the issues record to have the new due date, and a new count
# of how many times it has been renewed.
diff --git a/C4/FinesOnReturn.pm b/C4/FinesOnReturn.pm
new file mode 100644
index 0000000..c5bd7f9
--- /dev/null
+++ b/C4/FinesOnReturn.pm
@@ -0,0 +1,284 @@
+package C4::FinesOnReturn;
+
+# Copyright 2008 Kyle Hall <kyle.m.hall at gmail.com> kylehall.info
+#
+# 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;
+
+require Exporter;
+
+use vars qw($VERSION @ISA @EXPORT);
+
+use C4::Context;
+
+use DBI;
+use POSIX;
+use Date::Calc qw(Add_Delta_Days);
+use List::Util qw(min);
+use Data::Dumper;
+
+
+# Set the version for version checking
+$VERSION = 0.01;
+
+=head1 NAME
+
+C4::FinesOnReturn - Koha module for calculating fines on return/renewal.
+
+=head1 SYNOPSIS
+
+ use C4::Accounts::FinesOnReturn;
+
+=head1 DESCRIPTION
+
+This module is an alternative system to the current nightly fines generator.
+With this system, a fine for an overdue item is calculated at the time of
+return/renewal. The fine for the entire overdue period is treated as a single
+fine.
+
+=head1 FUNCTIONS
+
+=over 2
+
+=cut
+
+ at ISA = qw(Exporter);
+ at EXPORT = qw(&CreateFineOnReturn &CalculateFine);
+
+## Function Calculate Fine
+## Calculates the fine for the given barcode or itemnumber.
+## $future_date is an optional date ( YYYY-MM-DD ) for estimating a
fine in the future.
+## Returns amount of fine.
+sub CalculateFine {
+ my $maxFine = C4::Context->preference('MaxFine');
+ my ( $itembarcode, $itemnumber, $future_date ) = @_;
+
+ my $return_date = sprintf("%04d-%02d-%02d", (localtime(time))[5] +
1900, (localtime(time))[4] + 1, (localtime(time))[3]);
+ if ( $future_date ) {
+ $return_date = $future_date;
+ }
+
+ my $dbh = C4::Context->dbh;
+
+ my $fineData = _GetFineData( $itembarcode, $itemnumber, $future_date );
+
+
+ if ( ( $fineData->{'replacementprice'} > 0 ) && (
$fineData->{'replacementprice'} < $maxFine ) ) {
+ $maxFine = $fineData->{'replacementprice'};
+ }
+
+ if ( $fineData->{'days_overdue'} < 1 ) { return 0; } ## Short
circuit for speed
+
+ my $issuing_rule = _GetIssuingRule( $fineData->{'categorycode'},
$fineData->{'itemtype'}, $fineData->{'holdingbranch'} );
+ my $days_to_charge = $fineData->{'days_overdue'} -
$issuing_rule->{'firstremind'} - _GetHolidaysBetween(
$fineData->{'date_due'}, $return_date, $fineData->{'holdingbranch'} );
+ if ( $days_to_charge < 1 ) { return 0; } ## Short circuit for speed
+
+ if ( ! $issuing_rule->{'chargeperiod'} ) {
$issuing_rule->{'chargeperiod'} = 1; }
+
+ my $fine = $days_to_charge * $issuing_rule->{'fine'} /
$issuing_rule->{'chargeperiod'};
+ if ( $fine > $maxFine ) { $fine = $maxFine; }
+
+ return $fine;
+}
+
+## Function CreateFineOnReturn
+## This function accepts to arguments, $itembarcode and $itemnumber
+## Only one is required, if both are passed $itemnumber will be used.
+## NOTE: This function should be run right before an item is returned
or renewed.
+sub CreateFineOnReturn {
+ my ( $itembarcode, $itemnumber ) = @_;
+
+ my $dbh = C4::Context->dbh;
+
+ my $amount = CalculateFine( $itembarcode, $itemnumber );
+
+ if ( $amount > 0 ) {
+ my $fineData = _GetFineData( $itembarcode, $itemnumber );
+ my $description = " $fineData->{'itemcallnumber'} : (
$fineData->{'barcode'} ) Issued: $fineData->{'issuedate'}, Due:
$fineData->{'date_due'}, Returned: $fineData->{'date_returned'}";
+ _CreateFine( $fineData->{'itemnumber'},
$fineData->{'borrowernumber'}, $amount, my $type = 'F', $description
);
+ }
+}
+
+## Function _CreateFine
+## Creates the accountline in the db
+sub _CreateFine {
+ my ( $itemnum, $bornum, $amount, $type, $description ) = @_;
+ my $dbh = C4::Context->dbh;
+
+ my $itemData = _GetFineData( '', $itemnum );
+ my $title = $itemData->{'title'};
+ my $holdingBranch = $itemData->{'holdingbranch'};
+
+ ## Get the next accountno from accountlines
+ ## FIXME: Should accountlines.accountno just be set to
autoincrement in MySQL?
+ my $sth2 = $dbh->prepare("SELECT MAX( accountno ) FROM accountlines");
+ $sth2->execute;
+ my $accountno = $sth2->fetchrow_array + 1;
+ $sth2->finish;
+
+ if ( $amount > 0 ) {
+ ## Insert the fine into the database
+ my $sth3 = $dbh->prepare("INSERT INTO accountlines (
+ borrowernumber, itemnumber, date, amount, description,
accounttype, amountoutstanding, accountno )
+ VALUES ( ?, ?, NOW(), ?, ?, 'F', ?, ? )");
+ warn "_CreateFine:: Insert Data sth3->execute( $bornum, $itemnum,
$amount, '$type: $title {$holdingBranch} $description', $amount,
$accountno )";
+ $sth3->execute( $bornum, $itemnum, $amount, "$type: $title
{$holdingBranch} $description", $amount, $accountno );
+ $sth3->finish;
+ }
+
+}
+
+
+## Function getFineData
+## This function returns an array associated array of data about the
borrower and the item
+## $future_date is an optional date ( YYYY-MM-DD ) for estimating a
fine in the future.
+sub _GetFineData {
+ my ( $itembarcode, $itemnumber, $future_date ) = @_;
+
+ my $diff_date = "NOW()";
+ if ( $future_date ) {
+ $diff_date = "DATE( $future_date )";
+ }
+
+ my $dbh = C4::Context->dbh;
+
+ my $sql = "SELECT items.itemnumber,
+ items.itemcallnumber,
+ items.replacementprice,
+ issues.date_due,
+ issues.issuedate,
+ DATEDIFF( $diff_date, issues.date_due ) as days_overdue,
+ borrowers.borrowernumber,
+ borrowers.categorycode,
+ biblioitems.itemtype,
+ items.price,
+ items.barcode,
+ items.holdingbranch,
+ biblio.title,
+ CURDATE() AS date_returned
+ FROM items, issues, borrowers, biblio, biblioitems,
branches, itemtypes
+ WHERE
+ issues.itemnumber = items.itemnumber
+ AND borrowers.borrowernumber = issues.borrowernumber
+ AND items.biblionumber = biblioitems.biblionumber
+ AND items.biblionumber = biblio.biblionumber
+ AND branches.branchcode = items.holdingbranch
+ AND biblioitems.itemtype = itemtypes.itemtype
+ AND issues.returndate IS NULL
+ ";
+
+ if ( $itembarcode ) {
+ $sql .= "AND items.barcode = ?";
+ } else {
+ $sql .= "AND items.itemnumber = ?";
+ }
+
+ my $sth = $dbh->prepare( $sql );
+
+ if ( $itembarcode ) {
+ $sth->execute( $itembarcode );
+ } else {
+ $sth->execute( $itemnumber );
+ }
+
+ my $fineData = $sth->fetchrow_hashref();
+
+ return $fineData;
+}
+
+## _GetIssuingRule takes the borrower categorycode, itemtype, and the
item's holdingbranch
+## And returns the proper issuing rule, if there is no exact issuing
rule for the combination,
+## it tries to match just the category code, if that fails it tries
just the itemtype
+## if that fails, it returns the default rule for the branch
+sub _GetIssuingRule {
+ my ( $categorycode, $itemtype, $holdingbranch ) = @_;
+
+ my $issuingrule = _CheckForIssuingRule( $categorycode, $itemtype,
$holdingbranch );
+ if ( $issuingrule ) { return $issuingrule; }
+
+ my $issuingrule = _CheckForIssuingRule( $categorycode, '', $holdingbranch );
+ if ( $issuingrule ) { return $issuingrule; }
+
+ my $issuingrule = _CheckForIssuingRule( '', $itemtype, $holdingbranch );
+ if ( $issuingrule ) { return $issuingrule; }
+
+ my $issuingrule = _CheckForIssuingRule( '', '', $holdingbranch );
+ if ( $issuingrule ) { return $issuingrule; }
+
+ my $issuingrule = _CheckForIssuingRule( '', '', '' );
+ return $issuingrule;
+
+}
+
+## Checks to see if there is an issuing rule for the given criteria
+## $categorycode and/or $itemtype can be empty to indicate wildcard
+## $holdingbranch is the current holdingbranch for the item
+## If the issuingrule exists, it returns a hashref for it, if not, it returns 0
+sub _CheckForIssuingRule {
+ my ( $categorycode, $itemtype, $branchcode ) = @_;
+
+ if ( ! $categorycode ) { $categorycode = "*"; }
+ if ( ! $itemtype ) { $itemtype = "*"; }
+ if ( ! $branchcode ) { $branchcode = "*"; }
+
+ my $dbh = C4::Context->dbh;
+
+ my $sql = "SELECT * FROM issuingrules WHERE categorycode LIKE ? AND
itemtype LIKE ? AND branchcode LIKE ?";
+
+ my $sth = $dbh->prepare( $sql );
+
+ $sth->execute( $categorycode, $itemtype, $branchcode );
+
+ my $issuingrule = $sth->fetchrow_hashref();
+
+ return $issuingrule;
+}
+
+## Takes a starting and ending date
+## in the format YYYY-MM-DD
+## and returns the number of
+## holidays between the two dates
+sub _GetHolidaysBetween {
+ my ( $startDate, $endDate, $branchcode ) = @_;
+
+ my ( $sYear, $sMonth, $sDay ) = split( /-/, $startDate );
+ my ( $eYear, $eMonth, $eDay ) = split( /-/, $endDate );
+
+ my $holidaysCount = 0;
+
+ my $calendar = C4::Calendar->new( branchcode => $branchcode );
+
+ $holidaysCount += $calendar->isHoliday( $sDay, $sMonth, $sYear );
+
+ while ( mktime( 0, 0, 0, $sDay, $sMonth - 1, $sYear - 1900, 0, 0 )
< mktime( 0, 0, 0, $eDay, $eMonth - 1, $eYear - 1900, 0, 0 ) ) { ##
Changed <= to < to fix fine issue
+ ( $sYear, $sMonth, $sDay ) = Add_Delta_Days( $sYear, $sMonth, $sDay, 1 );
+ $holidaysCount += $calendar->isHoliday( $sDay, $sMonth, $sYear );
+ }
+
+ return $holidaysCount;
+}
+
+1;
+__END__
+
+=back
+
+=head1 AUTHOR
+
+Kyle Hall
+
+=cut
diff --git a/installer/data/mysql/en/mandatory/sysprefs.sql
b/installer/data/mysql/en/mandatory/sysprefs.sql
index 47a0c4b..2bde4f1 100644
--- a/installer/data/mysql/en/mandatory/sysprefs.sql
+++ b/installer/data/mysql/en/mandatory/sysprefs.sql
@@ -214,3 +214,4 @@ INSERT INTO systempreferences
(variable,value,explanation,options,type) VALUES('
INSERT INTO `systempreferences`
(variable,value,options,explanation,type) VALUES
('OPACDisplayRequestPriority','0','','Show patrons the priority level
on holds in the OPAC','YesNo');
INSERT INTO `systempreferences` ( `variable` , `value` , `options` ,
`explanation` , `type` ) VALUES ( 'UseBranchTransferLimits', '0', '',
'If ON, Koha will will use the rules defined in branch_transfer_limits
to decide if an item transfer should be allowed.', 'YesNo');
INSERT INTO systempreferences
(variable,value,explanation,options,type)
VALUES('AllowHoldPolicyOverride', '0', 'Allow staff to override hold
policies when placing holds',NULL,'YesNo');
+INSERT INTO `systempreferences` ( `variable` , `value` , `options` ,
`explanation` , `type` ) VALUES ( 'calcFineOnReturn', '0', '', 'Turns
on the feature to calculate fines at the time of return and/or renewal
as an alternative to the nightly cronjob fines system.', 'YesNo' );
diff --git a/installer/data/mysql/fr-FR/1-Obligatoire/unimarc_standard_systemprefs.sql
b/installer/data/mysql/fr-FR/1-Obligatoire/unimarc_standard_systemprefs.sql
index 6047741..545b68c 100644
--- a/installer/data/mysql/fr-FR/1-Obligatoire/unimarc_standard_systemprefs.sql
+++ b/installer/data/mysql/fr-FR/1-Obligatoire/unimarc_standard_systemprefs.sql
@@ -216,4 +216,4 @@ INSERT INTO systempreferences
(variable,value,explanation,options,type) VALUES('
INSERT INTO `systempreferences`
(variable,value,options,explanation,type) VALUES
('OPACDisplayRequestPriority','0','','Afficher l\'ordre des
rÃ(c)servation pour les adhÃ(c)rents á l\'opac','YesNo');
INSERT INTO `systempreferences` ( `variable` , `value` , `options` ,
`explanation` , `type` ) VALUES ( 'UseBranchTransferLimits', '0', '',
'If ON, Koha will will use the rules defined in branch_transfer_limits
to decide if an item transfer should be allowed.', 'YesNo');
INSERT INTO systempreferences
(variable,value,explanation,options,type)
VALUES('AllowHoldPolicyOverride', '0', "Autorise le personnel á
outrepasser la politique de rÃ(c)servation au moment d'une
rÃ(c)servation",NULL,'YesNo');
-
+INSERT INTO `systempreferences` ( `variable` , `value` , `options` ,
`explanation` , `type` ) VALUES ( 'calcFineOnReturn', '0', '', 'Turns
on the feature to calculate fines at the time of return and/or renewal
as an alternative to the nightly cronjob fines system.', 'YesNo' );
diff --git a/installer/data/mysql/updatedatabase.pl
b/installer/data/mysql/updatedatabase.pl
index a819f8f..9306563 100755
--- a/installer/data/mysql/updatedatabase.pl
+++ b/installer/data/mysql/updatedatabase.pl
@@ -2184,6 +2184,13 @@ if (C4::Context->preference("Version") <
TransformToNum($DBversion)) {
SetVersion ($DBversion);
}
+$DBversion = "3.01.00.014";
+if (C4::Context->preference("Version") < TransformToNum($DBversion)) {
+ $dbh->do("INSERT INTO `systempreferences` ( `variable` , `value`
, `options` , `explanation` , `type` ) VALUES ( 'calcFineOnReturn',
'0', '', 'Turns on the feature to calculate fines at the time of
return and/or renewal as an alternative to the nightly cronjob fines
system.', 'YesNo' )");
+ print "Upgrade to $DBversion done (add new syspref)\n";
+ SetVersion ($DBversion);
+}
+
=item DropAllForeignKeys($table)
Drop all foreign keys of the table $table
--
1.5.6.5
More information about the Koha-patches
mailing list