C4/Circulation/Issues.pm

   1 package C4::Circulation::Issues; #asummes C4/Circulation/Issues
   2
   3 #package to deal with Issues
   4 #written 3/11/99 by chris@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::Issues
  32         # use each other, so functions get redefined.
  33 use C4::Circulation::Borrower;
  34         # FIXME - C4::Circulation::Issues and C4::Circulation::Borrower
  35         # use each other, so functions get redefined.
  36 use C4::Scan;
  37 use C4::Stats;
  38 use C4::Print;
  39 use C4::Format;
  40 use C4::Input;
  41 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  42
  43 # set the version for version checking
  44 $VERSION = 0.01;
  45
  46 @ISA = qw(Exporter);
  47 @EXPORT = qw(&Issue &formatitem);
  48 %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
  49
  50 # your exported package globals go here,
  51 # as well as any optionally exported functions
  52
  53 @EXPORT_OK   = qw($Var1 %Hashit);
  54
  55
  56 # non-exported package globals go here
  57 use vars qw(@more $stuff);
  58
  59 # initalize package globals, first exported ones
  60
  61 my $Var1   = '';
  62 my %Hashit = ();
  63
  64 # then the others (which are still accessible as $Some::Module::stuff)
  65 my $stuff  = '';
  66 my @more   = ();
  67
  68 # all file-scoped lexicals must be created before
  69 # the functions below that use them.
  70
  71 # file-private lexicals go here
  72 my $priv_var    = '';
  73 my %secret_hash = ();
  74
  75 # here's a file-private function as a closure,
  76 # callable as &$priv_func;  it cannot be prototyped.
  77 my $priv_func = sub {
  78   # stuff goes here.
  79 };
  80
  81 # make all your functions, whether exported or not;
  82
  83
  84 sub Issue  {
  85    my ($env) = @_;
  86    my $dbh = C4::Context->dbh;
  87    #clear help
  88    helptext('');
  89    #clearscreen();
  90    my $done;
  91    my ($items,$items2,$amountdue);
  92    my $itemsdet;
  93    $env->{'sysarea'} = "Issues";
  94    $done = "Issues";
  95    while ($done eq "Issues") {
  96      my ($bornum,$issuesallowed,$borrower,$reason,$amountdue) = &findborrower($env,$dbh);
  97      #C4::Circulation::Borrowers
  98      $env->{'loanlength'}="";
  99      if ($reason ne "") {
 100        $done = $reason;
 101      } elsif ($env->{'IssuesAllowed'} eq '0') {
 102        error_msg($env,"No Issues Allowed =$env->{'IssuesAllowed'}");
 103      } else {
 104        $env->{'bornum'} = $bornum;
 105        $env->{'bcard'}  = $borrower->{'cardnumber'};
 106        #deal with alternative loans
 107        #now check items
 108        ($items,$items2)=
 109        C4::Circulation::Main::pastitems($env,$bornum,$dbh); #from Circulation.pm
 110        $done = "No";
 111        my $it2p=0;
 112        while ($done eq 'No'){
 113          ($done,$items2,$it2p,$amountdue,$itemsdet) =
 114             &processitems($env,$bornum,$borrower,$items,
 115             $items2,$it2p,$amountdue,$itemsdet);
 116        }
 117      #&endint($env);
 118      }
 119    }
 120    Cdk::refreshCdkScreen();
 121    return ($done);
 122 }
 123
 124
 125 sub processitems {
 126   #process a users items
 127    my ($env,$bornum,$borrower,$items,$items2,$it2p,$amountdue,$itemsdet,$odues)=@_;
 128    my $dbh = C4::Context->dbh;
 129    $env->{'newborrower'} = "";
 130    my ($itemnum,$reason) =
 131      issuewindow($env,'Issues',$dbh,$items,$items2,$borrower,fmtdec($env,$amountdue,"32"));
 132    if ($itemnum eq ""){
 133      $reason = "Finished user";
 134    } else {
 135      my ($item,$charge,$datedue) = &issueitem($env,$dbh,$itemnum,$bornum,$items);
 136      if ($datedue ne "") {
 137        my $line = formatitem($env,$item,$datedue,$charge);
 138        unshift @$items2,$line;
 139        #$items2->[$it2p] = $line;
 140        $item->{'date_due'} = $datedue;
 141        $item->{'charge'} = $charge;
 142        $itemsdet->[$it2p] = $item;
 143        $it2p++;
 144        $amountdue += $charge;
 145      }
 146    }
 147    #check to see if more books to process for this user
 148    my @done;
 149    if ($env->{'newborrower'} ne "") {$reason = "Finished user";}
 150    if ($reason eq 'Finished user'){
 151      if (@$items2[0] ne "") {
 152        remoteprint($env,$itemsdet,$borrower);
 153        if ($amountdue > 0) {
 154          &reconcileaccount($env,$dbh,$borrower->{'borrowernumber'},$amountdue);
 155        }
 156      }
 157      @done = ("Issues");
 158    } elsif ($reason eq "Print"){
 159      remoteprint($env,$itemsdet,$borrower);
 160      @done = ("No",$items2,$it2p);
 161    } else {
 162      if ($reason ne 'Finished issues'){
 163        #return No to let them know that we wish to
 164        # process more Items for borrower
 165        @done = ("No",$items2,$it2p,$amountdue,$itemsdet);
 166      } else  {
 167        @done = ("Circ");
 168      }
 169    }
 170    #debug_msg($env, "return from issues $done[0]");
 171    return @done;
 172 }
 173
 174 sub formatitem {
 175    my ($env,$item,$datedue,$charge) = @_;
 176    my $line = $datedue." ".$item->{'barcode'}." ".$item->{'title'}.": ".$item->{'author'};
 177    my $iclass =  $item->{'itemtype'};
 178    if ($item->{'dewey'} > 0) {
 179      my $dewey = $item->{'dewey'};
 180      $dewey =~ s/0*$//;
 181      $dewey =~ s/\.$//;
 182      $iclass = $iclass.$dewey.$item->{'subclass'};
 183    };
 184    my $llen = 65 - length($iclass);
 185    my $line = fmtstr($env,$line,"L".$llen);
 186    my $line = $line." $iclass ";
 187    my $line = $line.fmtdec($env,$charge,"22");
 188    return $line;
 189 }
 190
 191 sub issueitem{
 192    my ($env,$dbh,$itemnum,$bornum,$items)=@_;
 193    $itemnum=uc $itemnum;
 194    my $canissue = 1;
 195    ##  my ($itemnum,$reason)=&scanbook();
 196    my $query="Select * from items,biblio,biblioitems where (barcode='$itemnum') and
 197       (items.biblionumber=biblio.biblionumber) and
 198       (items.biblioitemnumber=biblioitems.biblioitemnumber) ";
 199    my $item;
 200    my $charge;
 201    my $datedue = $env->{'loanlength'};
 202    my $sth=$dbh->prepare($query);
 203    $sth->execute;
 204    if ($item=$sth->fetchrow_hashref) {
 205      $sth->finish;
 206      #check if item is restricted
 207      if ($item->{'notforloan'} == 1) {
 208        error_msg($env,"Item Not for Loan");
 209        $canissue = 0;
 210      } elsif ($item->{'wthdrawn'} == 1) {
 211        error_msg($env,"Item Withdrawn");
 212        $canissue = 0;
 213 #     } elsif ($item->{'itemlost'} == 1) {
 214 #       error_msg($env,"Item Lost");
 215 #       $canissue = 0;
 216      } elsif ($item->{'restricted'} == 1 ){
 217        error_msg($env,"Restricted Item");
 218        #check borrowers status to take out restricted items
 219        # if borrower allowed {
 220        #  $canissue = 1
 221        # } else {
 222        $canissue = 0;
 223        # }
 224      } elsif ($item->{'itemtype'} eq 'REF'){
 225        error_msg($env,"Item Not for Loan");
 226        $canissue=0;
 227      }
 228      #check if item is on issue already
 229      if ($canissue == 1) {
 230        my ($currbor,$issuestat,$newdate) =
 231          &C4::Circulation::Main::previousissue($env,$item->{'itemnumber'},$dbh,$bornum);
 232        if ($issuestat eq "N") {
 233          $canissue = 0;
 234        } elsif ($issuestat eq "R") {
 235          $canissue = -1;
 236          $datedue = $newdate;
 237          $charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
 238          if ($charge > 0) {
 239            createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
 240          }
 241          &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$item->{'itemnumber'},$item->{'itemtype'});
 242        }
 243      }
 244      if ($canissue == 1) {
 245        #check reserve
 246        my ($resbor,$resrec) =  &C4::Circulation::Main::checkreserve($env,$dbh,$item->{'itemnumber'});
 247        #debug_msg($env,$resbor);
 248        if ($resbor eq $bornum) {
 249          my $rquery = "update reserves
 250            set found = 'F'
 251            where reservedate = '$resrec->{'reservedate'}'
 252            and borrowernumber = '$resrec->{'borrowernumber'}'
 253            and biblionumber = '$resrec->{'biblionumber'}'";
 254          my $rsth = $dbh->prepare($rquery);
 255          $rsth->execute;
 256          $rsth->finish;
 257        } elsif ($resbor ne "") {
 258          my $bquery = "select * from borrowers
 259             where borrowernumber = '$resbor'";
 260          my $btsh = $dbh->prepare($bquery);
 261          $btsh->execute;
 262          my $resborrower = $btsh->fetchrow_hashref;
 263          my $msgtxt = chr(7)."Res for $resborrower->{'cardnumber'},";
 264          $msgtxt = $msgtxt." $resborrower->{'initials'} $resborrower->{'surname'}";
 265          my $ans = msg_ny($env,$msgtxt,"Allow issue?");
 266          if ($ans eq "N") {
 267             # print a docket;
 268             printreserve($env,$resrec,$resborrower,$item);
 269             $canissue = 0;
 270          } else {
 271            my $ans = msg_ny($env,"Cancel reserve?");
 272            if ($ans eq "Y") {
 273              my $rquery = "update reserves
 274                set found = 'F'
 275                where reservedate = '$resrec->{'reservedate'}'
 276                and borrowernumber = '$resrec->{'borrowernumber'}'
 277                and biblionumber = '$resrec->{'biblionumber'}'";
 278              my $rsth = $dbh->prepare($rquery);
 279              $rsth->execute;
 280              $rsth->finish;
 281            }
 282          }
 283          $btsh->finish();
 284        };
 285      }
 286      #if charge deal with it
 287
 288      if ($canissue == 1) {
 289        $charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
 290      }
 291      if ($canissue == 1) {
 292        #now mark as issued
 293        $datedue=&updateissues($env,$item->{'itemnumber'},$item->{'biblioitemnumber'},$dbh,$bornum);
 294        #debug_msg("","date $datedue");
 295        &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$item->{'itemnumber'},$item->{'itemtype'});
 296        if ($charge > 0) {
 297          createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
 298        }
 299      } elsif ($canissue == 0) {
 300        info_msg($env,"Can't issue $item->{'cardnumber'}");
 301      }
 302    } else {
 303      my $valid = checkdigit($env,$itemnum);
 304      if ($valid ==1) {
 305        if (substr($itemnum,0,1) = "V") {
 306          #this is a borrower
 307          $env->{'newborrower'} = $itemnum;
 308        } else {
 309          error_msg($env,"$itemnum not found - rescan");
 310        }
 311      } else {
 312        error_msg($env,"Invalid Number");
 313      }
 314    }
 315    $sth->finish;
 316    #debug_msg($env,"date $datedue");
 317    return($item,$charge,$datedue);
 318 }
 319
 320 sub createcharge {
 321   my ($env,$dbh,$itemno,$bornum,$charge) = @_;
 322   my $nextaccntno = getnextacctno($env,$bornum,$dbh);
 323   my $query = "insert into accountlines
 324      (borrowernumber,itemnumber,accountno,date,amount,
 325      description,accounttype,amountoutstanding)
 326      values ($bornum,$itemno,$nextaccntno,now(),$charge,'Rental','Rent',$charge)";
 327   my $sth = $dbh->prepare($query);
 328   $sth->execute;
 329   $sth->finish;
 330 }
 331
 332
 333
 334 sub updateissues{
 335   # issue the book
 336   my ($env,$itemno,$bitno,$dbh,$bornum)=@_;
 337   my $loanlength=21;
 338   my $query="Select *  from biblioitems,itemtypes
 339   where (biblioitems.biblioitemnumber='$bitno')
 340   and (biblioitems.itemtype = itemtypes.itemtype)";
 341   my $sth=$dbh->prepare($query);
 342   $sth->execute;
 343   if (my $data=$sth->fetchrow_hashref) {
 344     $loanlength = $data->{'loanlength'}
 345   }
 346   $sth->finish;
 347   my $dateduef;
 348   if ($env->{'loanlength'} eq "") {
 349     my $ti = time;
 350     my $datedue = time + ($loanlength * 86400);
 351     my @datearr = localtime($datedue);
 352     $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
 353   } else {
 354     $dateduef = $env->{'loanlength'};
 355   }
 356   $query = "Insert into issues (borrowernumber,itemnumber, date_due,branchcode)
 357   values ($bornum,$itemno,'$dateduef','$env->{'branchcode'}')";
 358   my $sth=$dbh->prepare($query);
 359   $sth->execute;
 360   $sth->finish;
 361   $query = "Select * from items where itemnumber=$itemno";
 362   $sth=$dbh->prepare($query);
 363   $sth->execute;
 364   my $item=$sth->fetchrow_hashref;
 365   $sth->finish;
 366   $item->{'issues'}++;
 367   $query="Update items set issues=$item->{'issues'} where itemnumber=$itemno";
 368   $sth=$dbh->prepare($query);
 369   $sth->execute;
 370   $sth->finish;
 371   #my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($datedue);
 372   my @datearr = split('-',$dateduef);
 373   my $dateret = join('-',$datearr[2],$datearr[1],$datearr[0]);
 374 #  debug_msg($env,"query $query");
 375   return($dateret);
 376 }
 377
 378 # FIXME - This is very similar to
 379 # &C4::Circulation::Renewals2::calc_charges and
 380 # &C4::Circulation::Circ2::calc_charges.
 381 # Pick one and stick with it.
 382 sub calc_charges {
 383   # calculate charges due
 384   my ($env, $dbh, $itemno, $bornum)=@_;
 385   my $charge=0;
 386   my $item_type;
 387   my $q1 = "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes
 388     where (items.itemnumber ='$itemno')
 389     and (biblioitems.biblioitemnumber = items.biblioitemnumber)
 390     and (biblioitems.itemtype = itemtypes.itemtype)";
 391   my $sth1= $dbh->prepare($q1);
 392   $sth1->execute;
 393   if (my $data1=$sth1->fetchrow_hashref) {
 394      $item_type = $data1->{'itemtype'};
 395      $charge = $data1->{'rentalcharge'};
 396      my $q2 = "select rentaldiscount from borrowers,categoryitem
 397         where (borrowers.borrowernumber = '$bornum')
 398         and (borrowers.categorycode = categoryitem.categorycode)
 399         and (categoryitem.itemtype = '$item_type')";
 400      my $sth2=$dbh->prepare($q2);
 401      $sth2->execute;
 402      if (my $data2=$sth2->fetchrow_hashref) {
 403         my $discount = $data2->{'rentaldiscount'};
 404         $charge = ($charge *(100 - $discount)) / 100;
 405      }
 406      $sth2->{'finish'}; # FIXME - Was this supposed to be $sth2->finish ?
 407   }
 408   $sth1->finish;
 409   return ($charge);
 410 }
 411
 412 END { }       # module clean-up code here (global destructor)