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