C4/Circulation/Returns.pm

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