From e86eb18b406f0e7f9edc79c3a8484ffd99173e49 Mon Sep 17 00:00:00 2001 From: hdl Date: Thu, 5 Apr 2007 08:53:31 +0000 Subject: [PATCH] Adding Circulation and Overdues modules --- C4/Circulation.pm | 1948 +++++++++++++++++++++++++++++++++++++++++++++ C4/Overdues.pm | 1314 ++++++++++++++++++++++++++++++ 2 files changed, 3262 insertions(+) create mode 100755 C4/Circulation.pm create mode 100644 C4/Overdues.pm diff --git a/C4/Circulation.pm b/C4/Circulation.pm new file mode 100755 index 0000000000..56fb3ce702 --- /dev/null +++ b/C4/Circulation.pm @@ -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$ + +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$' =~ /\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 + +@ISA = 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 + +There is no item in the catalog with the given barcode. The value is C<$barcode>. + +=item C + +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 + +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 + +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 + +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. It also has the key C, whose value is either C or C. + +=item C + +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 table in the Koha database. +Additional keys include: + +=over 4 + +=item C + +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 + +If the item is currently on loan, this gives the card number of the +patron who currently has the item. + +=item C, C, C + +These give the timestamp for the last three times the item was +borrowed. + +=item C, C, C + +The card number of the last three patrons who borrowed this item. + +=item C, C, C + +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 + +No item with this barcode exists. The value is C<$barcode>. + +=item C + +The book is not currently on loan. The value is C<$barcode>. + +=item C + +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 + +This book has been withdrawn/cancelled. The value should be ignored. + +=item C + +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. It also has the key C, whose value is +either C, C, 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 ( \@GetItemIssues ); +} + +=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, where +I is the number of items on issue (either today or before today). +C<$issues-E{I}> 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 ( \@GetBorrowerIssues ); +} + +=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 \@issues; +} + +=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{branchcode}> is the code of the branch where the +renewal is taking place. + +C<$env-E{usercode}> is the value to log in C +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 +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 + +@results = 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 + +=cut + diff --git a/C4/Overdues.pm b/C4/Overdues.pm new file mode 100644 index 0000000000..226ec8e9f6 --- /dev/null +++ b/C4/Overdues.pm @@ -0,0 +1,1314 @@ +package C4::Overdues; + +# $Id$ + +# 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$' =~ /\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 + +@ISA = 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, \@results ); +} + +=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, \@overdueitems ); +} + +=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{'date'},"%o"); + (undef,undef,undef,undef,undef,undef,$wday,undef,undef) =localtime($dateinsec); + for (my $j=0;$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{'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)=@_; +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)=@_; +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)=@_; + 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)=@_; +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)=@_; + 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)=@_; + 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)=@_; + 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)=@_; + 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)=@_; +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 + +=cut -- 2.20.1