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::Accounts;
  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::Search;
  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 = itemnodata($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 $query = "select * from items,biblio
 129     where barcode = '$item'
 130     and (biblio.biblionumber=items.biblionumber)";
 131   my $sth=$dbh->prepare($query);
 132   $sth->execute;
 133   if ($itemrec=$sth->fetchrow_hashref) {
 134      $sth->finish;
 135      $itemno = $itemrec->{'itemnumber'};
 136      $query = "select * from issues
 137        where (itemnumber='$itemrec->{'itemnumber'}')
 138        and (returndate is null)";
 139      my $sth=$dbh->prepare($query);
 140      $sth->execute;
 141      if (my $issuerec=$sth->fetchrow_hashref) {
 142        $sth->finish;
 143        $query = "select * from borrowers where
 144        (borrowernumber = '$issuerec->{'borrowernumber'}')";
 145        my $sth= $dbh->prepare($query);
 146        $sth->execute;
 147        $env->{'bornum'}=$issuerec->{'borrowernumber'};
 148        $borrower = $sth->fetchrow_hashref;
 149        $bornum = $issuerec->{'borrowernumber'};
 150        $itemno = $issuerec->{'itemnumber'};
 151        $amt_owing = returnrecord($env,$dbh,$bornum,$itemno);
 152        $reason = "Returned";
 153      } else {
 154        $sth->finish;
 155        updatelastseen($env,$dbh,$itemrec->{'itemnumber'});
 156        $reason = "Item not issued";
 157      }
 158      my ($resfound,$resrec) = find_reserves($env,$dbh,$itemrec->{'itemnumber'});
 159      if ($resfound eq "y") {
 160        my $bquery = "select * from borrowers
 161           where borrowernumber = '$resrec->{'borrowernumber'}'";
 162        my $btsh = $dbh->prepare($bquery);
 163        $btsh->execute;
 164        my $resborrower = $btsh->fetchrow_hashref;
 165        #printreserve($env,$resrec,$resborrower,$itemrec);
 166        my $mess = "Reserved for collection at branch $resrec->{'branchcode'}";
 167        C4::InterfaceCDK::error_msg($env,$mess);
 168        $btsh->finish;
 169      }
 170    } else {
 171      $sth->finish;
 172      $reason = "Item not found";
 173   }
 174   return ($reason,$bornum,$borrower,$itemno,$itemrec,$amt_owing);
 175   # end checkissue
 176   }
 177
 178 # FIXME - Only used in &C4::Circulation::Main::previousissue,
 179 # &checkissue, C4/Circulation.pm, and tkperl/tkcirc, all of which
 180 # appear to be obsolete. Presumably this function is obsolete as well.
 181 # Otherwise, it needs a POD.
 182 sub returnrecord {
 183   # mark items as returned
 184   my ($env,$dbh,$bornum,$itemno)=@_;
 185   #my $amt_owing = calc_odues($env,$dbh,$bornum,$itemno);
 186   my @datearr = localtime(time);
 187   my $dateret = (1900+$datearr[5])."-".$datearr[4]."-".$datearr[3];
 188   my $query = "update issues set returndate = now(), branchcode ='$env->{'branchcode'}' where
 189     (borrowernumber = '$bornum') and (itemnumber = '$itemno')
 190     and (returndate is null)";
 191   my $sth = $dbh->prepare($query);
 192   $sth->execute;
 193   $sth->finish;
 194   updatelastseen($env,$dbh,$itemno);
 195   # check for overdue fine
 196   my $oduecharge;
 197   my $query = "select * from accountlines
 198     where (borrowernumber = '$bornum')
 199     and (itemnumber = '$itemno')
 200     and (accounttype = 'FU' or accounttype='O')";
 201   my $sth = $dbh->prepare($query);
 202     $sth->execute;
 203     if (my $data = $sth->fetchrow_hashref) {
 204        # alter fine to show that the book has been returned.
 205        my $uquery = "update accountlines
 206          set accounttype = 'F'
 207          where (borrowernumber = '$bornum')
 208          and (itemnumber = '$itemno')
 209          and (accountno = '$data->{'accountno'}') ";
 210        my $usth = $dbh->prepare($uquery);
 211        $usth->execute();
 212        $usth->finish();
 213        $oduecharge = $data->{'amountoutstanding'};
 214     }
 215     $sth->finish;
 216   # check for charge made for lost book
 217   my $query = "select * from accountlines
 218     where (borrowernumber = '$bornum')
 219     and (itemnumber = '$itemno')
 220     and (accounttype = 'L')";
 221   my $sth = $dbh->prepare($query);
 222   $sth->execute;
 223   if (my $data = $sth->fetchrow_hashref) {
 224     # writeoff this amount
 225     my $offset;
 226     my $amount = $data->{'amount'};
 227     my $acctno = $data->{'accountno'};
 228     my $amountleft;
 229     if ($data->{'amountoutstanding'} == $amount) {
 230        $offset = $data->{'amount'};
 231        $amountleft = 0;
 232     } else {
 233        $offset = $amount - $data->{'amountoutstanding'};
 234        $amountleft = $data->{'amountoutstanding'} - $amount;
 235     }
 236     my $uquery = "update accountlines
 237       set accounttype = 'LR',amountoutstanding='0'
 238       where (borrowernumber = '$bornum')
 239       and (itemnumber = '$itemno')
 240       and (accountno = '$acctno') ";
 241     my $usth = $dbh->prepare($uquery);
 242     $usth->execute();
 243     $usth->finish;
 244     my $nextaccntno = C4::Accounts::getnextacctno($env,$bornum,$dbh);
 245     $uquery = "insert into accountlines
 246       (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
 247       values ($bornum,$nextaccntno,now(),0-$amount,'Book Returned',
 248       'CR',$amountleft)";
 249     $usth = $dbh->prepare($uquery);
 250     $usth->execute;
 251     $usth->finish;
 252     $uquery = "insert into accountoffsets
 253       (borrowernumber, accountno, offsetaccount,  offsetamount)
 254       values ($bornum,$data->{'accountno'},$nextaccntno,$offset)";
 255     $usth = $dbh->prepare($uquery);
 256     $usth->execute;
 257     $usth->finish;
 258   }
 259   $sth->finish;
 260   UpdateStats($env,'branch','return','0','',$itemno);
 261   return($oduecharge);
 262 }
 263
 264 # FIXME - Only used in tkperl/tkcirc. Presumably this function is
 265 # obsolete.
 266 # Otherwise, it needs a POD.
 267 sub calc_odues {
 268   # calculate overdue fees
 269   my ($env,$dbh,$bornum,$itemno)=@_;
 270   my $amt_owing;
 271   return($amt_owing);
 272 }
 273
 274 # This function is only used in &checkissue and &returnrecord, both of
 275 # which appear to be obsolete. So presumably this function is obsolete
 276 # too.
 277 # Otherwise, it needs a POD.
 278 sub updatelastseen {
 279   my ($env,$dbh,$itemnumber)= @_;
 280   my $br = $env->{'branchcode'};
 281   my $query = "update items
 282     set datelastseen = now(), holdingbranch = '$br'
 283     where (itemnumber = '$itemnumber')";
 284   my $sth = $dbh->prepare($query);
 285   $sth->execute;
 286   $sth->finish;
 287
 288 }
 289
 290
 291 # FIXME - There's also a &C4::Circulation::Circ2::find_reserves, but
 292 # that one looks rather different.
 293 # FIXME - This is only used in &checkissue, which appears to be
 294 # obsolete. So presumably this function is obsolete too.
 295 sub find_reserves {
 296   my ($env,$dbh,$itemno) = @_;
 297   my $itemdata = itemnodata($env,$dbh,$itemno);
 298   my $query = "select * from reserves where found is null
 299   and biblionumber = $itemdata->{'biblionumber'} and cancellationdate is NULL
 300   order by priority,reservedate ";
 301   my $sth = $dbh->prepare($query);
 302   $sth->execute;
 303   my $resfound = "n";
 304   my $resrec;
 305   while (($resrec=$sth->fetchrow_hashref) && ($resfound eq "n")) {
 306     if ($resrec->{'found'} eq "W") {
 307       if ($resrec->{'itemnumber'} eq $itemno) {
 308         $resfound = "y";
 309       }
 310     } elsif ($resrec->{'constrainttype'} eq "a") {
 311       $resfound = "y";
 312     } else {
 313       my $conquery = "select * from reserveconstraints where borrowernumber
 314 = $resrec->{'borrowernumber'} and reservedate = '$resrec->{'reservedate'}' and biblionumber = $resrec->{'biblionumber'} and biblioitemnumber = $itemdata->{'biblioitemnumber'}";
 315       my $consth = $dbh->prepare($conquery);
 316       $consth->execute;
 317       if (my $conrec=$consth->fetchrow_hashref) {
 318         if ($resrec->{'constrainttype'} eq "o") {
 319            $resfound = "y";
 320          }
 321       } else {
 322         if ($resrec->{'constrainttype'} eq "e") {
 323           $resfound = "y";
 324         }
 325       }
 326       $consth->finish;
 327     }
 328     if ($resfound eq "y") {
 329       my $updquery = "update reserves
 330         set found = 'W',itemnumber='$itemno'
 331         where borrowernumber = $resrec->{'borrowernumber'}
 332         and reservedate = '$resrec->{'reservedate'}'
 333         and biblionumber = $resrec->{'biblionumber'}";
 334       my $updsth = $dbh->prepare($updquery);
 335       $updsth->execute;
 336       $updsth->finish;
 337       my $itbr = $resrec->{'branchcode'};
 338       if ($resrec->{'branchcode'} ne $env->{'branchcode'}) {
 339          my $updquery = "update items
 340           set holdingbranch = 'TR'
 341           where itemnumber = $itemno";
 342         my $updsth = $dbh->prepare($updquery);
 343         $updsth->execute;
 344         $updsth->finish;
 345       }
 346     }
 347   }
 348   $sth->finish;
 349   return ($resfound,$resrec);
 350 }