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