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