C4/Circulation/Returns.pm

   1 package C4::Circulation::Returns;
   2
   3 # $Id$
   4
   5 #package to deal with Returns
   6 #written 3/11/99 by olwen@katipo.co.nz
   7
   8
   9 # Copyright 2000-2002 Katipo Communications
  10 #
  11 # This file is part of Koha.
  12 #
  13 # Koha is free software; you can redistribute it and/or modify it under the
  14 # terms of the GNU General Public License as published by the Free Software
  15 # Foundation; either version 2 of the License, or (at your option) any later
  16 # version.
  17 #
  18 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  19 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  20 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  21 #
  22 # You should have received a copy of the GNU General Public License along with
  23 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  24 # Suite 330, Boston, MA  02111-1307 USA
  25
  26 # FIXME - None of the functions (certainly none of the exported
  27 # functions) are used anywhere anymore. Presumably this module is
  28 # obsolete.
  29
  30 use strict;
  31 require Exporter;
  32 use DBI;
  33 use C4::Context;
  34 use C4::Accounts2;
  35 use C4::InterfaceCDK;
  36 use C4::Circulation::Main;
  37         # FIXME - C4::Circulation::Main and C4::Circulation::Returns
  38         # use each other, so functions get redefined.
  39 use C4::Scan;
  40 use C4::Stats;
  41 use C4::Members;
  42 use C4::Print;
  43
  44 use vars qw($VERSION @ISA @EXPORT);
  45
  46 # set the version for version checking
  47 $VERSION = 0.01;
  48
  49 @ISA = qw(Exporter);
  50 @EXPORT = qw(&returnrecord &calc_odues &Returns);
  51
  52 # FIXME - This is only used in C4::Circmain and C4::Circulation, both
  53 # of which appear to be obsolete. Presumably this function is obsolete
  54 # as well.
  55 # Otherwise, it needs a POD.
  56 sub Returns {
  57   my ($env)=@_;
  58   my $dbh = C4::Context->dbh;
  59   my @items;
  60   @items[0]=" "x50;
  61   my $reason;
  62   my $item;
  63   my $reason;
  64   my $borrower;
  65   my $itemno;
  66   my $itemrec;
  67   my $bornum;
  68   my $amt_owing;
  69   my $odues;
  70   my $issues;
  71   my $resp;
  72 # until (($reason eq "Circ") || ($reason eq "Quit")) {
  73   until ($reason ne "") {
  74     ($reason,$item) =
  75       returnwindow($env,"Enter Returns",
  76       $item,\@items,$borrower,$amt_owing,$odues,$dbh,$resp); #C4::Circulation
  77     #debug_msg($env,"item = $item");
  78     #if (($reason ne "Circ") && ($reason ne "Quit")) {
  79     if ($reason eq "")  {
  80       $resp = "";
  81       ($resp,$bornum,$borrower,$itemno,$itemrec,$amt_owing) =
  82          checkissue($env,$dbh,$item);
  83       if ($bornum ne "") {
  84          ($issues,$odues,$amt_owing) = borrdata2($env,$bornum);
  85       } else {
  86         $issues = "";
  87         $odues = "";
  88         $amt_owing = "";
  89       }
  90       if ($resp ne "") {
  91         #if ($resp eq "Returned") {
  92         if ($itemno ne "" ) {
  93           my $item = getbibliofromitemnumber($env,$dbh,$itemno);
  94           # FIXME - This relies on C4::Circulation::Main to have a
  95           # "use C4::Circulation::Issues;" line, which is bogus.
  96           my $fmtitem = C4::Circulation::Issues::formatitem($env,$item,"",$amt_owing);
  97           unshift @items,$fmtitem;
  98           if ($items[20] > "") {
  99             pop @items;
 100           }
 101         }
 102         #} elsif ($resp ne "") {
 103         #  error_msg($env,"$resp");
 104         #}
 105         #if ($resp ne "Returned") {
 106         #  error_msg($env,"$resp");
 107         #  $bornum = "";
 108         #}
 109       }
 110     }
 111   }
 112 #  clearscreen;
 113   return($reason);
 114   }
 115
 116 # FIXME - Only used in &Returns and in telnet/doreturns.pl, both of
 117 # which appear obsolete. Presumably this function is obsolete as well.
 118 # Otherwise, it needs a POD.
 119 sub checkissue {
 120   my ($env,$dbh, $item) = @_;
 121   my $reason='Circ';
 122   my $bornum;
 123   my $borrower;
 124   my $itemno;
 125   my $itemrec;
 126   my $amt_owing;
 127   $item = uc $item;
 128   my $sth=$dbh->prepare("select * from items,biblio
 129     where barcode = ?
 130     and (biblio.biblionumber=items.biblionumber)");
 131   $sth->execute($item);
 132   if ($itemrec=$sth->fetchrow_hashref) {
 133      $sth->finish;
 134      $itemno = $itemrec->{'itemnumber'};
 135      my $sth=$dbh->prepare("select * from issues
 136        where (itemnumber=?)
 137        and (returndate is null)");
 138      $sth->execute($itemrec->{'itemnumber'});
 139      if (my $issuerec=$sth->fetchrow_hashref) {
 140        $sth->finish;
 141        my $sth= $dbh->prepare("select * from borrowers where
 142        (borrowernumber = ?)");
 143        $sth->execute($issuerec->{'borrowernumber'});
 144        $env->{'bornum'}=$issuerec->{'borrowernumber'};
 145        $borrower = $sth->fetchrow_hashref;
 146        $bornum = $issuerec->{'borrowernumber'};
 147        $itemno = $issuerec->{'itemnumber'};
 148        $amt_owing = returnrecord($env,$dbh,$bornum,$itemno);
 149        $reason = "Returned";
 150      } else {
 151        $sth->finish;
 152        updatelastseen($env,$dbh,$itemrec->{'itemnumber'});
 153        $reason = "Item not issued";
 154      }
 155      my ($resfound,$resrec) = find_reserves($env,$dbh,$itemrec->{'itemnumber'});
 156      if ($resfound eq "y") {
 157        my $btsh = $dbh->prepare("select * from borrowers
 158           where borrowernumber = ?");
 159        $btsh->execute($resrec->{'borrowernumber'});
 160        my $resborrower = $btsh->fetchrow_hashref;
 161        #printreserve($env,$resrec,$resborrower,$itemrec);
 162        my $mess = "Reserved for collection at branch $resrec->{'branchcode'}";
 163        C4::InterfaceCDK::error_msg($env,$mess);
 164        $btsh->finish;
 165      }
 166    } else {
 167      $sth->finish;
 168      $reason = "Item not found";
 169   }
 170   return ($reason,$bornum,$borrower,$itemno,$itemrec,$amt_owing);
 171   # end checkissue
 172   }
 173
 174 # FIXME - Only used in &C4::Circulation::Main::previousissue,
 175 # &checkissue, C4/Circulation.pm, and tkperl/tkcirc, all of which
 176 # appear to be obsolete. Presumably this function is obsolete as well.
 177 # Otherwise, it needs a POD.
 178 sub returnrecord {
 179   # mark items as returned
 180   my ($env,$dbh,$bornum,$itemno)=@_;
 181   #my $amt_owing = calc_odues($env,$dbh,$bornum,$itemno);
 182   my @datearr = localtime(time);
 183   my $dateret = (1900+$datearr[5])."-".$datearr[4]."-".$datearr[3];
 184   my $sth = $dbh->prepare("update issues set returndate = now(), branchcode = ? where
 185     (borrowernumber = ?) and (itemnumber = ?)
 186     and (returndate is null)");
 187   $sth->execute($env->{'branchcode'},$bornum,$itemno);
 188   $sth->finish;
 189   updatelastseen($env,$dbh,$itemno);
 190   # check for overdue fine
 191   my $oduecharge;
 192   my $sth = $dbh->prepare("select * from accountlines
 193     where (borrowernumber = ?)
 194     and (itemnumber = ?)
 195     and (accounttype = 'FU' or accounttype='O')");
 196     $sth->execute($bornum,$itemno);
 197     if (my $data = $sth->fetchrow_hashref) {
 198        # alter fine to show that the book has been returned.
 199        my $usth = $dbh->prepare("update accountlines
 200          set accounttype = 'F'
 201          where (borrowernumber = ?)
 202          and (itemnumber = ?)
 203          and (accountno = ?) ");
 204        $usth->execute($bornum,$itemno,$data->{'accountno'});
 205        $usth->finish();
 206        $oduecharge = $data->{'amountoutstanding'};
 207     }
 208     $sth->finish;
 209   # check for charge made for lost book
 210   my $sth = $dbh->prepare("select * from accountlines
 211     where (borrowernumber = ?)
 212     and (itemnumber = ?)
 213     and (accounttype = 'L')");
 214   $sth->execute($bornum,$itemno);
 215   if (my $data = $sth->fetchrow_hashref) {
 216     # writeoff this amount
 217     my $offset;
 218     my $amount = $data->{'amount'};
 219     my $acctno = $data->{'accountno'};
 220     my $amountleft;
 221     if ($data->{'amountoutstanding'} == $amount) {
 222        $offset = $data->{'amount'};
 223        $amountleft = 0;
 224     } else {
 225        $offset = $amount - $data->{'amountoutstanding'};
 226        $amountleft = $data->{'amountoutstanding'} - $amount;
 227     }
 228     my $usth = $dbh->prepare("update accountlines
 229       set accounttype = 'LR',amountoutstanding='0'
 230       where (borrowernumber = ?)
 231       and (itemnumber = ?)
 232       and (accountno = ?) ");
 233     $usth->execute($bornum,$itemno,$acctno);
 234     $usth->finish;
 235     my $nextaccntno = C4::Accounts::getnextacctno($env,$bornum,$dbh);
 236     $usth = $dbh->prepare("insert into accountlines
 237       (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
 238       values (?,?,now(),?,'Book Returned','CR',?)");
 239     $usth->execute($bornum,$nextaccntno,0-$amount,$amountleft);
 240     $usth->finish;
 241     $uquery = "insert into accountoffsets
 242       (borrowernumber, accountno, offsetaccount,  offsetamount)
 243       values (?,?,?,?)";
 244     $usth = $dbh->prepare("");
 245     $usth->execute($bornum,$data->{'accountno'},$nextaccntno,$offset);
 246     $usth->finish;
 247   }
 248   $sth->finish;
 249   UpdateStats($env,'branch','return','0','',$itemno);
 250   return($oduecharge);
 251 }
 252
 253 # FIXME - Only used in tkperl/tkcirc. Presumably this function is
 254 # obsolete.
 255 # Otherwise, it needs a POD.
 256 sub calc_odues {
 257   # calculate overdue fees
 258   my ($env,$dbh,$bornum,$itemno)=@_;
 259   my $amt_owing;
 260   return($amt_owing);
 261 }
 262
 263 # This function is only used in &checkissue and &returnrecord, both of
 264 # which appear to be obsolete. So presumably this function is obsolete
 265 # too.
 266 # Otherwise, it needs a POD.
 267 sub updatelastseen {
 268   my ($env,$dbh,$itemnumber)= @_;
 269   my $br = $env->{'branchcode'};
 270   my $sth = $dbh->prepare("update items
 271     set datelastseen = now(), holdingbranch = ?
 272     where (itemnumber = ?)");
 273   $sth->execute($br,$itemnumber);
 274   $sth->finish;
 275
 276 }
 277
 278
 279 # FIXME - There's also a &C4::Circulation::Circ2::find_reserves, but
 280 # that one looks rather different.
 281 # FIXME - This is only used in &checkissue, which appears to be
 282 # obsolete. So presumably this function is obsolete too.
 283 sub find_reserves {
 284   my ($env,$dbh,$itemno) = @_;
 285   my $itemdata = getbibliofromitemnumber($env,$dbh,$itemno);
 286   my $sth = $dbh->prepare("select * from reserves where found is null
 287   and biblionumber = ? and cancellationdate is NULL
 288   order by priority,reservedate ");
 289   $sth->execute($itemdata->{'biblionumber'};
 290   my $resfound = "n";
 291   my $resrec;
 292   while (($resrec=$sth->fetchrow_hashref) && ($resfound eq "n")) {
 293     if ($resrec->{'found'} eq "W") {
 294       if ($resrec->{'itemnumber'} eq $itemno) {
 295         $resfound = "y";
 296       }
 297     } elsif ($resrec->{'constrainttype'} eq "a") {
 298       $resfound = "y";
 299     } else {
 300       my $consth = $dbh->prepare("select * from reserveconstraints where borrowernumber = ? and reservedate = ? and biblionumber = ? and biblioitemnumber = ?");
 301       $consth->execute($resrec->{'borrowernumber'},$resrec->{'reservedate'},$resrec->{'biblionumber'},$itemdata->{'biblioitemnumber'});
 302       if (my $conrec=$consth->fetchrow_hashref) {
 303         if ($resrec->{'constrainttype'} eq "o") {
 304            $resfound = "y";
 305          }
 306       } else {
 307         if ($resrec->{'constrainttype'} eq "e") {
 308           $resfound = "y";
 309         }
 310       }
 311       $consth->finish;
 312     }
 313     if ($resfound eq "y") {
 314       my $updsth = $dbh->prepare("update reserves
 315         set found = 'W',itemnumber = ?
 316         where borrowernumber = ?
 317         and reservedate = ?
 318         and biblionumber = ?");
 319       $updsth->execute($itemno,$resrec->{'borrowernumber'},$resrec->{'reservedate'},$resrec->{'biblionumber'});
 320       $updsth->finish;
 321       my $itbr = $resrec->{'branchcode'};
 322       if ($resrec->{'branchcode'} ne $env->{'branchcode'}) {
 323         my $updsth = $dbh->prepare("update items
 324           set holdingbranch = 'TR'
 325           where itemnumber = ?");
 326         $updsth->execute($itemno);
 327         $updsth->finish;
 328       }
 329     }
 330   }
 331   $sth->finish;
 332   return ($resfound,$resrec);
 333 }