[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Koha-cvs] koha/C4 Circulation.pm Overdues.pm
|
From: |
Henri-Damien LAURENT |
|
Subject: |
[Koha-cvs] koha/C4 Circulation.pm Overdues.pm |
|
Date: |
Thu, 05 Apr 2007 08:53:32 +0000 |
CVSROOT: /cvsroot/koha
Module name: koha
Changes by: Henri-Damien LAURENT <hdl> 07/04/05 08:53:31
Added files:
C4 : Circulation.pm Overdues.pm
Log message:
Adding Circulation and Overdues modules
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Circulation.pm?cvsroot=koha&rev=1.11
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Overdues.pm?cvsroot=koha&rev=1.1
Patches:
Index: Circulation.pm
===================================================================
RCS file: Circulation.pm
diff -N Circulation.pm
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ Circulation.pm 5 Apr 2007 08:53:31 -0000 1.11
@@ -0,0 +1,1948 @@
+package C4::Circulation;
+
+# 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
+
+# $Id: Circulation.pm,v 1.11 2007/04/05 08:53:31 hdl Exp $
+
+use strict;
+require Exporter;
+use C4::Context;
+use C4::Stats;
+use C4::Reserves2;
+use C4::Koha;
+use C4::Biblio;
+use C4::Accounts;
+use C4::Reserves2;
+use C4::Members;
+use C4::Date;
+use Date::Calc qw(
+ Today
+ Today_and_Now
+ Add_Delta_YM
+ Add_Delta_DHMS
+ Date_to_Days
+);
+use POSIX qw(strftime);
+use C4::Branch; # GetBranches
+use C4::Log; # logaction
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = do { my @v = '$Revision: 1.11 $' =~ /\d+/g; shift(@v).".".join(
"_", map { sprintf "%03d", $_ } @v ); };
+
+=head1 NAME
+
+C4::Circulation::Circ2 - Koha circulation module
+
+=head1 SYNOPSIS
+
+use C4::Circulation;
+
+=head1 DESCRIPTION
+
+The functions in this module deal with circulation, issues, and
+returns, as well as general information about the library.
+Also deals with stocktaking.
+
+=head1 FUNCTIONS
+
+=cut
+
address@hidden = qw(Exporter);
+
+# FIXME subs that should probably be elsewhere
+push @EXPORT, qw(
+ &fixoverduesonreturn
+);
+
+# subs to deal with issuing a book
+push @EXPORT, qw(
+ &CanBookBeIssued
+ &CanBookBeRenewed
+ &AddIssue
+ &AddRenewal
+ &GetItemIssue
+ &GetItemIssues
+ &GetBorrowerIssues
+ &GetIssuingCharges
+ &GetBiblioIssues
+ &AnonymiseIssueHistory
+);
+# subs to deal with returns
+push @EXPORT, qw(
+ &AddReturn
+);
+
+# subs to deal with transfers
+push @EXPORT, qw(
+ &transferbook
+ &GetTransfers
+ &GetTransfersFromTo
+ &updateWrongTransfer
+ &DeleteTransfer
+);
+
+# subs to remove
+push @EXPORT, qw(
+ &decode
+ &dotransfer
+);
+
+=head2 decode
+
+=head3 $str = &decode($chunk);
+
+=over 4
+
+=item Decodes a segment of a string emitted by a CueCat barcode scanner and
+returns it.
+
+=back
+
+=cut
+
+# FIXME - At least, I'm pretty sure this is for decoding CueCat stuff.
+
+# FIXME From Paul : i don't understand what this sub does & why it has to be
called on every circ. Speak of this with chris maybe ?
+sub decode {
+ my ($encoded) = @_;
+ my $seq =
+ 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
+ my @s = map { index( $seq, $_ ); } split( //, $encoded );
+ my $l = ( $#s + 1 ) % 4;
+ if ($l) {
+ if ( $l == 1 ) {
+ warn "Error!";
+ return;
+ }
+ $l = 4 - $l;
+ $#s += $l;
+ }
+ my $r = '';
+ while ( $#s >= 0 ) {
+ my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
+ $r .=
+ chr( ( $n >> 16 ) ^ 67 )
+ .chr( ( $n >> 8 & 255 ) ^ 67 )
+ .chr( ( $n & 255 ) ^ 67 );
+ @s = @s[ 4 .. $#s ];
+ }
+ $r = substr( $r, 0, length($r) - $l );
+ return $r;
+}
+
+=head2 transferbook
+
+($dotransfer, $messages, $iteminformation) = &transferbook($newbranch,
$barcode, $ignore_reserves);
+
+Transfers an item to a new branch. If the item is currently on loan, it is
automatically returned before the actual transfer.
+
+C<$newbranch> is the code for the branch to which the item should be
transferred.
+
+C<$barcode> is the barcode of the item to be transferred.
+
+If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
+Otherwise, if an item is reserved, the transfer fails.
+
+Returns three values:
+
+=head3 $dotransfer
+
+is true if the transfer was successful.
+
+=head3 $messages
+
+is a reference-to-hash which may have any of the following keys:
+
+=over 4
+
+=item C<BadBarcode>
+
+There is no item in the catalog with the given barcode. The value is
C<$barcode>.
+
+=item C<IsPermanent>
+
+The item's home branch is permanent. This doesn't prevent the item from being
transferred, though. The value is the code of the item's home branch.
+
+=item C<DestinationEqualsHolding>
+
+The item is already at the branch to which it is being transferred. The
transfer is nonetheless considered to have failed. The value should be ignored.
+
+=item C<WasReturned>
+
+The item was on loan, and C<&transferbook> automatically returned it before
transferring it. The value is the borrower number of the patron who had the
item.
+
+=item C<ResFound>
+
+The item was reserved. The value is a reference-to-hash whose keys are fields
from the reserves table of the Koha database, and C<biblioitemnumber>. It also
has the key C<ResFound>, whose value is either C<Waiting> or C<Reserved>.
+
+=item C<WasTransferred>
+
+The item was eligible to be transferred. Barring problems communicating with
the database, the transfer should indeed have succeeded. The value should be
ignored.
+
+=back
+
+=cut
+
+#'
+# FIXME - This function tries to do too much, and its API is clumsy.
+# If it didn't also return books, it could be used to change the home
+# branch of a book while the book is on loan.
+#
+# Is there any point in returning the item information? The caller can
+# look that up elsewhere if ve cares.
+#
+# This leaves the ($dotransfer, $messages) tuple. This seems clumsy.
+# If the transfer succeeds, that's all the caller should need to know.
+# Thus, this function could simply return 1 or 0 to indicate success
+# or failure, and set $C4::Circulation::Circ2::errmsg in case of
+# failure. Or this function could return undef if successful, and an
+# error message in case of failure (this would feel more like C than
+# Perl, though).
+sub transferbook {
+ my ( $tbr, $barcode, $ignoreRs ) = @_;
+ my $messages;
+ my %env;
+ my $dotransfer = 1;
+ my $branches = GetBranches();
+ my $item = GetItemFromBarcode( $barcode );
+ my $issue = GetItemIssues($item->{itemnumber});
+
+ # bad barcode..
+ if ( not $item ) {
+ $messages->{'BadBarcode'} = $barcode;
+ $dotransfer = 0;
+ }
+
+ # get branches of book...
+ my $hbr = $item->{'homebranch'};
+ my $fbr = $item->{'holdingbranch'};
+
+ # if is permanent...
+ if ( $hbr && $branches->{$hbr}->{'PE'} ) {
+ $messages->{'IsPermanent'} = $hbr;
+ }
+
+ # can't transfer book if is already there....
+ # FIXME - Why not? Shouldn't it trivially succeed?
+ if ( $fbr eq $tbr ) {
+ $messages->{'DestinationEqualsHolding'} = 1;
+ $dotransfer = 0;
+ }
+
+ # check if it is still issued to someone, return it...
+ if ($issue->{borrowernumber}) {
+ AddReturn( $barcode, $fbr );
+ $messages->{'WasReturned'} = $issue->{borrowernumber};
+ }
+
+ # find reserves.....
+ # FIXME - Don't call &CheckReserves unless $ignoreRs is true.
+ # That'll save a database query.
+ my ( $resfound, $resrec ) =
+ CheckReserves( $item->{'itemnumber'} );
+ if ( $resfound and not $ignoreRs ) {
+ $resrec->{'ResFound'} = $resfound;
+
+ # $messages->{'ResFound'} = $resrec;
+ $dotransfer = 1;
+ }
+
+ #actually do the transfer....
+ if ($dotransfer) {
+ dotransfer( $item->{'itemnumber'}, $fbr, $tbr );
+
+ # don't need to update MARC anymore, we do it in batch now
+ $messages->{'WasTransfered'} = 1;
+ }
+ return ( $dotransfer, $messages, $item );
+}
+
+# Not exported
+# FIXME - This is only used in &transferbook. Why bother making it a
+# separate function?
+sub dotransfer {
+ my ( $itm, $fbr, $tbr ) = @_;
+
+ my $dbh = C4::Context->dbh;
+ $itm = $dbh->quote($itm);
+ $fbr = $dbh->quote($fbr);
+ $tbr = $dbh->quote($tbr);
+
+ #new entry in branchtransfers....
+ $dbh->do(
+"INSERT INTO branchtransfers (itemnumber, frombranch, datesent, tobranch)
+ VALUES ($itm, $fbr, now(), $tbr)"
+ );
+
+ #update holdingbranch in items .....
+ $dbh->do(
+ "UPDATE items set holdingbranch = $tbr WHERE items.itemnumber =
$itm");
+ &ModDateLastSeen($itm);
+ &domarctransfer( $dbh, $itm );
+ return;
+}
+
+##New sub to dotransfer in marc tables as well. Not exported -TG 10/04/2006
+sub domarctransfer {
+ my ( $dbh, $itemnumber ) = @_;
+ $itemnumber =~ s /\'//g; ##itemnumber seems to come with quotes-TG
+ my $sth =
+ $dbh->prepare(
+ "select biblionumber,holdingbranch from items where
itemnumber=$itemnumber"
+ );
+ $sth->execute();
+ while ( my ( $biblionumber, $holdingbranch ) = $sth->fetchrow ) {
+ &ModItemInMarconefield( $biblionumber, $itemnumber,
+ 'items.holdingbranch', $holdingbranch );
+ }
+ return;
+}
+
+=head2 CanBookBeIssued
+
+Check if a book can be issued.
+
+my ($issuingimpossible,$needsconfirmation) =
CanBookBeIssued($env,$borrower,$barcode,$year,$month,$day);
+
+=over 4
+
+=item C<$env> Environment variable. Should be empty usually, but used by other
subs. Next code cleaning could drop it.
+
+=item C<$borrower> hash with borrower informations (from GetMemberDetails)
+
+=item C<$barcode> is the bar code of the book being issued.
+
+=item C<$year> C<$month> C<$day> contains the date of the return (in case it's
forced by "stickyduedate".
+
+=back
+
+Returns :
+
+=over 4
+
+=item C<$issuingimpossible> a reference to a hash. It contains reasons why
issuing is impossible.
+Possible values are :
+
+=back
+
+=head3 INVALID_DATE
+
+sticky due date is invalid
+
+=head3 GNA
+
+borrower gone with no address
+
+=head3 CARD_LOST
+
+borrower declared it's card lost
+
+=head3 DEBARRED
+
+borrower debarred
+
+=head3 UNKNOWN_BARCODE
+
+barcode unknown
+
+=head3 NOT_FOR_LOAN
+
+item is not for loan
+
+=head3 WTHDRAWN
+
+item withdrawn.
+
+=head3 RESTRICTED
+
+item is restricted (set by ??)
+
+C<$issuingimpossible> a reference to a hash. It contains reasons why issuing
is impossible.
+Possible values are :
+
+=head3 DEBT
+
+borrower has debts.
+
+=head3 RENEW_ISSUE
+
+renewing, not issuing
+
+=head3 ISSUED_TO_ANOTHER
+
+issued to someone else.
+
+=head3 RESERVED
+
+reserved for someone else.
+
+=head3 INVALID_DATE
+
+sticky due date is invalid
+
+=head3 TOO_MANY
+
+if the borrower borrows to much things
+
+=cut
+
+# check if a book can be issued.
+# returns an array with errors if any
+
+sub TooMany ($$) {
+ my $borrower = shift;
+ my $biblionumber = shift;
+ my $cat_borrower = $borrower->{'categorycode'};
+ my $branch_borrower = $borrower->{'branchcode'};
+ my $dbh = C4::Context->dbh;
+
+ my $sth =
+ $dbh->prepare('select itemtype from biblioitems where biblionumber = ?');
+ $sth->execute($biblionumber);
+ my $type = $sth->fetchrow;
+ $sth =
+ $dbh->prepare(
+'select * from issuingrules where categorycode = ? and itemtype = ? and
branchcode = ?'
+ );
+
+# my $sth2 = $dbh->prepare("select COUNT(*) from issues i, biblioitems s
where i.borrowernumber = ? and i.returndate is null and i.itemnumber =
s.biblioitemnumber and s.itemtype like ?");
+ my $sth2 =
+ $dbh->prepare(
+"select COUNT(*) from issues i, biblioitems s1, items s2 where
i.borrowernumber = ? and i.returndate is null and i.itemnumber = s2.itemnumber
and s1.itemtype like ? and s1.biblioitemnumber = s2.biblioitemnumber"
+ );
+ my $sth3 =
+ $dbh->prepare(
+'select COUNT(*) from issues where borrowernumber = ? and returndate is null'
+ );
+ my $alreadyissued;
+
+ # check the 3 parameters
+ $sth->execute( $cat_borrower, $type, $branch_borrower );
+ my $result = $sth->fetchrow_hashref;
+
+ # warn "==>".$result->{maxissueqty};
+
+# Currently, using defined($result) ie on an entire hash reports whether memory
+# for that aggregate has ever been allocated. As $result is used all over the
place
+# it would rarely return as undefined.
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
+ my $alreadyissued = $sth2->fetchrow;
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "a $alreadyissued / ".( $result->{maxissueqty} + 0 ) );
+ }
+ else {
+ return;
+ }
+ }
+
+ # check for branch=*
+ $sth->execute( $cat_borrower, $type, "" );
+ $result = $sth->fetchrow_hashref;
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
+ my $alreadyissued = $sth2->fetchrow;
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "b $alreadyissued / ".( $result->{maxissueqty} + 0 ) );
+ }
+ else {
+ return;
+ }
+ }
+
+ # check for itemtype=*
+ $sth->execute( $cat_borrower, "*", $branch_borrower );
+ $result = $sth->fetchrow_hashref;
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth3->execute( $borrower->{'borrowernumber'} );
+ my ($alreadyissued) = $sth3->fetchrow;
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+
+# warn "HERE : $alreadyissued / ($result->{maxissueqty} for
$borrower->{'borrowernumber'}";
+ return ( "c $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
+ return;
+ }
+ }
+
+ # check for borrowertype=*
+ $sth->execute( "*", $type, $branch_borrower );
+ $result = $sth->fetchrow_hashref;
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
+ my $alreadyissued = $sth2->fetchrow;
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "d $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
+ return;
+ }
+ }
+
+ $sth->execute( "*", "*", $branch_borrower );
+ $result = $sth->fetchrow_hashref;
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth3->execute( $borrower->{'borrowernumber'} );
+ my $alreadyissued = $sth3->fetchrow;
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "e $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
+ return;
+ }
+ }
+
+ $sth->execute( "*", $type, "" );
+ $result = $sth->fetchrow_hashref;
+ if ( defined( $result->{maxissueqty} ) && $result->{maxissueqty} >= 0 ) {
+ $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
+ my $alreadyissued = $sth2->fetchrow;
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "f $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
+ return;
+ }
+ }
+
+ $sth->execute( $cat_borrower, "*", "" );
+ $result = $sth->fetchrow_hashref;
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
+ my $alreadyissued = $sth2->fetchrow;
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "g $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
+ return;
+ }
+ }
+
+ $sth->execute( "*", "*", "" );
+ $result = $sth->fetchrow_hashref;
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth3->execute( $borrower->{'borrowernumber'} );
+ my $alreadyissued = $sth3->fetchrow;
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "h $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
+ return;
+ }
+ }
+ return;
+}
+
+=head2 itemissues
+
+ @issues = &itemissues($biblioitemnumber, $biblio);
+
+Looks up information about who has borrowed the bookZ<>(s) with the
+given biblioitemnumber.
+
+C<$biblio> is ignored.
+
+C<&itemissues> returns an array of references-to-hash. The keys
+include the fields from the C<items> table in the Koha database.
+Additional keys include:
+
+=over 4
+
+=item C<date_due>
+
+If the item is currently on loan, this gives the due date.
+
+If the item is not on loan, then this is either "Available" or
+"Cancelled", if the item has been withdrawn.
+
+=item C<card>
+
+If the item is currently on loan, this gives the card number of the
+patron who currently has the item.
+
+=item C<timestamp0>, C<timestamp1>, C<timestamp2>
+
+These give the timestamp for the last three times the item was
+borrowed.
+
+=item C<card0>, C<card1>, C<card2>
+
+The card number of the last three patrons who borrowed this item.
+
+=item C<borrower0>, C<borrower1>, C<borrower2>
+
+The borrower number of the last three patrons who borrowed this item.
+
+=back
+
+=cut
+
+#'
+sub itemissues {
+ my ( $bibitem, $biblio ) = @_;
+ my $dbh = C4::Context->dbh;
+
+ # FIXME - If this function die()s, the script will abort, and the
+ # user won't get anything; depending on how far the script has
+ # gotten, the user might get a blank page. It would be much better
+ # to at least print an error message. The easiest way to do this
+ # is to set $SIG{__DIE__}.
+ my $sth =
+ $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
+ || die $dbh->errstr;
+ my $i = 0;
+ my @results;
+
+ $sth->execute($bibitem) || die $sth->errstr;
+
+ while ( my $data = $sth->fetchrow_hashref ) {
+
+ # Find out who currently has this item.
+ # FIXME - Wouldn't it be better to do this as a left join of
+ # some sort? Currently, this code assumes that if
+ # fetchrow_hashref() fails, then the book is on the shelf.
+ # fetchrow_hashref() can fail for any number of reasons (e.g.,
+ # database server crash), not just because no items match the
+ # search criteria.
+ my $sth2 = $dbh->prepare(
+ "SELECT * FROM issues
+ LEFT JOIN borrowers ON issues.borrowernumber =
borrowers.borrowernumber
+ WHERE itemnumber = ?
+ AND returndate IS NULL
+ "
+ );
+
+ $sth2->execute( $data->{'itemnumber'} );
+ if ( my $data2 = $sth2->fetchrow_hashref ) {
+ $data->{'date_due'} = $data2->{'date_due'};
+ $data->{'card'} = $data2->{'cardnumber'};
+ $data->{'borrower'} = $data2->{'borrowernumber'};
+ }
+ else {
+ if ( $data->{'wthdrawn'} eq '1' ) {
+ $data->{'date_due'} = 'Cancelled';
+ }
+ else {
+ $data->{'date_due'} = 'Available';
+ } # else
+ } # else
+
+ $sth2->finish;
+
+ # Find the last 3 people who borrowed this item.
+ $sth2 = $dbh->prepare(
+ "SELECT * FROM issues, borrowers
+ LEFT JOIN borrowers ON issues.borrowernumber =
borrowers.borrowernumber
+ WHERE itemnumber = ?
+ AND returndate IS NOT NULL
+ ORDER BY returndate DESC,timestamp DESC"
+ );
+
+# $sth2 = $dbh->prepare("
+# SELECT *
+# FROM issues
+# LEFT JOIN borrowers ON issues.borrowernumber =
borrowers.borrowernumber
+# WHERE itemnumber = ?
+# AND returndate is not NULL
+# ORDER BY returndate DESC,timestamp DESC
+# ");
+
+ $sth2->execute( $data->{'itemnumber'} );
+ for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
+ { # FIXME : error if there is less than 3 pple borrowing this item
+ if ( my $data2 = $sth2->fetchrow_hashref ) {
+ $data->{"timestamp$i2"} = $data2->{'timestamp'};
+ $data->{"card$i2"} = $data2->{'cardnumber'};
+ $data->{"borrower$i2"} = $data2->{'borrowernumber'};
+ } # if
+ } # for
+
+ $sth2->finish;
+ $results[$i] = $data;
+ $i++;
+ }
+
+ $sth->finish;
+ return (@results);
+}
+
+=head2 CanBookBeIssued
+
+$issuingimpossible, $needsconfirmation =
+ CanBookBeIssued( $env, $borrower, $barcode, $year, $month, $day,
$inprocess );
+
+C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
+
+=cut
+
+sub CanBookBeIssued {
+ my ( $env, $borrower, $barcode, $year, $month, $day, $inprocess ) = @_;
+ my %needsconfirmation; # filled with problems that needs confirmations
+ my %issuingimpossible; # filled with problems that causes the issue to
be IMPOSSIBLE
+ my $item = GetItem(GetItemFromBarcode( $barcode ));
+ my $issue = GetItemIssue($item->{itemnumber});
+ my $dbh = C4::Context->dbh;
+
+ #
+ # DUE DATE is OK ?
+ #
+ my ( $duedate, $invalidduedate ) = fixdate( $year, $month, $day );
+ $issuingimpossible{INVALID_DATE} = 1 if ($invalidduedate);
+
+ #
+ # BORROWER STATUS
+ #
+ if ( $borrower->{flags}->{GNA} ) {
+ $issuingimpossible{GNA} = 1;
+ }
+ if ( $borrower->{flags}->{'LOST'} ) {
+ $issuingimpossible{CARD_LOST} = 1;
+ }
+ if ( $borrower->{flags}->{'DBARRED'} ) {
+ $issuingimpossible{DEBARRED} = 1;
+ }
+ if ( Date_to_Days(Today) >
+ Date_to_Days( split "-", $borrower->{'dateexpiry'} ) )
+ {
+
+ #
+ #if (&Date_Cmp(&ParseDate($borrower->{expiry}),&ParseDate("today"))<0)
{
+ $issuingimpossible{EXPIRED} = 1;
+ }
+
+ #
+ # BORROWER STATUS
+ #
+
+ # DEBTS
+ my $amount =
+ checkaccount( $borrower->{'borrowernumber'}, $dbh, $duedate );
+ if ( C4::Context->preference("IssuingInProcess") ) {
+ my $amountlimit = C4::Context->preference("noissuescharge");
+ if ( $amount > $amountlimit && !$inprocess ) {
+ $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
+ }
+ elsif ( $amount <= $amountlimit && !$inprocess ) {
+ $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
+ }
+ }
+ else {
+ if ( $amount > 0 ) {
+ $needsconfirmation{DEBT} = $amount;
+ }
+ }
+
+ #
+ # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
+ #
+ my $toomany = TooMany( $borrower, $item->{biblionumber} );
+ $needsconfirmation{TOO_MANY} = $toomany if $toomany;
+
+ #
+ # ITEM CHECKING
+ #
+ unless ( $item->{barcode} ) {
+ $issuingimpossible{UNKNOWN_BARCODE} = 1;
+ }
+ if ( $item->{'notforloan'}
+ && $item->{'notforloan'} > 0 )
+ {
+ $issuingimpossible{NOT_FOR_LOAN} = 1;
+ }
+ if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} == 1 )
+ {
+ $issuingimpossible{WTHDRAWN} = 1;
+ }
+ if ( $item->{'restricted'}
+ && $item->{'restricted'} == 1 )
+ {
+ $issuingimpossible{RESTRICTED} = 1;
+ }
+ if ( C4::Context->preference("IndependantBranches") ) {
+ my $userenv = C4::Context->userenv;
+ if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
+ $issuingimpossible{NOTSAMEBRANCH} = 1
+ if ( $item->{'holdingbranch'} ne $userenv->{branch} );
+ }
+ }
+
+ #
+ # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
+ #
+ if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq
$borrower->{'borrowernumber'} )
+ {
+
+ # Already issued to current borrower. Ask whether the loan should
+ # be renewed.
+ my ($CanBookBeRenewed) = CanBookBeRenewed(
+ $borrower->{'borrowernumber'},
+ $item->{'itemnumber'}
+ );
+ if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
+ $issuingimpossible{NO_MORE_RENEWALS} = 1;
+ }
+ else {
+
+ # $needsconfirmation{RENEW_ISSUE} = 1;
+ }
+ }
+ elsif ($issue->{borrowernumber}) {
+
+ # issued to someone else
+ my $currborinfo = GetMemberDetails( $issue->{borrowernumber} );
+
+# warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'}
($currborinfo->{'cardnumber'})";
+ $needsconfirmation{ISSUED_TO_ANOTHER} =
+"$currborinfo->{'reservedate'} : $currborinfo->{'firstname'}
$currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
+ }
+
+ # See if the item is on reserve.
+ my ( $restype, $res ) = CheckReserves( $item->{'itemnumber'} );
+ if ($restype) {
+ my $resbor = $res->{'borrowernumber'};
+ if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting"
)
+ {
+
+ # The item is on reserve and waiting, but has been
+ # reserved by some other patron.
+ my ( $resborrower, $flags ) =
+ GetMemberDetails( $resbor, 0 );
+ my $branches = GetBranches();
+ my $branchname =
+ $branches->{ $res->{'branchcode'} }->{'branchname'};
+ $needsconfirmation{RESERVE_WAITING} =
+"$resborrower->{'firstname'} $resborrower->{'surname'}
($resborrower->{'cardnumber'}, $branchname)";
+
+# CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); Doesn't
belong in a checking subroutine.
+ }
+ elsif ( $restype eq "Reserved" ) {
+
+ # The item is on reserve for someone else.
+ my ( $resborrower, $flags ) =
+ GetMemberDetails( $resbor, 0 );
+ my $branches = GetBranches();
+ my $branchname =
+ $branches->{ $res->{'branchcode'} }->{'branchname'};
+ $needsconfirmation{RESERVED} =
+"$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'}
($resborrower->{'cardnumber'})";
+ }
+ }
+ if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" )
+ {
+ if ( $borrower->{'categorycode'} eq 'W' ) {
+ my %issuingimpossible;
+ return ( \%issuingimpossible, \%needsconfirmation );
+ }
+ else {
+ return ( \%issuingimpossible, \%needsconfirmation );
+ }
+ }
+ else {
+ return ( \%issuingimpossible, \%needsconfirmation );
+ }
+}
+
+=head2 AddIssue
+
+Issue a book. Does no check, they are done in CanBookBeIssued. If we reach
this sub, it means the user confirmed if needed.
+
+&AddIssue($env,$borrower,$barcode,$date)
+
+=over 4
+
+=item C<$env> Environment variable. Should be empty usually, but used by other
subs. Next code cleaning could drop it.
+
+=item C<$borrower> hash with borrower informations (from GetMemberDetails)
+
+=item C<$barcode> is the bar code of the book being issued.
+
+=item C<$date> contains the max date of return. calculated if empty.
+
+AddIssue does the following things :
+- step 0°: check that there is a borrowernumber & a barcode provided
+- check for RENEWAL (book issued & being issued to the same patron)
+ - renewal YES = Calculate Charge & renew
+ - renewal NO =
+ * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but
to someone else)
+ * RESERVE PLACED ?
+ - fill reserve if reserve to this patron
+ - cancel reserve or not, otherwise
+ * TRANSFERT PENDING ?
+ - complete the transfert
+ * ISSUE THE BOOK
+
+=back
+
+=cut
+
+sub AddIssue {
+ my ( $env, $borrower, $barcode, $date, $cancelreserve ) = @_;
+
+ my $dbh = C4::Context->dbh;
+if ($borrower and $barcode){
+# my ($borrower, $flags) = &GetMemberDetails($borrowernumber, 0);
+ # find which item we issue
+ my $item = GetItem('', $barcode);
+
+ # get actual issuing if there is one
+ my $actualissue = GetItemIssue( $item->{itemnumber});
+
+ # get biblioinformation for this item
+ my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
+
+#
+# check if we just renew the issue.
+#
+ if ( $actualissue->{borrowernumber} eq $borrower->{'borrowernumber'} ) {
+ # we renew, do we need to add some charge ?
+ my ( $charge, $itemtype ) = GetIssuingCharges(
+ $item->{'itemnumber'},
+ $borrower->{'borrowernumber'}
+ );
+ if ( $charge > 0 ) {
+ AddIssuingCharge(
+ $item->{'itemnumber'},
+ $borrower->{'borrowernumber'}, $charge
+ );
+ $item->{'charge'} = $charge;
+ }
+ &UpdateStats(
+ $env, $env->{'branchcode'},
+ 'renew', $charge,
+ '', $item->{'itemnumber'},
+ $biblio->{'itemtype'}, $borrower->{'borrowernumber'}
+ );
+ AddRenewal(
+ $borrower->{'borrowernumber'},
+ $item->{'itemnumber'}
+ );
+ }
+ else {# it's NOT a renewal
+ if ( $actualissue->{borrowernumber}) {
+ # This book is currently on loan, but not to the person
+ # who wants to borrow it now. mark it returned before issuing to
the new borrower
+ AddReturn(
+ $item->{'barcode'},
+ C4::Context->userenv->{'branch'}
+ );
+ }
+
+ # See if the item is on reserve.
+ my ( $restype, $res ) =
+ CheckReserves( $item->{'itemnumber'} );
+ if ($restype) {
+ my $resbor = $res->{'borrowernumber'};
+ if ( $resbor eq $borrower->{'borrowernumber'} ) {
+
+ # The item is reserved by the current patron
+ FillReserve($res);
+ }
+ elsif ( $restype eq "Waiting" ) {
+
+ # warn "Waiting";
+ # The item is on reserve and waiting, but has been
+ # reserved by some other patron.
+ my ( $resborrower, $flags ) = GetMemberDetails( $resbor, 0 );
+ my $branches = GetBranches();
+ my $branchname =
+ $branches->{ $res->{'branchcode'} }->{'branchname'};
+ if ($cancelreserve) {
+ CancelReserve( 0, $res->{'itemnumber'},
+ $res->{'borrowernumber'} );
+ }
+ else {
+
+ # set waiting reserve to first in reserve queue as book isn't waiting
now
+ UpdateReserve(
+ 1,
+ $res->{'biblionumber'},
+ $res->{'borrowernumber'},
+ $res->{'branchcode'}
+ );
+ }
+ }
+ elsif ( $restype eq "Reserved" ) {
+
+ # warn "Reserved";
+ # The item is reserved by someone else.
+ my ( $resborrower, $flags ) =
+ GetMemberDetails( $resbor, 0 );
+ my $branches = GetBranches();
+ my $branchname =
+ $branches->{ $res->{'branchcode'} }->{'branchname'};
+ if ($cancelreserve) { # cancel reserves on this item
+ CancelReserve( 0, $res->{'itemnumber'},
+ $res->{'borrowernumber'} );
+ }
+ }
+ }
+
+ # Starting process for transfer job (checking transfert and validate
it if we have one)
+ my ($datesent) = GetTransfers($item->{'itemnumber'});
+ if ($datesent) {
+ # updating line of branchtranfert to finish it, and changing the
to branch value, implement a comment for lisibility of this case (maybe for
stats ....)
+ my $sth =
+ $dbh->prepare(
+ "UPDATE branchtransfers
+ SET datearrived = now(),
+ tobranch = ?,
+ comments = 'Forced branchtransfert'
+ WHERE itemnumber= ? AND datearrived IS NULL"
+ );
+
$sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
+ $sth->finish;
+ }
+
+ # Record in the database the fact that the book was issued.
+ my $sth =
+ $dbh->prepare(
+ "INSERT INTO issues
+ (borrowernumber, itemnumber,issuedate, date_due,
branchcode)
+ VALUES (?,?,?,?,?)"
+ );
+ my $loanlength = GetLoanLength(
+ $borrower->{'categorycode'},
+ $biblio->{'itemtype'},
+ $borrower->{'branchcode'}
+ );
+ my $datedue = time + ($loanlength) * 86400;
+ my @datearr = localtime($datedue);
+ my $dateduef =
+ ( 1900 + $datearr[5] ) . "-"
+ . ( $datearr[4] + 1 ) . "-"
+ . $datearr[3];
+ if ($date) {
+ $dateduef = $date;
+ }
+
+ # if ReturnBeforeExpiry ON the datedue can't be after borrower
expirydate
+ if ( C4::Context->preference('ReturnBeforeExpiry')
+ && $dateduef gt $borrower->{dateexpiry} )
+ {
+ $dateduef = $borrower->{dateexpiry};
+ }
+ $sth->execute(
+ $borrower->{'borrowernumber'},
+ $item->{'itemnumber'},
+ strftime( "%Y-%m-%d", localtime ),$dateduef, $env->{'branchcode'}
+ );
+ $sth->finish;
+ $item->{'issues'}++;
+ $sth =
+ $dbh->prepare(
+ "UPDATE items SET issues=?, holdingbranch=?, itemlost=0,
datelastborrowed = now() WHERE itemnumber=?");
+ $sth->execute(
+ $item->{'issues'},
+ C4::Context->userenv->{'branch'},
+ $item->{'itemnumber'}
+ );
+ $sth->finish;
+ &ModDateLastSeen( $item->{'itemnumber'} );
+ # If it costs to borrow this book, charge it to the patron's account.
+ my ( $charge, $itemtype ) = GetIssuingCharges(
+ $item->{'itemnumber'},
+ $borrower->{'borrowernumber'}
+ );
+ if ( $charge > 0 ) {
+ AddIssuingCharge(
+ $item->{'itemnumber'},
+ $borrower->{'borrowernumber'}, $charge
+ );
+ $item->{'charge'} = $charge;
+ }
+
+ # Record the fact that this book was issued.
+ &UpdateStats(
+ $env, $env->{'branchcode'},
+ 'issue', $charge,
+ '', $item->{'itemnumber'},
+ $item->{'itemtype'}, $borrower->{'borrowernumber'}
+ );
+ }
+
+
&logaction(C4::Context->userenv->{'number'},"CIRCULATION","ISSUE",$borrower->{'borrowernumber'},$biblio->{'biblionumber'})
+ if C4::Context->preference("IssueLog");
+ }
+}
+
+=head2 GetLoanLength
+
+Get loan length for an itemtype, a borrower type and a branch
+
+my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
+
+=cut
+
+sub GetLoanLength {
+ my ( $borrowertype, $itemtype, $branchcode ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare(
+"select issuelength from issuingrules where categorycode=? and itemtype=? and
branchcode=?"
+ );
+
+# try to find issuelength & return the 1st available.
+# check with borrowertype, itemtype and branchcode, then without one of those
parameters
+ $sth->execute( $borrowertype, $itemtype, $branchcode );
+ my $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+
+ $sth->execute( $borrowertype, $itemtype, "" );
+ $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+
+ $sth->execute( $borrowertype, "*", $branchcode );
+ $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+
+ $sth->execute( "*", $itemtype, $branchcode );
+ $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+
+ $sth->execute( $borrowertype, "*", "" );
+ $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+
+ $sth->execute( "*", "*", $branchcode );
+ $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+
+ $sth->execute( "*", $itemtype, "" );
+ $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+
+ $sth->execute( "*", "*", "" );
+ $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+
+ # if no rule is set => 21 days (hardcoded)
+ return 21;
+}
+
+=head2 AddReturn
+
+($doreturn, $messages, $iteminformation, $borrower) =
+ &AddReturn($barcode, $branch);
+
+Returns a book.
+
+C<$barcode> is the bar code of the book being returned. C<$branch> is
+the code of the branch where the book is being returned.
+
+C<&AddReturn> returns a list of four items:
+
+C<$doreturn> is true iff the return succeeded.
+
+C<$messages> is a reference-to-hash giving the reason for failure:
+
+=over 4
+
+=item C<BadBarcode>
+
+No item with this barcode exists. The value is C<$barcode>.
+
+=item C<NotIssued>
+
+The book is not currently on loan. The value is C<$barcode>.
+
+=item C<IsPermanent>
+
+The book's home branch is a permanent collection. If you have borrowed
+this book, you are not allowed to return it. The value is the code for
+the book's home branch.
+
+=item C<wthdrawn>
+
+This book has been withdrawn/cancelled. The value should be ignored.
+
+=item C<ResFound>
+
+The item was reserved. The value is a reference-to-hash whose keys are
+fields from the reserves table of the Koha database, and
+C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
+either C<Waiting>, C<Reserved>, or 0.
+
+=back
+
+C<$borrower> is a reference-to-hash, giving information about the
+patron who last borrowed the book.
+
+=cut
+
+# FIXME - This API is bogus. There's no need to return $borrower and
+# $iteminformation; the caller can ask about those separately, if it
+# cares (it'd be inefficient to make two database calls instead of
+# one, but &GetMemberDetails and &getiteminformation can be
+# memoized if this is an issue).
+#
+# The ($doreturn, $messages) tuple is redundant: if the return
+# succeeded, that's all the caller needs to know. So &AddReturn can
+# return 1 and 0 on success and failure, and set
+# $C4::Circulation::Circ2::errmsg to indicate the error. Or it can
+# return undef for success, and an error message on error (though this
+# is more C-ish than Perl-ish).
+
+sub AddReturn {
+ my ( $barcode, $branch ) = @_;
+ my %env;
+ my $messages;
+ my $dbh = C4::Context->dbh;
+ my $doreturn = 1;
+ my $validTransfert = 0;
+ my $reserveDone = 0;
+
+ die '$branch not defined' unless defined $branch; # just in case (bug 170)
+ # get information on item
+ my $iteminformation = GetItemIssue( GetItemFromBarcode($barcode));
+ if ( not $iteminformation ) {
+ $messages->{'BadBarcode'} = $barcode;
+ $doreturn = 0;
+ }
+
+ # find the borrower
+ if ( ( not $iteminformation->{borrowernumber} ) && $doreturn ) {
+ $messages->{'NotIssued'} = $barcode;
+ $doreturn = 0;
+ }
+
+ # check if the book is in a permanent collection....
+ my $hbr = $iteminformation->{'homebranch'};
+ my $branches = GetBranches();
+ if ( $hbr && $branches->{$hbr}->{'PE'} ) {
+ $messages->{'IsPermanent'} = $hbr;
+ }
+
+ # check that the book has been cancelled
+ if ( $iteminformation->{'wthdrawn'} ) {
+ $messages->{'wthdrawn'} = 1;itemnumber
+ $doreturn = 0;
+ }
+
+# new op dev : if the book returned in an other branch update the holding
branch
+
+# update issues, thereby returning book (should push this out into another
subroutine
+ my ($borrower) = GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
+
+# case of a return of document (deal with issues and holdingbranch)
+
+ if ($doreturn) {
+ my $sth =
+ $dbh->prepare(
+"update issues set returndate = now() where (borrowernumber = ?) and
(itemnumber = ?) and (returndate is null)"
+ );
+ $sth->execute( $borrower->{'borrowernumber'},
+ $iteminformation->{'itemnumber'} );
+ $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right?
+ }
+
+# continue to deal with returns cases, but not only if we have an issue
+
+# the holdingbranch is updated if the document is returned in an other
location .
+if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} )
+ {
+
UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
+# reload iteminformation holdingbranch with the userenv value
+ $iteminformation->{'holdingbranch'} =
C4::Context->userenv->{'branch'};
+ }
+ ModDateLastSeen( $iteminformation->{'itemnumber'} );
+ ($borrower) = GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
+
+ # fix up the accounts.....
+ if ( $iteminformation->{'itemlost'} ) {
+ $messages->{'WasLost'} = 1;
+ }
+
+ # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
+ # check if we have a transfer for this document
+ my ($datesent,$frombranch,$tobranch) = GetTransfers(
$iteminformation->{'itemnumber'} );
+
+ # if we have a transfer to do, we update the line of transfers with the
datearrived
+ if ($datesent) {
+ if ( $tobranch eq C4::Context->userenv->{'branch'} ) {
+ my $sth =
+ $dbh->prepare(
+ "update branchtransfers set datearrived = now() where
itemnumber= ? AND datearrived IS NULL"
+ );
+ $sth->execute( $iteminformation->{'itemnumber'} );
+ $sth->finish;
+# now we check if there is a reservation with the validate of transfer
if we have one, we can set it with the status 'W'
+ SetWaitingStatus( $iteminformation->{'itemnumber'} );
+ }
+ else {
+ $messages->{'WrongTransfer'} = $tobranch;
+ $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'};
+ }
+ $validTransfert = 1;
+ }
+
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
+# fix up the overdues in accounts...
+ fixoverduesonreturn( $borrower->{'borrowernumber'},
+ $iteminformation->{'itemnumber'} );
+
+# find reserves.....
+# if we don't have a reserve with the status W, we launch the
Checkreserves routine
+ my ( $resfound, $resrec ) =
+ CheckReserves( $iteminformation->{'itemnumber'} );
+ if ($resfound) {
+
+# my $tobrcd = ReserveWaiting($resrec->{'itemnumber'},
$resrec->{'borrowernumber'});
+ $resrec->{'ResFound'} = $resfound;
+ $messages->{'ResFound'} = $resrec;
+ $reserveDone = 1;
+ }
+
+ # update stats?
+ # Record the fact that this book was returned.
+ UpdateStats(
+ \%env, $branch, 'return', '0', '',
+ $iteminformation->{'itemnumber'},
+ $iteminformation->{'itemtype'},
+ $borrower->{'borrowernumber'}
+ );
+
+
&logaction(C4::Context->userenv->{'number'},"CIRCULATION","RETURN",$iteminformation->{borrowernumber},$iteminformation->{'biblionumber'})
+ if C4::Context->preference("ReturnLog");
+
+ #adding message if holdingbranch is non equal a userenv branch to return
the document to homebranch
+ #we check, if we don't have reserv or transfert for this document, if not,
return it to homebranch .
+
+ if ( ($iteminformation->{'holdingbranch'} ne
$iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and
($validTransfert ne 1) and ($reserveDone ne 1) ){
+ if (C4::Context->preference("AutomaticItemReturn") == 1) {
+ dotransfer($iteminformation->{'itemnumber'},
C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'});
+ $messages->{'WasTransfered'} = 1;
+ warn "was transfered";
+ }
+ }
+
+ return ( $doreturn, $messages, $iteminformation, $borrower );
+}
+
+=head2 fixoverdueonreturn
+
+ &fixoverdueonreturn($brn,$itm);
+
+C<$brn> borrowernumber
+
+C<$itm> itemnumber
+
+=cut
+
+sub fixoverduesonreturn {
+ my ( $borrowernumber, $item ) = @_;
+ my $dbh = C4::Context->dbh;
+
+ # check for overdue fine
+ my $sth =
+ $dbh->prepare(
+"SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?)
AND (accounttype='FU' OR accounttype='O')"
+ );
+ $sth->execute( $borrowernumber, $item );
+
+ # alter fine to show that the book has been returned
+ if ( my $data = $sth->fetchrow_hashref ) {
+ my $usth =
+ $dbh->prepare(
+"UPDATE accountlines SET accounttype='F' WHERE (borrowernumber = ?) AND
(itemnumber = ?) AND (accountno = ?)"
+ );
+ $usth->execute( $borrowernumber, $item, $data->{'accountno'} );
+ $usth->finish();
+ }
+ $sth->finish();
+ return;
+}
+
+=head2 GetItemIssue
+
+$issues = &GetBorrowerIssue($itemnumber);
+
+Returns patrons currently having a book. nothing if item is not issued atm
+
+C<$itemnumber> is the itemnumber
+
+Returns an array of hashes
+=cut
+
+sub GetItemIssue {
+ my ( $itemnumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my @GetItemIssues;
+
+ # get today date
+ my $today = POSIX::strftime("%Y%m%d", localtime);
+
+ my $sth = $dbh->prepare(
+ "SELECT * FROM issues
+ LEFT JOIN items ON issues.itemnumber=items.itemnumber
+ WHERE
+ issues.itemnumber=? AND returndate IS NULL ");
+ $sth->execute($itemnumber);
+ my $data = $sth->fetchrow_hashref;
+ my $datedue = $data->{'date_due'};
+ $datedue =~ s/-//g;
+ if ( $datedue < $today ) {
+ $data->{'overdue'} = 1;
+ }
+ my $itemnumber = $data->{'itemnumber'};
+ $sth->finish;
+ return ($data);
+}
+
+=head2 GetItemIssues
+
+$issues = &GetBorrowerIssues($itemnumber, $history);
+
+Returns patrons that have issued a book
+
+C<$itemnumber> is the itemnumber
+C<$history> is 0 if you want actuel "issuer" (if it exist) and 1 if you want
issues history
+
+Returns an array of hashes
+=cut
+
+sub GetItemIssues {
+ my ( $itemnumber,$history ) = @_;
+ my $dbh = C4::Context->dbh;
+ my @GetItemIssues;
+
+ # get today date
+ my $today = POSIX::strftime("%Y%m%d", localtime);
+
+ my $sth = $dbh->prepare(
+ "SELECT * FROM issues
+ WHERE
+ itemnumber=?".($history?"":" AND returndate IS NULL ").
+ "ORDER BY issues.date_due DESC"
+ );
+ $sth->execute($itemnumber);
+ while ( my $data = $sth->fetchrow_hashref ) {
+ my $datedue = $data->{'date_due'};
+ $datedue =~ s/-//g;
+ if ( $datedue < $today ) {
+ $data->{'overdue'} = 1;
+ }
+ my $itemnumber = $data->{'itemnumber'};
+
+ push @GetItemIssues, $data;
+ }
+ $sth->finish;
+ return ( address@hidden );
+}
+
+=head2 GetBorrowerIssues
+
+$issues = &GetBorrowerIssues($borrower);
+
+Returns a list of books currently on loan to a patron.
+
+C<$borrower->{borrowernumber}> is the borrower number of the patron
+whose issues we want to list.
+
+C<&GetBorrowerIssues> returns a PHP-style array: C<$issues> is a
+reference-to-hash whose keys are integers in the range 1...I<n>, where
+I<n> is the number of items on issue (either today or before today).
+C<$issues-E<gt>{I<n>}> is a reference-to-hash whose keys are all of
+the fields of the biblio, biblioitems, items, and issues fields of the
+Koha database for that particular item.
+
+=cut
+
+sub GetBorrowerIssues {
+ my ( $borrower ) = @_;
+ my $dbh = C4::Context->dbh;
+ my @GetBorrowerIssues;
+ # get today date
+ my $today = POSIX::strftime("%Y%m%d", localtime);
+
+ my $sth = $dbh->prepare(
+ "SELECT * FROM issues
+ LEFT JOIN items ON issues.itemnumber=items.itemnumber
+ LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
+ LEFT JOIN biblioitems ON
items.biblioitemnumber=biblioitems.biblioitemnumber
+ WHERE
+ borrowernumber=? AND returndate IS NULL
+ ORDER BY issues.date_due"
+ );
+ $sth->execute($borrower->{'borrowernumber'});
+ while ( my $data = $sth->fetchrow_hashref ) {
+ my $datedue = $data->{'date_due'};
+ $datedue =~ s/-//g;
+ if ( $datedue < $today ) {
+ $data->{'overdue'} = 1;
+ }
+ my $itemnumber = $data->{'itemnumber'};
+
+ push @GetBorrowerIssues, $data;
+ }
+ $sth->finish;
+ return ( address@hidden );
+}
+
+=head2 GetBiblioIssues
+
+$issues = GetBiblioIssues($biblionumber);
+
+this function get all issues from a biblionumber.
+
+Return:
+C<$issues> is a reference to array which each value is ref-to-hash. This
ref-to-hash containts all column from
+tables issues and the firstname,surname & cardnumber from borrowers.
+
+=cut
+
+sub GetBiblioIssues {
+ my $biblionumber = shift;
+ return undef unless $biblionumber;
+ my $dbh = C4::Context->dbh;
+ my $query = "
+ SELECT issues.*,biblio.biblionumber,biblio.title,
biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
+ FROM issues
+ LEFT JOIN borrowers ON borrowers.borrowernumber =
issues.borrowernumber
+ LEFT JOIN items ON issues.itemnumber = items.itemnumber
+ LEFT JOIN biblioitems ON items.itemnumber =
biblioitems.biblioitemnumber
+ LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
+ WHERE biblio.biblionumber = ?
+ ORDER BY issues.timestamp
+ ";
+ my $sth = $dbh->prepare($query);
+ $sth->execute($biblionumber);
+
+ my @issues;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push @issues, $data;
+ }
+ return address@hidden;
+}
+
+=head2 CanBookBeRenewed
+
+$ok = &CanBookBeRenewed($borrowernumber, $itemnumber);
+
+Find out whether a borrowed item may be renewed.
+
+C<$env> is ignored.
+
+C<$dbh> is a DBI handle to the Koha database.
+
+C<$borrowernumber> is the borrower number of the patron who currently
+has the item on loan.
+
+C<$itemnumber> is the number of the item to renew.
+
+C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
+item must currently be on loan to the specified borrower; renewals
+must be allowed for the item's type; and the borrower must not have
+already renewed the loan.
+
+=cut
+
+sub CanBookBeRenewed {
+
+ # check renewal status
+ my ( $borrowernumber, $itemnumber ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $renews = 1;
+ my $renewokay = 0;
+
+ # Look in the issues table for this item, lent to this borrower,
+ # and not yet returned.
+
+ # FIXME - I think this function could be redone to use only one SQL call.
+ my $sth1 = $dbh->prepare(
+ "SELECT * FROM issues
+ WHERE borrowernumber = ?
+ AND itemnumber = ?
+ AND returndate IS NULL"
+ );
+ $sth1->execute( $borrowernumber, $itemnumber );
+ if ( my $data1 = $sth1->fetchrow_hashref ) {
+
+ # Found a matching item
+
+ # See if this item may be renewed. This query is convoluted
+ # because it's a bit messy: given the item number, we need to find
+ # the biblioitem, which gives us the itemtype, which tells us
+ # whether it may be renewed.
+ my $sth2 = $dbh->prepare(
+ "SELECT renewalsallowed FROM items
+ LEFT JOIN biblioitems on items.biblioitemnumber =
biblioitems.biblioitemnumber
+ LEFT JOIN itemtypes ON biblioitems.itemtype =
itemtypes.itemtype
+ WHERE items.itemnumber = ?
+ "
+ );
+ $sth2->execute($itemnumber);
+ if ( my $data2 = $sth2->fetchrow_hashref ) {
+ $renews = $data2->{'renewalsallowed'};
+ }
+ if ( $renews && $renews > $data1->{'renewals'} ) {
+ $renewokay = 1;
+ }
+ $sth2->finish;
+ my ( $resfound, $resrec ) = C4::Reserves2::CheckReserves($itemnumber);
+ if ($resfound) {
+ $renewokay = 0;
+ }
+ ( $resfound, $resrec ) = C4::Reserves2::CheckReserves($itemnumber);
+ if ($resfound) {
+ $renewokay = 0;
+ }
+
+ }
+ $sth1->finish;
+ return ($renewokay);
+}
+
+=head2 AddRenewal
+
+&AddRenewal($borrowernumber, $itemnumber, $datedue);
+
+Renews a loan.
+
+C<$env-E<gt>{branchcode}> is the code of the branch where the
+renewal is taking place.
+
+C<$env-E<gt>{usercode}> is the value to log in C<statistics.usercode>
+in the Koha database.
+
+C<$borrowernumber> is the borrower number of the patron who currently
+has the item.
+
+C<$itemnumber> is the number of the item to renew.
+
+C<$datedue> can be used to set the due date. If C<$datedue> is the
+empty string, C<&AddRenewal> will calculate the due date automatically
+from the book's item type. If you wish to set the due date manually,
+C<$datedue> should be in the form YYYY-MM-DD.
+
+=cut
+
+sub AddRenewal {
+
+ my ( $borrowernumber, $itemnumber, $datedue ) = @_;
+ my $dbh = C4::Context->dbh;
+
+ # If the due date wasn't specified, calculate it by adding the
+ # book's loan length to today's date.
+ if ( $datedue eq "" ) {
+
+ my $biblio = GetBiblioFromItemNumber($itemnumber);
+ my $borrower = GetMemberDetails( $borrowernumber, 0 );
+ my $loanlength = GetLoanLength(
+ $borrower->{'categorycode'},
+ $biblio->{'itemtype'},
+ $borrower->{'branchcode'}
+ );
+ my ( $due_year, $due_month, $due_day ) =
+ Add_Delta_DHMS( Today_and_Now(), $loanlength, 0, 0, 0 );
+ $datedue = "$due_year-$due_month-$due_day";
+
+ }
+
+ # Find the issues record for this book
+ my $sth =
+ $dbh->prepare("SELECT * FROM issues
+ WHERE borrowernumber=?
+ AND itemnumber=?
+ AND returndate IS NULL"
+ );
+ $sth->execute( $borrowernumber, $itemnumber );
+ my $issuedata = $sth->fetchrow_hashref;
+ $sth->finish;
+
+ # Update the issues record to have the new due date, and a new count
+ # of how many times it has been renewed.
+ my $renews = $issuedata->{'renewals'} + 1;
+ $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?
+ WHERE borrowernumber=?
+ AND itemnumber=?
+ AND returndate IS NULL"
+ );
+ $sth->execute( $datedue, $renews, $borrowernumber, $itemnumber );
+ $sth->finish;
+
+ # Log the renewal
+ UpdateStats( C4::Context->userenv->{'branchcode'}, 'renew', '', '',
$itemnumber );
+
+ # Charge a new rental fee, if applicable?
+ my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
+ if ( $charge > 0 ) {
+ my $accountno = getnextacctno( $borrowernumber );
+ my $item = GetBiblioFromItemNumbe(r$itemnumber);
+ $sth = $dbh->prepare(
+ "INSERT INTO accountlines
+ (borrowernumber,accountno,date,amount,
+ description,accounttype,amountoutstanding,
+ itemnumber)
+ VALUES (?,?,now(),?,?,?,?,?)"
+ );
+ $sth->execute( $borrowernumber, $accountno, $charge,
+ "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
+ 'Rent', $charge, $itemnumber );
+ $sth->finish;
+ }
+}
+
+=head2 GetIssuingCharges
+
+($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
+
+Calculate how much it would cost for a given patron to borrow a given
+item, including any applicable discounts.
+
+C<$env> is ignored.
+
+C<$itemnumber> is the item number of item the patron wishes to borrow.
+
+C<$borrowernumber> is the patron's borrower number.
+
+C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
+and C<$item_type> is the code for the item's item type (e.g., C<VID>
+if it's a video).
+
+=cut
+
+sub GetIssuingCharges {
+
+ # calculate charges due
+ my ( $itemnumber, $borrowernumber ) = @_;
+ my $charge = 0;
+ my $dbh = C4::Context->dbh;
+ my $item_type;
+
+ # Get the book's item type and rental charge (via its biblioitem).
+ my $sth1 = $dbh->prepare(
+ "SELECT itemtypes.itemtype,rentalcharge FROM items
+ LEFT JOIN biblioitems ON biblioitems.biblioitemnumber =
items.biblioitemnumber
+ LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
+ WHERE items.itemnumber =?
+ "
+ );
+ $sth1->execute($itemnumber);
+ if ( my $data1 = $sth1->fetchrow_hashref ) {
+ $item_type = $data1->{'itemtype'};
+ $charge = $data1->{'rentalcharge'};
+ my $q2 = "SELECT rentaldiscount FROM borrowers
+ LEFT JOIN issuingrules ON borrowers.categorycode =
issuingrules.categorycode
+ WHERE borrowers.borrowernumber = ?
+ AND issuingrules.itemtype = ?";
+ my $sth2 = $dbh->prepare($q2);
+ $sth2->execute( $borrowernumber, $item_type );
+ if ( my $data2 = $sth2->fetchrow_hashref ) {
+ my $discount = $data2->{'rentaldiscount'};
+ if ( $discount eq 'NULL' ) {
+ $discount = 0;
+ }
+ $charge = ( $charge * ( 100 - $discount ) ) / 100;
+ }
+ $sth2->finish;
+ }
+
+ $sth1->finish;
+ return ( $charge, $item_type );
+}
+
+=head2 AddIssuingCharge
+
+&AddIssuingCharge( $itemno, $borrowernumber, $charge )
+
+=cut
+
+sub AddIssuingCharge {
+ my ( $itemnumber, $borrowernumber, $charge ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $nextaccntno = getnextacctno( $borrowernumber );
+ my $query ="
+ INSERT INTO accountlines
+ (borrowernumber, itemnumber, accountno,
+ date, amount, description, accounttype,
+ amountoutstanding)
+ VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
+ ";
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge,
$charge );
+ $sth->finish;
+}
+
+=head2 GetTransfers
+
+GetTransfers($itemnumber);
+
+=cut
+
+sub GetTransfers {
+ my ($itemnumber) = @_;
+
+ my $dbh = C4::Context->dbh;
+
+ my $query = '
+ SELECT datesent,
+ frombranch,
+ tobranch
+ FROM branchtransfers
+ WHERE itemnumber = ?
+ AND datearrived IS NULL
+ ';
+ my $sth = $dbh->prepare($query);
+ $sth->execute($itemnumber);
+ my @row = $sth->fetchrow_array();
+ $sth->finish;
+ return @row;
+}
+
+
+=head2 GetTransfersFromTo
+
address@hidden = GetTransfersFromTo($frombranch,$tobranch);
+
+Returns the list of pending transfers between $from and $to branch
+
+=cut
+
+sub GetTransfersFromTo {
+ my ( $frombranch, $tobranch ) = @_;
+ return unless ( $frombranch && $tobranch );
+ my $dbh = C4::Context->dbh;
+ my $query = "
+ SELECT itemnumber,datesent,frombranch
+ FROM branchtransfers
+ WHERE frombranch=?
+ AND tobranch=?
+ AND datearrived IS NULL
+ ";
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $frombranch, $tobranch );
+ my @gettransfers;
+
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push @gettransfers, $data;
+ }
+ $sth->finish;
+ return (@gettransfers);
+}
+
+=head2 DeleteTransfer
+
+&DeleteTransfer($itemnumber);
+
+=cut
+
+sub DeleteTransfer {
+ my ($itemnumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "DELETE FROM branchtransfers
+ WHERE itemnumber=?
+ AND datearrived IS NULL "
+ );
+ $sth->execute($itemnumber);
+ $sth->finish;
+}
+
+=head2 AnonymiseIssueHistory
+
+$rows = AnonymiseIssueHistory($borrowernumber,$date)
+
+This function write NULL instead of C<$borrowernumber> given on input arg into
the table issues.
+if C<$borrowernumber> is not set, it will delete the issue history for all
borrower older than C<$date>.
+
+return the number of affected rows.
+
+=cut
+
+sub AnonymiseIssueHistory {
+ my $date = shift;
+ my $borrowernumber = shift;
+ my $dbh = C4::Context->dbh;
+ my $query = "
+ UPDATE issues
+ SET borrowernumber = NULL
+ WHERE returndate < '".$date."'
+ AND borrowernumber IS NOT NULL
+ ";
+ $query .= " AND borrowernumber = '".$borrowernumber."'" if defined
$borrowernumber;
+ my $rows_affected = $dbh->do($query);
+ return $rows_affected;
+}
+
+=head2 updateWrongTransfer
+
+$items =
updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
+
+This function validate the line of brachtransfer but with the wrong
destination (mistake from a librarian ...), and create a new line in
branchtransfer from the actual library to the original library of reservation
+
+=cut
+
+sub updateWrongTransfer {
+ my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
+ my $dbh = C4::Context->dbh;
+# first step validate the actual line of transfert .
+ my $sth =
+ $dbh->prepare(
+ "update branchtransfers set datearrived =
now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived
IS NULL"
+ );
+ $sth->execute($FromLibrary,$itemNumber);
+ $sth->finish;
+
+# second step create a new line of branchtransfer to the right location .
+ dotransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
+
+#third step changing holdingbranch of item
+ UpdateHoldingbranch($FromLibrary,$itemNumber);
+}
+
+=head2 UpdateHoldingbranch
+
+$items = UpdateHoldingbranch($branch,$itmenumber);
+Simple methode for updating hodlingbranch in items BDD line
+=cut
+
+sub UpdateHoldingbranch {
+ my ( $branch,$itmenumber ) = @_;
+ my $dbh = C4::Context->dbh;
+# first step validate the actual line of transfert .
+ my $sth =
+ $dbh->prepare(
+ "update items set holdingbranch = ? where itemnumber= ?"
+ );
+ $sth->execute($branch,$itmenumber);
+ $sth->finish;
+
+
+}
+
+1;
+
+__END__
+
+=head1 AUTHOR
+
+Koha Developement team <address@hidden>
+
+=cut
+
Index: Overdues.pm
===================================================================
RCS file: Overdues.pm
diff -N Overdues.pm
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ Overdues.pm 5 Apr 2007 08:53:31 -0000 1.1
@@ -0,0 +1,1314 @@
+package C4::Overdues;
+
+# $Id: Overdues.pm,v 1.1 2007/04/05 08:53:31 hdl Exp $
+
+# 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;
+require Exporter;
+use C4::Context;
+use Date::Calc qw/Today/;
+use vars qw($VERSION @ISA @EXPORT);
+use C4::Accounts;
+use Date::Manip qw/UnixDate/;
+use C4::Log; # logaction
+
+# set the version for version checking
+$VERSION = do { my @v = '$Revision: 1.1 $' =~ /\d+/g;
+shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
+
+=head1 NAME
+
+C4::Circulation::Fines - Koha module dealing with fines
+
+=head1 SYNOPSIS
+
+ use C4::Overdues;
+
+=head1 DESCRIPTION
+
+This module contains several functions for dealing with fines for
+overdue items. It is primarily used by the 'misc/fines2.pl' script.
+
+=head1 FUNCTIONS
+
+=over 2
+
+=cut
+
address@hidden = qw(Exporter);
+# subs to rename (and maybe merge some...)
+push @EXPORT, qw(
+ &CalcFine
+ &Getoverdues
+ &checkoverdues
+ &CheckAccountLineLevelInfo
+ &CheckAccountLineItemInfo
+ &CheckExistantNotifyid
+ &GetNextIdNotify
+ &GetNotifyId
+ &NumberNotifyId
+ &AmountNotify
+ &UpdateAccountLines
+ &UpdateFine
+ &GetOverdueDelays
+ &GetOverduerules
+ &GetFine
+ &CreateItemAccountLine
+ &ReplacementCost2
+
+ &CheckItemNotify
+ &GetOverduesForBranch
+ &RemoveNotifyLine
+ &AddNotifyLine
+);
+# subs to remove
+push @EXPORT, qw(
+ &BorType
+);
+
+#
+# All subs to move : check that an equivalent don't exist already before moving
+#
+
+# subs to move to Circulation.pm
+push @EXPORT, qw(
+ &GetIssuingRules
+ &GetIssuesIteminfo
+);
+# subs to move to Members.pm
+push @EXPORT, qw(
+ &CheckBorrowerDebarred
+ &UpdateBorrowerDebarred
+);
+# subs to move to Biblio.pm
+push @EXPORT, qw(
+ &GetItems
+ &ReplacementCost
+);
+
+=item Getoverdues
+
+ ($count, $overdues) = &Getoverdues();
+
+Returns the list of all overdue books.
+
+C<$count> is the number of elements in C<@{$overdues}>.
+
+C<$overdues> is a reference-to-array. Each element is a
+reference-to-hash whose keys are the fields of the issues table in the
+Koha database.
+
+=cut
+
+#'
+sub Getoverdues {
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "Select * from issues where date_due < now() and returndate is
+ NULL order by borrowernumber "
+ );
+ $sth->execute;
+
+ # FIXME - Use push @results
+ my $i = 0;
+ my @results;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $results[$i] = $data;
+ $i++;
+ }
+ $sth->finish;
+
+ # print @results;
+ # FIXME - Bogus API.
+ return ( $i, address@hidden );
+}
+
+=head2 checkoverdues
+
+( $count, $overdueitems )=checkoverdues( $borrowernumber, $dbh );
+
+Not exported
+
+=cut
+
+sub checkoverdues {
+
+# From Main.pm, modified to return a list of overdueitems, in addition to a
count
+#checks whether a borrower has overdue items
+ my ( $borrowernumber, $dbh ) = @_;
+ my @datearr = localtime;
+ my $today =
+ ( $datearr[5] + 1900 ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
+ my @overdueitems;
+ my $count = 0;
+ my $sth = $dbh->prepare(
+ "SELECT * FROM issues,biblio,biblioitems,items
+ WHERE items.biblioitemnumber = biblioitems.biblioitemnumber
+ AND items.biblionumber = biblio.biblionumber
+ AND issues.itemnumber = items.itemnumber
+ AND issues.borrowernumber = ?
+ AND issues.returndate is NULL
+ AND issues.date_due < ?"
+ );
+ $sth->execute( $borrowernumber, $today );
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push( @overdueitems, $data );
+ $count++;
+ }
+ $sth->finish;
+ return ( $count, address@hidden );
+}
+
+=item CalcFine
+
+ ($amount, $chargename, $message) =
+ &CalcFine($itemnumber, $borrowercode, $days_overdue);
+
+Calculates the fine for a book.
+
+The issuingrules table in the Koha database is a fine matrix, listing
+the penalties for each type of patron for each type of item and each branch
(e.g., the
+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
+the book.
+
+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).
+
+C<$chargename> is the chargename field from the applicable record in
+the categoryitem table, whatever that is.
+
+C<$message> is a text message, either "First Notice", "Second Notice",
+or "Final Notice".
+
+=cut
+
+#'
+sub CalcFine {
+ my ( $itemnumber, $bortype, $difference , $dues ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $data = GetIssuingRules($itemnumber,$bortype);
+ my $amount = 0;
+ my $printout;
+ my $countspecialday=&GetSpecialHolidays($dues,$itemnumber);
+ my
$countrepeatableday=&GetRepeatableHolidays($dues,$itemnumber,$difference);
+ my $countalldayclosed = $countspecialday + $countrepeatableday;
+ my $daycount = $difference - $countalldayclosed;
+ my $daycounttotal = $daycount - $data->{'firstremind'};
+ if ($data->{'firstremind'} < $daycount)
+ {
+ $amount = $daycounttotal*$data->{'fine'};
+ }
+ return ( $amount, $data->{'chargename'}, $printout ,$daycounttotal ,$daycount
);
+}
+
+
+=item GetSpecialHolidays
+
+&GetSpecialHolidays($date_dues,$itemnumber);
+
+return number of special days between date of the day and date due
+
+C<$date_dues> is the envisaged date of book return.
+
+C<$itemnumber> is the book's item number.
+
+=cut
+
+sub GetSpecialHolidays {
+my ($date_dues,$itemnumber) = @_;
+# calcul the today date
+my $today = join "-", &Today();
+
+# return the holdingbranch
+my $iteminfo=GetIssuesIteminfo($itemnumber);
+# use sql request to find all date between date_due and today
+my $dbh = C4::Context->dbh;
+my $query=qq|SELECT DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d')as
date
+FROM `special_holidays`
+WHERE DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') >= ?
+AND DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') <= ?
+AND branchcode=?
+|;
+my @result=GetWdayFromItemnumber($itemnumber);
+my @result_date;
+my $wday;
+my $dateinsec;
+my $sth = $dbh->prepare($query);
+$sth->execute($date_dues,$today,$iteminfo->{'branchcode'});
+
+while ( my $special_date=$sth->fetchrow_hashref){
+ push (@result_date,$special_date);
+}
+
+my $specialdaycount=scalar(@result_date);
+
+ for (my $i=0;$i<scalar(@result_date);$i++){
+ $dateinsec=UnixDate($result_date[$i]->{'date'},"%o");
+ (undef,undef,undef,undef,undef,undef,$wday,undef,undef)
=localtime($dateinsec);
+ for (my $j=0;$j<scalar(@result);$j++){
+ if ($wday == ($result[$j]->{'weekday'})){
+ $specialdaycount --;
+ }
+ }
+ }
+
+return $specialdaycount;
+}
+
+=item GetRepeatableHolidays
+
+&GetRepeatableHolidays($date_dues, $itemnumber, $difference,);
+
+return number of day closed between date of the day and date due
+
+C<$date_dues> is the envisaged date of book return.
+
+C<$itemnumber> is item number.
+
+C<$difference> numbers of between day date of the day and date due
+
+=cut
+
+sub GetRepeatableHolidays{
+my ($date_dues,$itemnumber,$difference) = @_;
+my $dateinsec=UnixDate($date_dues,"%o");
+my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
=localtime($dateinsec);
+my @result=GetWdayFromItemnumber($itemnumber);
+my @dayclosedcount;
+my $j;
+
+for (my $i=0;$i<scalar(@result);$i++){
+ my $k=$wday;
+
+ for ( $j=0;$j<$difference;$j++){
+ if ($result[$i]->{'weekday'} == $k)
+ {
+ push ( @dayclosedcount ,$k);
+ }
+ $k++;
+ ($k=0) if($k eq 7);
+ }
+ }
+return scalar(@dayclosedcount);
+}
+
+
+=item GetWayFromItemnumber
+
+&Getwdayfromitemnumber($itemnumber);
+
+return the different week day from repeatable_holidays table
+
+C<$itemnumber> is item number.
+
+=cut
+
+sub GetWdayFromItemnumber{
+my($itemnumber)address@hidden;
+my $iteminfo=GetIssuesIteminfo($itemnumber);
+my @result;
+my $dbh = C4::Context->dbh;
+my $query = qq|SELECT weekday
+ FROM repeatable_holidays
+ WHERE branchcode=?
+|;
+my $sth = $dbh->prepare($query);
+ # print $query;
+
+$sth->execute($iteminfo->{'branchcode'});
+while ( my $weekday=$sth->fetchrow_hashref){
+ push (@result,$weekday);
+ }
+return @result;
+}
+
+
+=item GetIssuesIteminfo
+
+&GetIssuesIteminfo($itemnumber);
+
+return all data from issues about item
+
+C<$itemnumber> is item number.
+
+=cut
+
+sub GetIssuesIteminfo{
+my($itemnumber)address@hidden;
+my $dbh = C4::Context->dbh;
+my $query = qq|SELECT *
+ FROM issues
+ WHERE itemnumber=?
+|;
+my $sth = $dbh->prepare($query);
+$sth->execute($itemnumber);
+my ($issuesinfo)=$sth->fetchrow_hashref;
+return $issuesinfo;
+}
+
+
+=item UpdateFine
+
+ &UpdateFine($itemnumber, $borrowernumber, $amount, $type, $description);
+
+(Note: the following is mostly conjecture and guesswork.)
+
+Updates the fine owed on an overdue book.
+
+C<$itemnumber> is the book's item number.
+
+C<$borrowernumber> is the borrower number of the patron who currently
+has the book on loan.
+
+C<$amount> is the current amount owed by the patron.
+
+C<$type> will be used in the description of the fine.
+
+C<$description> is a string that must be present in the description of
+the fine. I think this is expected to be a date in DD/MM/YYYY format.
+
+C<&UpdateFine> looks up the amount currently owed on the given item
+and sets it to C<$amount>, creating, if necessary, a new entry in the
+accountlines table of the Koha database.
+
+=cut
+
+#'
+# FIXME - This API doesn't look right: why should the caller have to
+# specify both the item number and the borrower number? A book can't
+# be on loan to two different people, so the item number should be
+# sufficient.
+sub UpdateFine {
+ my ( $itemnum, $borrowernumber, $amount, $type, $due ) = @_;
+ my $dbh = C4::Context->dbh;
+ # FIXME - What exactly is this query supposed to do? It looks up an
+ # entry in accountlines that matches the given item and borrower
+ # numbers, where the description contains $due, and where the
+ # account type has one of several values, but what does this _mean_?
+ # Does it look up existing fines for this item?
+ # FIXME - What are these various account types? ("FU", "O", "F", "M")
+ my $sth = $dbh->prepare(
+ "Select * from accountlines where itemnumber=? and
+ borrowernumber=? and (accounttype='FU' or accounttype='O' or
+ accounttype='F' or accounttype='M') and description like ?"
+ );
+ $sth->execute( $itemnum, $borrowernumber, "%$due%" );
+
+ if ( my $data = $sth->fetchrow_hashref ) {
+
+ # I think this if-clause deals with the case where we're updating
+ # an existing fine.
+ # print "in accounts ...";
+ if ( $data->{'amount'} != $amount ) {
+
+ # print "updating";
+ my $diff = $amount - $data->{'amount'};
+ my $out = $data->{'amountoutstanding'} + $diff;
+ my $sth2 = $dbh->prepare(
+ "update accountlines set date=now(), amount=?,
+ amountoutstanding=?,accounttype='FU' where
+ borrowernumber=? and itemnumber=?
+ and (accounttype='FU' or accounttype='O') and description like ?"
+ );
+ $sth2->execute( $amount, $out, $data->{'borrowernumber'},
+ $data->{'itemnumber'}, "%$due%" );
+ $sth2->finish;
+ }
+ else {
+
+ # print "no update needed $data->{'amount'}"
+ }
+ }
+ else {
+
+ # I think this else-clause deals with the case where we're adding
+ # a new fine.
+ my $sth4 = $dbh->prepare(
+ "select title from biblio,items where items.itemnumber=?
+ and biblio.biblionumber=items.biblionumber"
+ );
+ $sth4->execute($itemnum);
+ my $title = $sth4->fetchrow_hashref;
+ $sth4->finish;
+
+# # print "not in account";
+# my $sth3 = $dbh->prepare("Select max(accountno) from accountlines");
+# $sth3->execute;
+#
+# # FIXME - Make $accountno a scalar.
+# my @accountno = $sth3->fetchrow_array;
+# $sth3->finish;
+# $accountno[0]++;
+# begin transaction
+ my $nextaccntno = getnextacctno($borrowernumber);
+ my $sth2 = $dbh->prepare(
+ "Insert into accountlines
+ (borrowernumber,itemnumber,date,amount,
+ description,accounttype,amountoutstanding,accountno) values
+ (?,?,now(),?,?,'FU',?,?)"
+ );
+ $sth2->execute( $borrowernumber, $itemnum, $amount,
+ "$type $title->{'title'} $due",
+ $amount, $nextaccntno);
+ $sth2->finish;
+ }
+ # logging action
+ &logaction(
+ C4::Context->userenv->{'number'},
+ "FINES",
+ $type,
+ $borrowernumber,
+ "due=".$due." amount=".$amount." itemnumber=".$itemnum
+ ) if C4::Context->preference("FinesLog");
+
+ $sth->finish;
+}
+
+=item BorType
+
+ $borrower = &BorType($borrowernumber);
+
+Looks up a patron by borrower number.
+
+C<$borrower> is a reference-to-hash whose keys are all of the fields
+from the borrowers and categories tables of the Koha database. Thus,
+C<$borrower> contains all information about both the borrower and
+category he or she belongs to.
+
+=cut
+
+#'
+sub BorType {
+ my ($borrowernumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "Select * from borrowers,categories where
+ borrowernumber=? and
+borrowers.categorycode=categories.categorycode"
+ );
+ $sth->execute($borrowernumber);
+ my $data = $sth->fetchrow_hashref;
+ $sth->finish;
+ return ($data);
+}
+
+=item ReplacementCost
+
+ $cost = &ReplacementCost($itemnumber);
+
+Returns the replacement cost of the item with the given item number.
+
+=cut
+
+#'
+sub ReplacementCost {
+ my ($itemnum) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare("Select replacementprice from items where itemnumber=?");
+ $sth->execute($itemnum);
+
+ # FIXME - Use fetchrow_array or something.
+ my $data = $sth->fetchrow_hashref;
+ $sth->finish;
+ return ( $data->{'replacementprice'} );
+}
+
+=item GetFine
+
+$data->{'sum(amountoutstanding)'} = &GetFine($itemnum,$borrowernumber);
+
+return the total of fine
+
+C<$itemnum> is item number
+
+C<$borrowernumber> is the borrowernumber
+
+=cut
+
+
+sub GetFine {
+ my ( $itemnum, $borrowernumber ) = @_;
+ my $dbh = C4::Context->dbh();
+ my $query = "SELECT sum(amountoutstanding) FROM accountlines
+ where accounttype like 'F%'
+ AND amountoutstanding > 0 AND itemnumber = ? AND borrowernumber=?";
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $itemnum, $borrowernumber );
+ my $data = $sth->fetchrow_hashref();
+ $sth->finish();
+ $dbh->disconnect();
+ return ( $data->{'sum(amountoutstanding)'} );
+}
+
+
+
+
+=item GetIssuingRules
+
+$data = &GetIssuingRules($itemnumber,$categorycode);
+
+Looks up for all issuingrules an item info
+
+C<$itemnumber> is a reference-to-hash whose keys are all of the fields
+from the borrowers and categories tables of the Koha database. Thus,
+
+C<$categorycode> contains information about borrowers category
+
+C<$data> contains all information about both the borrower and
+category he or she belongs to.
+=cut
+
+sub GetIssuingRules {
+ my ($itemnumber,$categorycode)address@hidden;
+ my $dbh = C4::Context->dbh();
+ my $query=qq|SELECT *
+ FROM items,biblioitems,itemtypes,issuingrules
+ WHERE items.itemnumber=?
+ AND items.biblioitemnumber=biblioitems.biblioitemnumber
+ AND biblioitems.itemtype=itemtypes.itemtype
+ AND issuingrules.itemtype=itemtypes.itemtype
+ AND issuingrules.categorycode=?
+ AND (items.itemlost <> 1
+ OR items.itemlost is NULL)|;
+ my $sth = $dbh->prepare($query);
+ # print $query;
+ $sth->execute($itemnumber,$categorycode);
+ my ($data) = $sth->fetchrow_hashref;
+ $sth->finish;
+return ($data);
+
+}
+
+
+sub ReplacementCost2 {
+ my ( $itemnum, $borrowernumber ) = @_;
+ my $dbh = C4::Context->dbh();
+ my $query = "SELECT amountoutstanding
+ FROM accountlines
+ WHERE accounttype like 'L'
+ AND amountoutstanding > 0
+ AND itemnumber = ?
+ AND borrowernumber= ?";
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $itemnum, $borrowernumber );
+ my $data = $sth->fetchrow_hashref();
+ $sth->finish();
+ $dbh->disconnect();
+ return ( $data->{'amountoutstanding'} );
+}
+
+
+=item GetNextIdNotify
+
+($result) = &GetNextIdNotify($reference);
+
+Returns the new file number
+
+C<$result> contains the next file number
+
+C<$reference> contains the beggining of file number
+
+=cut
+
+
+
+sub GetNextIdNotify {
+my ($reference)address@hidden;
+my $query=qq|SELECT max(notify_id)
+ FROM accountlines
+ WHERE notify_id like \"$reference%\"
+ |;
+# AND borrowernumber=?|;
+my $dbh = C4::Context->dbh;
+my $sth=$dbh->prepare($query);
+$sth->execute();
+my $result=$sth->fetchrow;
+$sth->finish;
+my $count;
+ if ($result eq '')
+ {
+ ($result=$reference."01") ;
+ }else
+ {
+ $count=substr($result,6)+1;
+
+ if($count<10){
+ ($count = "0".$count);
+ }
+ $result=$reference.$count;
+ }
+return $result;
+}
+
+
+=item AmountNotify
+
+(@notify) = &AmountNotify($borrowernumber);
+
+Returns amount for all file per borrowers
+C<@notify> array contains all file per borrowers
+
+C<$notify_id> contains the file number for the borrower number nad item number
+
+=cut
+
+sub NumberNotifyId{
+ my ($borrowernumber)address@hidden;
+ my $dbh = C4::Context->dbh;
+ my $env;
+ my $query=qq| SELECT distinct(notify_id)
+ FROM accountlines
+ WHERE borrowernumber=?|;
+ my @notify;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber);
+ while ( my $numberofotify=$sth->fetchrow_array){
+ push (@notify,$numberofotify);
+ }
+ $sth->finish;
+
+ return (@notify);
+
+}
+
+=item AmountNotify
+
+($totalnotify) = &AmountNotify($notifyid);
+
+Returns amount for all file per borrowers
+C<$notifyid> is the file number
+
+C<$totalnotify> contains amount of a file
+
+C<$notify_id> contains the file number for the borrower number nad item number
+
+=cut
+
+sub AmountNotify{
+ my ($notifyid)address@hidden;
+ my $dbh = C4::Context->dbh;
+ my $query=qq| SELECT sum(amountoutstanding)
+ FROM accountlines
+ WHERE notify_id=?|;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($notifyid);
+ my $totalnotify=$sth->fetchrow;
+ $sth->finish;
+ return ($totalnotify);
+}
+
+
+=item GetNotifyId
+
+($notify_id) = &GetNotifyId($borrowernumber,$itemnumber);
+
+Returns the file number per borrower and itemnumber
+
+C<$borrowernumber> is a reference-to-hash whose keys are all of the fields
+from the items tables of the Koha database. Thus,
+
+C<$itemnumber> contains the borrower categorycode
+
+C<$notify_id> contains the file number for the borrower number nad item number
+
+=cut
+
+ sub GetNotifyId {
+ my ($borrowernumber,$itemnumber)address@hidden;
+ my $query=qq|SELECT notify_id
+ FROM accountlines
+ WHERE borrowernumber=?
+ AND itemnumber=?
+ AND (accounttype='FU' or accounttype='O')|;
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber,$itemnumber);
+ my ($notify_id)=$sth->fetchrow;
+ $sth->finish;
+ return ($notify_id);
+
+ }
+
+=item CreateItemAccountLine
+
+() =
&CreateItemAccountLine($borrowernumber,$itemnumber,$date,$amount,$description,$accounttype,$amountoutstanding,$timestamp,$notify_id,$level);
+
+update the account lines with file number or with file level
+
+C<$items> is a reference-to-hash whose keys are all of the fields
+from the items tables of the Koha database. Thus,
+
+C<$itemnumber> contains the item number
+
+C<$borrowernumber> contains the borrower number
+
+C<$date> contains the date of the day
+
+C<$amount> contains item price
+
+C<$description> contains the descritpion of accounttype
+
+C<$accounttype> contains the account type
+
+C<$amountoutstanding> contains the $amountoutstanding
+
+C<$timestamp> contains the timestamp with time and the date of the day
+
+C<$notify_id> contains the file number
+
+C<$level> contains the file level
+
+
+=cut
+
+ sub CreateItemAccountLine {
+ my
($borrowernumber,$itemnumber,$date,$amount,$description,$accounttype,$amountoutstanding,$timestamp,$notify_id,$level)address@hidden;
+ my $dbh = C4::Context->dbh;
+ my $nextaccntno = getnextacctno($borrowernumber);
+ my $query= "INSERT into accountlines
+
(borrowernumber,accountno,itemnumber,date,amount,description,accounttype,amountoutstanding,timestamp,notify_id,notify_level)
+ VALUES
+ (?,?,?,?,?,?,?,?,?,?,?)";
+
+
+ my $sth=$dbh->prepare($query);
+
$sth->execute($borrowernumber,$nextaccntno,$itemnumber,$date,$amount,$description,$accounttype,$amountoutstanding,$timestamp,$notify_id,$level);
+ $sth->finish;
+ }
+
+=item UpdateAccountLines
+
+() = &UpdateAccountLines($notify_id,$notify_level,$borrowernumber,$itemnumber);
+
+update the account lines with file number or with file level
+
+C<$items> is a reference-to-hash whose keys are all of the fields
+from the items tables of the Koha database. Thus,
+
+C<$itemnumber> contains the item number
+
+C<$notify_id> contains the file number
+
+C<$notify_level> contains the file level
+
+C<$borrowernumber> contains the borrowernumber
+
+=cut
+
+sub UpdateAccountLines {
+my ($notify_id,$notify_level,$borrowernumber,$itemnumber)address@hidden;
+my $query;
+if ($notify_id eq '')
+{
+
+ $query=qq|UPDATE accountlines
+ SET notify_level=?
+ WHERE borrowernumber=? AND itemnumber=?
+ AND (accounttype='FU' or accounttype='O')|;
+}else
+{
+ $query=qq|UPDATE accountlines
+ SET notify_id=?, notify_level=?
+ WHERE borrowernumber=?
+ AND itemnumber=?
+ AND (accounttype='FU' or accounttype='O')|;
+}
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare($query);
+
+if ($notify_id eq '')
+{
+ $sth->execute($notify_level,$borrowernumber,$itemnumber);
+}else
+{
+ $sth->execute($notify_id,$notify_level,$borrowernumber,$itemnumber);
+}
+ $sth->finish;
+
+}
+
+
+=item GetItems
+
+($items) = &GetItems($itemnumber);
+
+Returns the list of all delays from overduerules.
+
+C<$items> is a reference-to-hash whose keys are all of the fields
+from the items tables of the Koha database. Thus,
+
+C<$itemnumber> contains the borrower categorycode
+
+=cut
+
+sub GetItems {
+ my($itemnumber) = @_;
+ my $query=qq|SELECT *
+ FROM items
+ WHERE itemnumber=?|;
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($itemnumber);
+ my ($items)=$sth->fetchrow_hashref;
+ $sth->finish;
+ return($items);
+}
+
+=item GetOverdueDelays
+
+(@delays) = &GetOverdueDelays($categorycode);
+
+Returns the list of all delays from overduerules.
+
+C<@delays> it's an array contains the three delays from overduerules table
+
+C<$categorycode> contains the borrower categorycode
+
+=cut
+
+sub GetOverdueDelays {
+ my($category) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query=qq|SELECT delay1,delay2,delay3
+ FROM overduerules
+ WHERE categorycode=?|;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($category);
+ my (@delays)=$sth->fetchrow_array;
+ $sth->finish;
+ return(@delays);
+}
+
+=item CheckAccountLineLevelInfo
+
+($exist) =
&CheckAccountLineLevelInfo($borrowernumber,$itemnumber,$accounttype,notify_level);
+
+Check and Returns the list of all overdue books.
+
+C<$exist> contains number of line in accounlines
+with the same .biblionumber,itemnumber,accounttype,and notify_level
+
+C<$borrowernumber> contains the borrower number
+
+C<$itemnumber> contains item number
+
+C<$accounttype> contains account type
+
+C<$notify_level> contains the accountline level
+
+
+=cut
+
+sub CheckAccountLineLevelInfo {
+ my($borrowernumber,$itemnumber,$level) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query= qq|SELECT count(*)
+ FROM accountlines
+ WHERE borrowernumber =?
+ AND itemnumber = ?
+ AND notify_level=?|;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber,$itemnumber,$level);
+ my ($exist)=$sth->fetchrow;
+ $sth->finish;
+ return($exist);
+}
+
+=item GetOverduerules
+
+($overduerules) = &GetOverduerules($categorycode);
+
+Returns the value of borrowers (debarred or not) with notify level
+
+C<$overduerules> return value of debbraed field in overduerules table
+
+C<$category> contains the borrower categorycode
+
+C<$notify_level> contains the notify level
+=cut
+
+
+sub GetOverduerules{
+ my($category,$notify_level) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query=qq|SELECT debarred$notify_level
+ FROM overduerules
+ WHERE categorycode=?|;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($category);
+ my ($overduerules)=$sth->fetchrow;
+ $sth->finish;
+ return($overduerules);
+}
+
+
+=item CheckBorrowerDebarred
+
+($debarredstatus) = &CheckBorrowerDebarred($borrowernumber);
+
+Check if the borrowers is already debarred
+
+C<$debarredstatus> return 0 for not debarred and return 1 for debarred
+
+C<$borrowernumber> contains the borrower number
+
+=cut
+
+
+sub CheckBorrowerDebarred{
+ my($borrowernumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query=qq|SELECT debarred
+ FROM borrowers
+ WHERE borrowernumber=?
+ |;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber);
+ my ($debarredstatus)=$sth->fetchrow;
+ $sth->finish;
+ if ($debarredstatus eq '1'){
+ return(1);}
+ else{
+ return(0);
+ }
+}
+
+=item UpdateBorrowerDebarred
+
+($borrowerstatut) = &UpdateBorrowerDebarred($borrowernumber);
+
+update status of borrowers in borrowers table (field debarred)
+
+C<$borrowernumber> borrower number
+
+=cut
+
+sub UpdateBorrowerDebarred{
+ my($borrowernumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query=qq|UPDATE borrowers
+ SET debarred='1'
+ WHERE borrowernumber=?
+ |;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber);
+ $sth->finish;
+ return 1;
+}
+
+=item CheckExistantNotifyid
+
+ ($exist) =
&CheckExistantNotifyid($borrowernumber,$itemnumber,$accounttype,$notify_id);
+
+Check and Returns the notify id if exist else return 0.
+
+C<$exist> contains a notify_id
+
+C<$borrowernumber> contains the borrower number
+
+C<$date_due> contains the date of item return
+
+
+=cut
+
+sub CheckExistantNotifyid {
+ my($borrowernumber,$date_due) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = qq|SELECT notify_id FROM issues,accountlines
+ WHERE accountlines.borrowernumber =?
+ AND issues.itemnumber= accountlines.itemnumber
+ AND date_due = ?|;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber,$date_due);
+ my ($exist)=$sth->fetchrow;
+ $sth->finish;
+ if ($exist eq '')
+ {
+ return(0);
+ }else
+ {
+ return($exist);
+ }
+}
+
+=item CheckAccountLineItemInfo
+
+ ($exist) =
&CheckAccountLineItemInfo($borrowernumber,$itemnumber,$accounttype,$notify_id);
+
+Check and Returns the list of all overdue items from the same file
number(notify_id).
+
+C<$exist> contains number of line in accounlines
+with the same .biblionumber,itemnumber,accounttype,notify_id
+
+C<$borrowernumber> contains the borrower number
+
+C<$itemnumber> contains item number
+
+C<$accounttype> contains account type
+
+C<$notify_id> contains the file number
+
+=cut
+
+sub CheckAccountLineItemInfo {
+ my($borrowernumber,$itemnumber,$accounttype,$notify_id) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = qq|SELECT count(*) FROM accountlines
+ WHERE borrowernumber =?
+ AND itemnumber = ?
+ AND accounttype= ?
+ AND notify_id = ?|;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber,$itemnumber,$accounttype,$notify_id);
+ my ($exist)=$sth->fetchrow;
+ $sth->finish;
+ return($exist);
+ }
+
+=head2 CheckItemNotify
+
+Sql request to check if the document has alreday been notified
+this function is not exported, only used with GetOverduesForBranch
+
+=cut
+
+sub CheckItemNotify {
+ my ($notify_id,$notify_level,$itemnumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("
+ SELECT COUNT(*) FROM notifys
+ WHERE notify_id = ?
+ AND notify_level = ?
+ AND itemnumber = ? ");
+ $sth->execute($notify_id,$notify_level,$itemnumber);
+ my $notified = $sth->fetchrow;
+$sth->finish;
+return ($notified);
+}
+
+=head2 GetOverduesForBranch
+
+Sql request for display all information for branchoverdues.pl
+2 possibilities : with or without department .
+display is filtered by branch
+
+=cut
+
+sub GetOverduesForBranch {
+ my ( $branch, $department) = @_;
+ if ( not $department ) {
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("
+ SELECT
+ borrowers.surname,
+ borrowers.firstname,
+ biblio.title,
+ itemtypes.description,
+ issues.date_due,
+ issues.returndate,
+ branches.branchname,
+ items.barcode,
+ borrowers.phone,
+ borrowers.email,
+ items.itemcallnumber,
+ borrowers.borrowernumber,
+ items.itemnumber,
+ biblio.biblionumber,
+ issues.branchcode,
+ accountlines.notify_id,
+ accountlines.notify_level,
+ items.location,
+ accountlines.amountoutstanding
+ FROM
issues,borrowers,biblio,biblioitems,itemtypes,items,branches,accountlines
+ WHERE ( issues.returndate is null)
+ AND ( accountlines.amountoutstanding != '0.000000')
+ AND ( accountlines.accounttype = 'FU')
+ AND ( issues.borrowernumber = accountlines.borrowernumber )
+ AND ( issues.itemnumber = accountlines.itemnumber )
+ AND ( borrowers.borrowernumber = issues.borrowernumber )
+ AND ( biblio.biblionumber = biblioitems.biblionumber )
+ AND ( biblioitems.biblionumber = items.biblionumber )
+ AND ( itemtypes.itemtype = biblioitems.itemtype )
+ AND ( items.itemnumber = issues.itemnumber )
+ AND ( branches.branchcode = issues.branchcode )
+ AND (issues.branchcode = ?)
+ AND (issues.date_due <= NOW())
+ ORDER BY borrowers.surname
+ ");
+ $sth->execute($branch);
+ my @getoverdues;
+ my $i = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ #check if the document has already been notified
+ my $countnotify =
CheckItemNotify($data->{'notify_id'},$data->{'notify_level'},$data->{'itemnumber'});
+ if ($countnotify eq '0'){
+ $getoverdues[$i] = $data;
+ $i++;
+ }
+ }
+ return (@getoverdues);
+ $sth->finish;
+ }
+ else {
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare( "
+ SELECT borrowers.surname,
+ borrowers.firstname,
+ biblio.title,
+ itemtypes.description,
+ issues.date_due,
+ issues.returndate,
+ branches.branchname,
+ items.barcode,
+ borrowers.phone,
+ borrowers.email,
+ items.itemcallnumber,
+ borrowers.borrowernumber,
+ items.itemnumber,
+ biblio.biblionumber,
+ issues.branchcode,
+ accountlines.notify_id,
+ accountlines.notify_level,
+ items.location,
+ accountlines.amountoutstanding
+ FROM
issues,borrowers,biblio,biblioitems,itemtypes,items,branches,accountlines
+ WHERE ( issues.returndate is null )
+ AND ( accountlines.amountoutstanding != '0.000000')
+ AND ( accountlines.accounttype = 'FU')
+ AND ( issues.borrowernumber = accountlines.borrowernumber )
+ AND ( issues.itemnumber = accountlines.itemnumber )
+ AND ( borrowers.borrowernumber = issues.borrowernumber )
+ AND ( biblio.biblionumber = biblioitems.biblionumber )
+ AND ( biblioitems.biblionumber = items.biblionumber )
+ AND ( itemtypes.itemtype = biblioitems.itemtype )
+ AND ( items.itemnumber = issues.itemnumber )
+ AND ( branches.branchcode = issues.branchcode )
+ AND (issues.branchcode = ? AND items.location = ?)
+ AND (issues.date_due <= NOW())
+ ORDER BY borrowers.surname
+ " );
+ $sth->execute( $branch, $department);
+ my @getoverdues;
+ my $i = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ #check if the document has already been notified
+ my $countnotify =
CheckItemNotify($data->{'notify_id'},$data->{'notify_level'},$data->{'itemnumber'});
+ if ($countnotify eq '0'){
+ $getoverdues[$i] = $data;
+ $i++;
+ }
+ }
+ $sth->finish;
+ return (@getoverdues);
+ }
+}
+
+
+=head2 AddNotifyLine
+
+&AddNotifyLine($borrowernumber, $itemnumber, $overduelevel, $method, $notifyId)
+
+Creat a line into notify, if the method is phone, the notification_send_date
is implemented to
+
+=cut
+
+sub AddNotifyLine {
+ my ( $borrowernumber, $itemnumber, $overduelevel, $method, $notifyId ) =
@_;
+ if ( $method eq "phone" ) {
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "INSERT INTO notifys
(borrowernumber,itemnumber,notify_date,notify_send_date,notify_level,method,notify_id)
+ VALUES (?,?,now(),now(),?,?,?)"
+ );
+ $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
+ $notifyId );
+ $sth->finish;
+ }
+ else {
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "INSERT INTO notifys
(borrowernumber,itemnumber,notify_date,notify_level,method,notify_id)
+ VALUES (?,?,now(),?,?,?)"
+ );
+ $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
+ $notifyId );
+ $sth->finish;
+ }
+ return 1;
+}
+
+=head2 RemoveNotifyLine
+
+&RemoveNotifyLine( $borrowernumber, $itemnumber, $notify_date );
+
+Cancel a notification
+
+=cut
+
+sub RemoveNotifyLine {
+ my ( $borrowernumber, $itemnumber, $notify_date ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "DELETE FROM notifys
+ WHERE
+ borrowernumber=?
+ AND itemnumber=?
+ AND notify_date=?"
+ );
+ $sth->execute( $borrowernumber, $itemnumber, $notify_date );
+ $sth->finish;
+ return 1;
+}
+
+1;
+__END__
+
+=back
+
+=head1 AUTHOR
+
+Koha Developement team <address@hidden>
+
+=cut
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Koha-cvs] koha/C4 Circulation.pm Overdues.pm,
Henri-Damien LAURENT <=