333 lines
11 KiB
Perl
Executable file
333 lines
11 KiB
Perl
Executable file
package C4::Circulation::Returns;
|
|
|
|
# $Id$
|
|
|
|
#package to deal with Returns
|
|
#written 3/11/99 by olwen@katipo.co.nz
|
|
|
|
|
|
# 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
|
|
|
|
# FIXME - None of the functions (certainly none of the exported
|
|
# functions) are used anywhere anymore. Presumably this module is
|
|
# obsolete.
|
|
|
|
use strict;
|
|
require Exporter;
|
|
use DBI;
|
|
use C4::Context;
|
|
use C4::Accounts;
|
|
use C4::InterfaceCDK;
|
|
use C4::Circulation::Main;
|
|
# FIXME - C4::Circulation::Main and C4::Circulation::Returns
|
|
# use each other, so functions get redefined.
|
|
use C4::Scan;
|
|
use C4::Stats;
|
|
use C4::Members;
|
|
use C4::Print;
|
|
|
|
use vars qw($VERSION @ISA @EXPORT);
|
|
|
|
# set the version for version checking
|
|
$VERSION = 0.01;
|
|
|
|
@ISA = qw(Exporter);
|
|
@EXPORT = qw(&returnrecord &calc_odues &Returns);
|
|
|
|
# FIXME - This is only used in C4::Circmain and C4::Circulation, both
|
|
# of which appear to be obsolete. Presumably this function is obsolete
|
|
# as well.
|
|
# Otherwise, it needs a POD.
|
|
sub Returns {
|
|
my ($env)=@_;
|
|
my $dbh = C4::Context->dbh;
|
|
my @items;
|
|
@items[0]=" "x50;
|
|
my $reason;
|
|
my $item;
|
|
my $reason;
|
|
my $borrower;
|
|
my $itemno;
|
|
my $itemrec;
|
|
my $bornum;
|
|
my $amt_owing;
|
|
my $odues;
|
|
my $issues;
|
|
my $resp;
|
|
# until (($reason eq "Circ") || ($reason eq "Quit")) {
|
|
until ($reason ne "") {
|
|
($reason,$item) =
|
|
returnwindow($env,"Enter Returns",
|
|
$item,\@items,$borrower,$amt_owing,$odues,$dbh,$resp); #C4::Circulation
|
|
#debug_msg($env,"item = $item");
|
|
#if (($reason ne "Circ") && ($reason ne "Quit")) {
|
|
if ($reason eq "") {
|
|
$resp = "";
|
|
($resp,$bornum,$borrower,$itemno,$itemrec,$amt_owing) =
|
|
checkissue($env,$dbh,$item);
|
|
if ($bornum ne "") {
|
|
($issues,$odues,$amt_owing) = borrdata2($env,$bornum);
|
|
} else {
|
|
$issues = "";
|
|
$odues = "";
|
|
$amt_owing = "";
|
|
}
|
|
if ($resp ne "") {
|
|
#if ($resp eq "Returned") {
|
|
if ($itemno ne "" ) {
|
|
my $item = getbibliofromitemnumber($env,$dbh,$itemno);
|
|
# FIXME - This relies on C4::Circulation::Main to have a
|
|
# "use C4::Circulation::Issues;" line, which is bogus.
|
|
my $fmtitem = C4::Circulation::Issues::formatitem($env,$item,"",$amt_owing);
|
|
unshift @items,$fmtitem;
|
|
if ($items[20] > "") {
|
|
pop @items;
|
|
}
|
|
}
|
|
#} elsif ($resp ne "") {
|
|
# error_msg($env,"$resp");
|
|
#}
|
|
#if ($resp ne "Returned") {
|
|
# error_msg($env,"$resp");
|
|
# $bornum = "";
|
|
#}
|
|
}
|
|
}
|
|
}
|
|
# clearscreen;
|
|
return($reason);
|
|
}
|
|
|
|
# FIXME - Only used in &Returns and in telnet/doreturns.pl, both of
|
|
# which appear obsolete. Presumably this function is obsolete as well.
|
|
# Otherwise, it needs a POD.
|
|
sub checkissue {
|
|
my ($env,$dbh, $item) = @_;
|
|
my $reason='Circ';
|
|
my $bornum;
|
|
my $borrower;
|
|
my $itemno;
|
|
my $itemrec;
|
|
my $amt_owing;
|
|
$item = uc $item;
|
|
my $sth=$dbh->prepare("select * from items,biblio
|
|
where barcode = ?
|
|
and (biblio.biblionumber=items.biblionumber)");
|
|
$sth->execute($item);
|
|
if ($itemrec=$sth->fetchrow_hashref) {
|
|
$sth->finish;
|
|
$itemno = $itemrec->{'itemnumber'};
|
|
my $sth=$dbh->prepare("select * from issues
|
|
where (itemnumber=?)
|
|
and (returndate is null)");
|
|
$sth->execute($itemrec->{'itemnumber'});
|
|
if (my $issuerec=$sth->fetchrow_hashref) {
|
|
$sth->finish;
|
|
my $sth= $dbh->prepare("select * from borrowers where
|
|
(borrowernumber = ?)");
|
|
$sth->execute($issuerec->{'borrowernumber'});
|
|
$env->{'bornum'}=$issuerec->{'borrowernumber'};
|
|
$borrower = $sth->fetchrow_hashref;
|
|
$bornum = $issuerec->{'borrowernumber'};
|
|
$itemno = $issuerec->{'itemnumber'};
|
|
$amt_owing = returnrecord($env,$dbh,$bornum,$itemno);
|
|
$reason = "Returned";
|
|
} else {
|
|
$sth->finish;
|
|
updatelastseen($env,$dbh,$itemrec->{'itemnumber'});
|
|
$reason = "Item not issued";
|
|
}
|
|
my ($resfound,$resrec) = find_reserves($env,$dbh,$itemrec->{'itemnumber'});
|
|
if ($resfound eq "y") {
|
|
my $btsh = $dbh->prepare("select * from borrowers
|
|
where borrowernumber = ?");
|
|
$btsh->execute($resrec->{'borrowernumber'});
|
|
my $resborrower = $btsh->fetchrow_hashref;
|
|
#printreserve($env,$resrec,$resborrower,$itemrec);
|
|
my $mess = "Reserved for collection at branch $resrec->{'branchcode'}";
|
|
C4::InterfaceCDK::error_msg($env,$mess);
|
|
$btsh->finish;
|
|
}
|
|
} else {
|
|
$sth->finish;
|
|
$reason = "Item not found";
|
|
}
|
|
return ($reason,$bornum,$borrower,$itemno,$itemrec,$amt_owing);
|
|
# end checkissue
|
|
}
|
|
|
|
# FIXME - Only used in &C4::Circulation::Main::previousissue,
|
|
# &checkissue, C4/Circulation.pm, and tkperl/tkcirc, all of which
|
|
# appear to be obsolete. Presumably this function is obsolete as well.
|
|
# Otherwise, it needs a POD.
|
|
sub returnrecord {
|
|
# mark items as returned
|
|
my ($env,$dbh,$bornum,$itemno)=@_;
|
|
#my $amt_owing = calc_odues($env,$dbh,$bornum,$itemno);
|
|
my @datearr = localtime(time);
|
|
my $dateret = (1900+$datearr[5])."-".$datearr[4]."-".$datearr[3];
|
|
my $sth = $dbh->prepare("update issues set returndate = now(), branchcode = ? where
|
|
(borrowernumber = ?) and (itemnumber = ?)
|
|
and (returndate is null)");
|
|
$sth->execute($env->{'branchcode'},$bornum,$itemno);
|
|
$sth->finish;
|
|
updatelastseen($env,$dbh,$itemno);
|
|
# check for overdue fine
|
|
my $oduecharge;
|
|
my $sth = $dbh->prepare("select * from accountlines
|
|
where (borrowernumber = ?)
|
|
and (itemnumber = ?)
|
|
and (accounttype = 'FU' or accounttype='O')");
|
|
$sth->execute($bornum,$itemno);
|
|
if (my $data = $sth->fetchrow_hashref) {
|
|
# alter fine to show that the book has been returned.
|
|
my $usth = $dbh->prepare("update accountlines
|
|
set accounttype = 'F'
|
|
where (borrowernumber = ?)
|
|
and (itemnumber = ?)
|
|
and (accountno = ?) ");
|
|
$usth->execute($bornum,$itemno,$data->{'accountno'});
|
|
$usth->finish();
|
|
$oduecharge = $data->{'amountoutstanding'};
|
|
}
|
|
$sth->finish;
|
|
# check for charge made for lost book
|
|
my $sth = $dbh->prepare("select * from accountlines
|
|
where (borrowernumber = ?)
|
|
and (itemnumber = ?)
|
|
and (accounttype = 'L')");
|
|
$sth->execute($bornum,$itemno);
|
|
if (my $data = $sth->fetchrow_hashref) {
|
|
# writeoff this amount
|
|
my $offset;
|
|
my $amount = $data->{'amount'};
|
|
my $acctno = $data->{'accountno'};
|
|
my $amountleft;
|
|
if ($data->{'amountoutstanding'} == $amount) {
|
|
$offset = $data->{'amount'};
|
|
$amountleft = 0;
|
|
} else {
|
|
$offset = $amount - $data->{'amountoutstanding'};
|
|
$amountleft = $data->{'amountoutstanding'} - $amount;
|
|
}
|
|
my $usth = $dbh->prepare("update accountlines
|
|
set accounttype = 'LR',amountoutstanding='0'
|
|
where (borrowernumber = ?)
|
|
and (itemnumber = ?)
|
|
and (accountno = ?) ");
|
|
$usth->execute($bornum,$itemno,$acctno);
|
|
$usth->finish;
|
|
my $nextaccntno = C4::Accounts::getnextacctno($env,$bornum,$dbh);
|
|
$usth = $dbh->prepare("insert into accountlines
|
|
(borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
|
|
values (?,?,now(),?,'Book Returned','CR',?)");
|
|
$usth->execute($bornum,$nextaccntno,0-$amount,$amountleft);
|
|
$usth->finish;
|
|
$uquery = "insert into accountoffsets
|
|
(borrowernumber, accountno, offsetaccount, offsetamount)
|
|
values (?,?,?,?)";
|
|
$usth = $dbh->prepare("");
|
|
$usth->execute($bornum,$data->{'accountno'},$nextaccntno,$offset);
|
|
$usth->finish;
|
|
}
|
|
$sth->finish;
|
|
UpdateStats($env,'branch','return','0','',$itemno);
|
|
return($oduecharge);
|
|
}
|
|
|
|
# FIXME - Only used in tkperl/tkcirc. Presumably this function is
|
|
# obsolete.
|
|
# Otherwise, it needs a POD.
|
|
sub calc_odues {
|
|
# calculate overdue fees
|
|
my ($env,$dbh,$bornum,$itemno)=@_;
|
|
my $amt_owing;
|
|
return($amt_owing);
|
|
}
|
|
|
|
# This function is only used in &checkissue and &returnrecord, both of
|
|
# which appear to be obsolete. So presumably this function is obsolete
|
|
# too.
|
|
# Otherwise, it needs a POD.
|
|
sub updatelastseen {
|
|
my ($env,$dbh,$itemnumber)= @_;
|
|
my $br = $env->{'branchcode'};
|
|
my $sth = $dbh->prepare("update items
|
|
set datelastseen = now(), holdingbranch = ?
|
|
where (itemnumber = ?)");
|
|
$sth->execute($br,$itemnumber);
|
|
$sth->finish;
|
|
|
|
}
|
|
|
|
|
|
# FIXME - There's also a &C4::Circulation::Circ2::find_reserves, but
|
|
# that one looks rather different.
|
|
# FIXME - This is only used in &checkissue, which appears to be
|
|
# obsolete. So presumably this function is obsolete too.
|
|
sub find_reserves {
|
|
my ($env,$dbh,$itemno) = @_;
|
|
my $itemdata = getbibliofromitemnumber($env,$dbh,$itemno);
|
|
my $sth = $dbh->prepare("select * from reserves where found is null
|
|
and biblionumber = ? and cancellationdate is NULL
|
|
order by priority,reservedate ");
|
|
$sth->execute($itemdata->{'biblionumber'};
|
|
my $resfound = "n";
|
|
my $resrec;
|
|
while (($resrec=$sth->fetchrow_hashref) && ($resfound eq "n")) {
|
|
if ($resrec->{'found'} eq "W") {
|
|
if ($resrec->{'itemnumber'} eq $itemno) {
|
|
$resfound = "y";
|
|
}
|
|
} elsif ($resrec->{'constrainttype'} eq "a") {
|
|
$resfound = "y";
|
|
} else {
|
|
my $consth = $dbh->prepare("select * from reserveconstraints where borrowernumber = ? and reservedate = ? and biblionumber = ? and biblioitemnumber = ?");
|
|
$consth->execute($resrec->{'borrowernumber'},$resrec->{'reservedate'},$resrec->{'biblionumber'},$itemdata->{'biblioitemnumber'});
|
|
if (my $conrec=$consth->fetchrow_hashref) {
|
|
if ($resrec->{'constrainttype'} eq "o") {
|
|
$resfound = "y";
|
|
}
|
|
} else {
|
|
if ($resrec->{'constrainttype'} eq "e") {
|
|
$resfound = "y";
|
|
}
|
|
}
|
|
$consth->finish;
|
|
}
|
|
if ($resfound eq "y") {
|
|
my $updsth = $dbh->prepare("update reserves
|
|
set found = 'W',itemnumber = ?
|
|
where borrowernumber = ?
|
|
and reservedate = ?
|
|
and biblionumber = ?");
|
|
$updsth->execute($itemno,$resrec->{'borrowernumber'},$resrec->{'reservedate'},$resrec->{'biblionumber'});
|
|
$updsth->finish;
|
|
my $itbr = $resrec->{'branchcode'};
|
|
if ($resrec->{'branchcode'} ne $env->{'branchcode'}) {
|
|
my $updsth = $dbh->prepare("update items
|
|
set holdingbranch = 'TR'
|
|
where itemnumber = ?");
|
|
$updsth->execute($itemno);
|
|
$updsth->finish;
|
|
}
|
|
}
|
|
}
|
|
$sth->finish;
|
|
return ($resfound,$resrec);
|
|
}
|