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 use C4::Biblio;
  44
  45 use vars qw($VERSION @ISA @EXPORT);
  46
  47 # set the version for version checking
  48 $VERSION = 0.01;
  49
  50 @ISA = qw(Exporter);
  51 @EXPORT = qw(&returnrecord &calc_odues &Returns);
  52
  53 # FIXME - This is only used in C4::Circmain and C4::Circulation, both
  54 # of which appear to be obsolete. Presumably this function is obsolete
  55 # as well.
  56 # Otherwise, it needs a POD.
  57 sub Returns {
  58   my ($env)=@_;
  59   my $dbh = C4::Context->dbh;
  60   my @items;
  61   @items[0]=" "x50;
  62   my $reason;
  63   my $item;
  64   my $reason;
  65   my $borrower;
  66   my $itemno;
  67   my $itemrec;
  68   my $bornum;
  69   my $amt_owing;
  70   my $odues;
  71   my $issues;
  72   my $resp;
  73 # until (($reason eq "Circ") || ($reason eq "Quit")) {
  74   until ($reason ne "") {
  75     ($reason,$item) =
  76       returnwindow($env,"Enter Returns",
  77       $item,\@items,$borrower,$amt_owing,$odues,$dbh,$resp); #C4::Circulation
  78     #debug_msg($env,"item = $item");
  79     #if (($reason ne "Circ") && ($reason ne "Quit")) {
  80     if ($reason eq "")  {
  81       $resp = "";
  82       ($resp,$bornum,$borrower,$itemno,$itemrec,$amt_owing) =
  83          checkissue($env,$dbh,$item);
  84       if ($bornum ne "") {
  85          ($issues,$odues,$amt_owing) = borrdata2($env,$bornum);
  86       } else {
  87         $issues = "";
  88         $odues = "";
  89         $amt_owing = "";
  90       }
  91       if ($resp ne "") {
  92         #if ($resp eq "Returned") {
  93         if ($itemno ne "" ) {
  94           my $item = getbibliofromitemnumber($env,$dbh,$itemno);
  95           # FIXME - This relies on C4::Circulation::Main to have a
  96           # "use C4::Circulation::Issues;" line, which is bogus.
  97           my $fmtitem = C4::Circulation::Issues::formatitem($env,$item,"",$amt_owing);
  98           unshift @items,$fmtitem;
  99           if ($items[20] > "") {
 100             pop @items;
 101           }
 102         }
 103         #} elsif ($resp ne "") {
 104         #  error_msg($env,"$resp");
 105         #}
 106         #if ($resp ne "Returned") {
 107         #  error_msg($env,"$resp");
 108         #  $bornum = "";
 109         #}
 110       }
 111     }
 112   }
 113 #  clearscreen;
 114   return($reason);
 115   }
 116
 117 # FIXME - Only used in &Returns and in telnet/doreturns.pl, both of
 118 # which appear obsolete. Presumably this function is obsolete as well.
 119 # Otherwise, it needs a POD.
 120 sub checkissue {
 121   my ($env,$dbh, $item) = @_;
 122   my $reason='Circ';
 123   my $bornum;
 124   my $borrower;
 125   my $itemno;
 126   my $itemrec;
 127   my $amt_owing;
 128   $item = uc $item;
 129   my $sth=$dbh->prepare("select * from items,biblio
 130     where barcode = ?
 131     and (biblio.biblionumber=items.biblionumber)");
 132   $sth->execute($item);
 133   if ($itemrec=$sth->fetchrow_hashref) {
 134      $sth->finish;
 135      $itemno = $itemrec->{'itemnumber'};
 136      my $sth=$dbh->prepare("select * from issues
 137        where (itemnumber=?)
 138        and (returndate is null)");
 139      $sth->execute($itemrec->{'itemnumber'});
 140      if (my $issuerec=$sth->fetchrow_hashref) {
 141        $sth->finish;
 142        my $sth= $dbh->prepare("select * from borrowers where
 143        (borrowernumber = ?)");
 144        $sth->execute($issuerec->{'borrowernumber'});
 145        $env->{'bornum'}=$issuerec->{'borrowernumber'};
 146        $borrower = $sth->fetchrow_hashref;
 147        $bornum = $issuerec->{'borrowernumber'};
 148        $itemno = $issuerec->{'itemnumber'};
 149        $amt_owing = returnrecord($env,$dbh,$bornum,$itemno);
 150        $reason = "Returned";
 151      } else {
 152        $sth->finish;
 153        updatelastseen($env,$dbh,$itemrec->{'itemnumber'});
 154        $reason = "Item not issued";
 155      }
 156      my ($resfound,$resrec) = find_reserves($env,$dbh,$itemrec->{'itemnumber'});
 157      if ($resfound eq "y") {
 158        my $btsh = $dbh->prepare("select * from borrowers
 159           where borrowernumber = ?");
 160        $btsh->execute($resrec->{'borrowernumber'});
 161        my $resborrower = $btsh->fetchrow_hashref;
 162        #printreserve($env,$resrec,$resborrower,$itemrec);
 163        my $mess = "Reserved for collection at branch $resrec->{'branchcode'}";
 164        C4::InterfaceCDK::error_msg($env,$mess);
 165        $btsh->finish;
 166      }
 167    } else {
 168      $sth->finish;
 169      $reason = "Item not found";
 170   }
 171   return ($reason,$bornum,$borrower,$itemno,$itemrec,$amt_owing);
 172   # end checkissue
 173   }
 174
 175 # FIXME - Only used in &C4::Circulation::Main::previousissue,
 176 # &checkissue, C4/Circulation.pm, and tkperl/tkcirc, all of which
 177 # appear to be obsolete. Presumably this function is obsolete as well.
 178 # Otherwise, it needs a POD.
 179 sub returnrecord {
 180   # mark items as returned
 181   my ($env,$dbh,$bornum,$itemno)=@_;
 182   #my $amt_owing = calc_odues($env,$dbh,$bornum,$itemno);
 183   my @datearr = localtime(time);
 184   my $dateret = (1900+$datearr[5])."-".$datearr[4]."-".$datearr[3];
 185   my $sth = $dbh->prepare("update issues set returndate = now(), branchcode = ? where
 186     (borrowernumber = ?) and (itemnumber = ?)
 187     and (returndate is null)");
 188   $sth->execute($env->{'branchcode'},$bornum,$itemno);
 189   $sth->finish;
 190   updatelastseen($env,$dbh,$itemno);
 191   # check for overdue fine
 192   my $oduecharge;
 193   my $sth = $dbh->prepare("select * from accountlines
 194     where (borrowernumber = ?)
 195     and (itemnumber = ?)
 196     and (accounttype = 'FU' or accounttype='O')");
 197     $sth->execute($bornum,$itemno);
 198     if (my $data = $sth->fetchrow_hashref) {
 199        # alter fine to show that the book has been returned.
 200        my $usth = $dbh->prepare("update accountlines
 201          set accounttype = 'F'
 202          where (borrowernumber = ?)
 203          and (itemnumber = ?)
 204          and (accountno = ?) ");
 205        $usth->execute($bornum,$itemno,$data->{'accountno'});
 206        $usth->finish();
 207        $oduecharge = $data->{'amountoutstanding'};
 208     }
 209     $sth->finish;
 210   # check for charge made for lost book
 211   my $sth = $dbh->prepare("select * from accountlines
 212     where (borrowernumber = ?)
 213     and (itemnumber = ?)
 214     and (accounttype = 'L')");
 215   $sth->execute($bornum,$itemno);
 216   if (my $data = $sth->fetchrow_hashref) {
 217     # writeoff this amount
 218     my $offset;
 219     my $amount = $data->{'amount'};
 220     my $acctno = $data->{'accountno'};
 221     my $amountleft;
 222     if ($data->{'amountoutstanding'} == $amount) {
 223        $offset = $data->{'amount'};
 224        $amountleft = 0;
 225     } else {
 226        $offset = $amount - $data->{'amountoutstanding'};
 227        $amountleft = $data->{'amountoutstanding'} - $amount;
 228     }
 229     my $usth = $dbh->prepare("update accountlines
 230       set accounttype = 'LR',amountoutstanding='0'
 231       where (borrowernumber = ?)
 232       and (itemnumber = ?)
 233       and (accountno = ?) ");
 234     $usth->execute($bornum,$itemno,$acctno);
 235     $usth->finish;
 236     my $nextaccntno = C4::Accounts::getnextacctno($env,$bornum,$dbh);
 237     $usth = $dbh->prepare("insert into accountlines
 238       (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
 239       values (?,?,now(),?,'Book Returned','CR',?)");
 240     $usth->execute($bornum,$nextaccntno,0-$amount,$amountleft);
 241     $usth->finish;
 242     $uquery = "insert into accountoffsets
 243       (borrowernumber, accountno, offsetaccount,  offsetamount)
 244       values (?,?,?,?)";
 245     $usth = $dbh->prepare("");
 246     $usth->execute($bornum,$data->{'accountno'},$nextaccntno,$offset);
 247     $usth->finish;
 248   }
 249   $sth->finish;
 250   UpdateStats($env,'branch','return','0','',$itemno);
 251   return($oduecharge);
 252 }
 253
 254 # FIXME - Only used in tkperl/tkcirc. Presumably this function is
 255 # obsolete.
 256 # Otherwise, it needs a POD.
 257 sub calc_odues {
 258   # calculate overdue fees
 259   my ($env,$dbh,$bornum,$itemno)=@_;
 260   my $amt_owing;
 261   return($amt_owing);
 262 }
 263
 264 # This function is only used in &checkissue and &returnrecord, both of
 265 # which appear to be obsolete. So presumably this function is obsolete
 266 # too.
 267 # Otherwise, it needs a POD.
 268 sub updatelastseen {
 269   my ($env,$dbh,$itemnumber)= @_;
 270   my $br = $env->{'branchcode'};
 271   my $sth = $dbh->prepare("update items
 272     set datelastseen = now(), holdingbranch = ?
 273     where (itemnumber = ?)");
 274   $sth->execute($br,$itemnumber);
 275   $sth->finish;
 276
 277 }
 278
 279
 280 # FIXME - There's also a &C4::Circulation::Circ2::find_reserves, but
 281 # that one looks rather different.
 282 # FIXME - This is only used in &checkissue, which appears to be
 283 # obsolete. So presumably this function is obsolete too.
 284 sub find_reserves {
 285   my ($env,$dbh,$itemno) = @_;
 286   my $itemdata = getbibliofromitemnumber($env,$dbh,$itemno);
 287   my $sth = $dbh->prepare("select * from reserves where found is null
 288   and biblionumber = ? and cancellationdate is NULL
 289   order by priority,reservedate ");
 290   $sth->execute($itemdata->{'biblionumber'};
 291   my $resfound = "n";
 292   my $resrec;
 293   while (($resrec=$sth->fetchrow_hashref) && ($resfound eq "n")) {
 294     if ($resrec->{'found'} eq "W") {
 295       if ($resrec->{'itemnumber'} eq $itemno) {
 296         $resfound = "y";
 297       }
 298     } elsif ($resrec->{'constrainttype'} eq "a") {
 299       $resfound = "y";
 300     } else {
 301       my $consth = $dbh->prepare("select * from reserveconstraints where borrowernumber = ? and reservedate = ? and biblionumber = ? and biblioitemnumber = ?");
 302       $consth->execute($resrec->{'borrowernumber'},$resrec->{'reservedate'},$resrec->{'biblionumber'},$itemdata->{'biblioitemnumber'});
 303       if (my $conrec=$consth->fetchrow_hashref) {
 304         if ($resrec->{'constrainttype'} eq "o") {
 305            $resfound = "y";
 306          }
 307       } else {
 308         if ($resrec->{'constrainttype'} eq "e") {
 309           $resfound = "y";
 310         }
 311       }
 312       $consth->finish;
 313     }
 314     if ($resfound eq "y") {
 315       my $updsth = $dbh->prepare("update reserves
 316         set found = 'W',itemnumber = ?
 317         where borrowernumber = ?
 318         and reservedate = ?
 319         and biblionumber = ?");
 320       $updsth->execute($itemno,$resrec->{'borrowernumber'},$resrec->{'reservedate'},$resrec->{'biblionumber'});
 321       $updsth->finish;
 322       my $itbr = $resrec->{'branchcode'};
 323       if ($resrec->{'branchcode'} ne $env->{'branchcode'}) {
 324         my $updsth = $dbh->prepare("update items
 325           set holdingbranch = 'TR'
 326           where itemnumber = ?");
 327         $updsth->execute($itemno);
 328         $updsth->finish;
 329       }
 330     }
 331   }
 332   $sth->finish;
 333   return ($resfound,$resrec);
 334 }