C4/Circulation/Issues.pm

   1 package C4::Circulation::Issues;
   2
   3 # $Id$
   4
   5 #package to deal with Issues
   6 #written 3/11/99 by chris@katipo.co.nz
   7
   8 # Copyright 2000-2002 Katipo Communications
   9 #
  10 # This file is part of Koha.
  11 #
  12 # Koha is free software; you can redistribute it and/or modify it under the
  13 # terms of the GNU General Public License as published by the Free Software
  14 # Foundation; either version 2 of the License, or (at your option) any later
  15 # version.
  16 #
  17 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  18 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  19 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  20 #
  21 # You should have received a copy of the GNU General Public License along with
  22 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  23 # Suite 330, Boston, MA  02111-1307 USA
  24
  25 # FIXME - AFAICT the only function here that's still being used is
  26 # &formatitem, and I'm not convinced that it's really being used.
  27
  28 use strict;
  29 require Exporter;
  30 use DBI;
  31 use C4::Context;
  32 use C4::Accounts;
  33 use C4::InterfaceCDK;
  34 use C4::Circulation::Main;
  35         # FIXME - C4::Circulation::Main and C4::Circulation::Issues
  36         # use each other, so functions get redefined.
  37 use C4::Circulation::Borrower;
  38         # FIXME - C4::Circulation::Issues and C4::Circulation::Borrower
  39         # use each other, so functions get redefined.
  40 use C4::Scan;
  41 use C4::Stats;
  42 use C4::Print;
  43 use C4::Format;
  44 use C4::Input;
  45 use vars qw($VERSION @ISA @EXPORT);
  46
  47 # set the version for version checking
  48 $VERSION = 0.01;
  49
  50 =head1 NAME
  51
  52 C4::Circulation::Issues - Miscellaneous functions related to Koha issues
  53
  54 =head1 SYNOPSIS
  55
  56   use C4::Circulation::Issues;
  57
  58 =head1 DESCRIPTION
  59
  60 This module provides a function for pretty-printing an item being
  61 issued.
  62
  63 =head1 FUNCTIONS
  64
  65 =over 2
  66
  67 =cut
  68 #'
  69
  70 @ISA = qw(Exporter);
  71 @EXPORT = qw(&Issue &formatitem);
  72
  73 # FIXME - This is only used in C4::Circmain and C4::Circulation, both
  74 # of which look obsolete. Is this function obsolete as well?
  75 # If not, this needs a POD.
  76 sub Issue  {
  77    my ($env) = @_;
  78    my $dbh = C4::Context->dbh;
  79    #clear help
  80    helptext('');
  81    #clearscreen();
  82    my $done;
  83    my ($items,$items2,$amountdue);
  84    my $itemsdet;
  85    $env->{'sysarea'} = "Issues";
  86    $done = "Issues";
  87    while ($done eq "Issues") {
  88      my ($bornum,$issuesallowed,$borrower,$reason,$amountdue) = &findborrower($env,$dbh);
  89      #C4::Circulation::Borrowers
  90      $env->{'loanlength'}="";
  91      if ($reason ne "") {
  92        $done = $reason;
  93      } elsif ($env->{'IssuesAllowed'} eq '0') {
  94        error_msg($env,"No Issues Allowed =$env->{'IssuesAllowed'}");
  95      } else {
  96        $env->{'bornum'} = $bornum;
  97        $env->{'bcard'}  = $borrower->{'cardnumber'};
  98        #deal with alternative loans
  99        #now check items
 100        ($items,$items2)=
 101        C4::Circulation::Main::pastitems($env,$bornum,$dbh); #from Circulation.pm
 102        $done = "No";
 103        my $it2p=0;
 104        while ($done eq 'No'){
 105          ($done,$items2,$it2p,$amountdue,$itemsdet) =
 106             &processitems($env,$bornum,$borrower,$items,
 107             $items2,$it2p,$amountdue,$itemsdet);
 108        }
 109      #&endint($env);
 110      }
 111    }
 112    Cdk::refreshCdkScreen();
 113    return ($done);
 114 }
 115
 116 # FIXME - Not exported, but called by "telnet/borrwraper.pl".
 117 # Presumably this function is obsolete.
 118 sub processitems {
 119   #process a users items
 120    my ($env,$bornum,$borrower,$items,$items2,$it2p,$amountdue,$itemsdet,$odues)=@_;
 121    my $dbh = C4::Context->dbh;
 122    $env->{'newborrower'} = "";
 123    my ($itemnum,$reason) =
 124      issuewindow($env,'Issues',$dbh,$items,$items2,$borrower,fmtdec($env,$amountdue,"32"));
 125    if ($itemnum eq ""){
 126      $reason = "Finished user";
 127    } else {
 128      my ($item,$charge,$datedue) = &issueitem($env,$dbh,$itemnum,$bornum,$items);
 129      if ($datedue ne "") {
 130        my $line = formatitem($env,$item,$datedue,$charge);
 131        unshift @$items2,$line;
 132        #$items2->[$it2p] = $line;
 133        $item->{'date_due'} = $datedue;
 134        $item->{'charge'} = $charge;
 135        $itemsdet->[$it2p] = $item;
 136        $it2p++;
 137        $amountdue += $charge;
 138      }
 139    }
 140    #check to see if more books to process for this user
 141    my @done;
 142    if ($env->{'newborrower'} ne "") {$reason = "Finished user";}
 143    if ($reason eq 'Finished user'){
 144      if (@$items2[0] ne "") {
 145        remoteprint($env,$itemsdet,$borrower);
 146        if ($amountdue > 0) {
 147          &reconcileaccount($env,$dbh,$borrower->{'borrowernumber'},$amountdue);
 148        }
 149      }
 150      @done = ("Issues");
 151    } elsif ($reason eq "Print"){
 152      remoteprint($env,$itemsdet,$borrower);
 153      @done = ("No",$items2,$it2p);
 154    } else {
 155      if ($reason ne 'Finished issues'){
 156        #return No to let them know that we wish to
 157        # process more Items for borrower
 158        @done = ("No",$items2,$it2p,$amountdue,$itemsdet);
 159      } else  {
 160        @done = ("Circ");
 161      }
 162    }
 163    #debug_msg($env, "return from issues $done[0]");
 164    return @done;
 165 }
 166
 167 =item formatitem
 168
 169   $line = &formatitem($env, $item, $datedue, $charge);
 170
 171 Pretty-prints a description of an item being issued, and returns the
 172 pretty-printed string.
 173
 174 C<$env> is effectively ignored.
 175
 176 C<$item> is a reference-to-hash whose keys are fields from the items
 177 table in the Koha database.
 178
 179 C<$datedue> is a string that will be prepended to the output.
 180
 181 C<$charge> is a number that will be appended to the output.
 182
 183 The return value C<$line> is a string of the form
 184
 185 I<$datedue $barcode $title: $author $type$dewey$subclass $charge>
 186
 187 where those values that are not passed in as arguments are obtained
 188 from C<$item>.
 189
 190 =cut
 191 #'
 192 sub formatitem {
 193    my ($env,$item,$datedue,$charge) = @_;
 194    my $line = $datedue." ".$item->{'barcode'}." ".$item->{'title'}.": ".$item->{'author'};
 195         # FIXME - Use string interpolation or sprintf()
 196    my $iclass =  $item->{'itemtype'};
 197    # FIXME - The Dewey code is a string, not a number.
 198    if ($item->{'dewey'} > 0) {
 199      my $dewey = $item->{'dewey'};
 200      $dewey =~ s/0*$//;
 201      $dewey =~ s/\.$//;
 202      $iclass .= $dewey.$item->{'subclass'};
 203    };
 204    my $llen = 65 - length($iclass);
 205    my $line = fmtstr($env,$line,"L".$llen);
 206                 # FIXME - Use sprintf() instead of &fmtstr.
 207    my $line .= " $iclass ";
 208    my $line .= fmtdec($env,$charge,"22");
 209    return $line;
 210 }
 211
 212 # Only used internally
 213 # FIXME - Only used by &processitems, which appears to be obsolete.
 214 sub issueitem{
 215    my ($env,$dbh,$itemnum,$bornum,$items)=@_;
 216    $itemnum=uc $itemnum;
 217    my $canissue = 1;
 218    ##  my ($itemnum,$reason)=&scanbook();
 219    my $query="Select * from items,biblio,biblioitems where (barcode='$itemnum') and
 220       (items.biblionumber=biblio.biblionumber) and
 221       (items.biblioitemnumber=biblioitems.biblioitemnumber) ";
 222    my $item;
 223    my $charge;
 224    my $datedue = $env->{'loanlength'};
 225    my $sth=$dbh->prepare($query);
 226    $sth->execute;
 227    if ($item=$sth->fetchrow_hashref) {
 228      $sth->finish;
 229      #check if item is restricted
 230      if ($item->{'notforloan'} == 1) {
 231        error_msg($env,"Item Not for Loan");
 232        $canissue = 0;
 233      } elsif ($item->{'wthdrawn'} == 1) {
 234        error_msg($env,"Item Withdrawn");
 235        $canissue = 0;
 236 #     } elsif ($item->{'itemlost'} == 1) {
 237 #       error_msg($env,"Item Lost");
 238 #       $canissue = 0;
 239      } elsif ($item->{'restricted'} == 1 ){
 240        error_msg($env,"Restricted Item");
 241        #check borrowers status to take out restricted items
 242        # if borrower allowed {
 243        #  $canissue = 1
 244        # } else {
 245        $canissue = 0;
 246        # }
 247      } elsif ($item->{'itemtype'} eq 'REF'){
 248        error_msg($env,"Item Not for Loan");
 249        $canissue=0;
 250      }
 251      #check if item is on issue already
 252      if ($canissue == 1) {
 253        my ($currbor,$issuestat,$newdate) =
 254          &C4::Circulation::Main::previousissue($env,$item->{'itemnumber'},$dbh,$bornum);
 255        if ($issuestat eq "N") {
 256          $canissue = 0;
 257        } elsif ($issuestat eq "R") {
 258          $canissue = -1;
 259          $datedue = $newdate;
 260          $charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
 261          if ($charge > 0) {
 262            createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
 263          }
 264          &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$item->{'itemnumber'},$item->{'itemtype'});
 265        }
 266      }
 267      if ($canissue == 1) {
 268        #check reserve
 269        my ($resbor,$resrec) =  &C4::Circulation::Main::checkreserve($env,$dbh,$item->{'itemnumber'});
 270        #debug_msg($env,$resbor);
 271        if ($resbor eq $bornum) {
 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        } elsif ($resbor ne "") {
 281          my $bquery = "select * from borrowers
 282             where borrowernumber = '$resbor'";
 283          my $btsh = $dbh->prepare($bquery);
 284          $btsh->execute;
 285          my $resborrower = $btsh->fetchrow_hashref;
 286          my $msgtxt = chr(7)."Res for $resborrower->{'cardnumber'},";
 287          $msgtxt .= " $resborrower->{'initials'} $resborrower->{'surname'}";
 288          my $ans = msg_ny($env,$msgtxt,"Allow issue?");
 289          if ($ans eq "N") {
 290             # print a docket;
 291             printreserve($env,$resrec,$resborrower,$item);
 292             $canissue = 0;
 293          } else {
 294            my $ans = msg_ny($env,"Cancel reserve?");
 295            if ($ans eq "Y") {
 296              my $rquery = "update reserves
 297                set found = 'F'
 298                where reservedate = '$resrec->{'reservedate'}'
 299                and borrowernumber = '$resrec->{'borrowernumber'}'
 300                and biblionumber = '$resrec->{'biblionumber'}'";
 301              my $rsth = $dbh->prepare($rquery);
 302              $rsth->execute;
 303              $rsth->finish;
 304            }
 305          }
 306          $btsh->finish();
 307        };
 308      }
 309      #if charge deal with it
 310
 311      if ($canissue == 1) {
 312        $charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
 313      }
 314      if ($canissue == 1) {
 315        #now mark as issued
 316        $datedue=&updateissues($env,$item->{'itemnumber'},$item->{'biblioitemnumber'},$dbh,$bornum);
 317        #debug_msg("","date $datedue");
 318        &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$item->{'itemnumber'},$item->{'itemtype'});
 319        if ($charge > 0) {
 320          createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
 321        }
 322      } elsif ($canissue == 0) {
 323        info_msg($env,"Can't issue $item->{'cardnumber'}");
 324      }
 325    } else {
 326      my $valid = checkdigit($env,$itemnum);
 327      if ($valid ==1) {
 328        if (substr($itemnum,0,1) = "V") {
 329          #this is a borrower
 330          $env->{'newborrower'} = $itemnum;
 331        } else {
 332          error_msg($env,"$itemnum not found - rescan");
 333        }
 334      } else {
 335        error_msg($env,"Invalid Number");
 336      }
 337    }
 338    $sth->finish;
 339    #debug_msg($env,"date $datedue");
 340    return($item,$charge,$datedue);
 341 }
 342
 343 # FIXME - A virtually identical function appears in
 344 # C4::Circulation::Circ2. Pick one and stick with it.
 345 sub createcharge {
 346   my ($env,$dbh,$itemno,$bornum,$charge) = @_;
 347   my $nextaccntno = getnextacctno($env,$bornum,$dbh);
 348   my $query = "insert into accountlines
 349      (borrowernumber,itemnumber,accountno,date,amount,
 350      description,accounttype,amountoutstanding)
 351      values ($bornum,$itemno,$nextaccntno,now(),$charge,'Rental','Rent',$charge)";
 352   my $sth = $dbh->prepare($query);
 353   $sth->execute;
 354   $sth->finish;
 355 }
 356
 357
 358 # Only used internally
 359 sub updateissues{
 360   # issue the book
 361   my ($env,$itemno,$bitno,$dbh,$bornum)=@_;
 362   my $loanlength=21;
 363   my $query="Select *  from biblioitems,itemtypes
 364   where (biblioitems.biblioitemnumber='$bitno')
 365   and (biblioitems.itemtype = itemtypes.itemtype)";
 366   my $sth=$dbh->prepare($query);
 367   $sth->execute;
 368   if (my $data=$sth->fetchrow_hashref) {
 369     $loanlength = $data->{'loanlength'}
 370   }
 371   $sth->finish;
 372   my $dateduef;
 373   if ($env->{'loanlength'} eq "") {
 374     my $ti = time;
 375     my $datedue = time + ($loanlength * 86400);
 376     my @datearr = localtime($datedue);
 377     $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
 378   } else {
 379     $dateduef = $env->{'loanlength'};
 380   }
 381   $query = "Insert into issues (borrowernumber,itemnumber, date_due,branchcode)
 382   values ($bornum,$itemno,'$dateduef','$env->{'branchcode'}')";
 383   my $sth=$dbh->prepare($query);
 384   $sth->execute;
 385   $sth->finish;
 386   $query = "Select * from items where itemnumber=$itemno";
 387   $sth=$dbh->prepare($query);
 388   $sth->execute;
 389   my $item=$sth->fetchrow_hashref;
 390   $sth->finish;
 391   $item->{'issues'}++;
 392   $query="Update items set issues=$item->{'issues'} where itemnumber=$itemno";
 393   $sth=$dbh->prepare($query);
 394   $sth->execute;
 395   $sth->finish;
 396   #my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($datedue);
 397   my @datearr = split('-',$dateduef);
 398   my $dateret = join('-',$datearr[2],$datearr[1],$datearr[0]);
 399 #  debug_msg($env,"query $query");
 400   return($dateret);
 401 }
 402
 403 # FIXME - This is very similar to
 404 # &C4::Circulation::Renewals2::calc_charges and
 405 # &C4::Circulation::Circ2::calc_charges.
 406 # Pick one and stick with it.
 407
 408 # Only used internally
 409 sub calc_charges {
 410   # calculate charges due
 411   my ($env, $dbh, $itemno, $bornum)=@_;
 412   my $charge=0;
 413   my $item_type;
 414   my $q1 = "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes
 415     where (items.itemnumber ='$itemno')
 416     and (biblioitems.biblioitemnumber = items.biblioitemnumber)
 417     and (biblioitems.itemtype = itemtypes.itemtype)";
 418   my $sth1= $dbh->prepare($q1);
 419   $sth1->execute;
 420   if (my $data1=$sth1->fetchrow_hashref) {
 421      $item_type = $data1->{'itemtype'};
 422      $charge = $data1->{'rentalcharge'};
 423      my $q2 = "select rentaldiscount from borrowers,categoryitem
 424         where (borrowers.borrowernumber = '$bornum')
 425         and (borrowers.categorycode = categoryitem.categorycode)
 426         and (categoryitem.itemtype = '$item_type')";
 427      my $sth2=$dbh->prepare($q2);
 428      $sth2->execute;
 429      if (my $data2=$sth2->fetchrow_hashref) {
 430         my $discount = $data2->{'rentaldiscount'};
 431         $charge = ($charge *(100 - $discount)) / 100;
 432      }
 433      $sth2->{'finish'}; # FIXME - Was this supposed to be $sth2->finish ?
 434   }
 435   $sth1->finish;
 436   return ($charge);
 437 }
 438
 439 1;
 440 __END__
 441
 442 =back
 443
 444 =head1 AUTHOR
 445
 446 Koha Developement team <info@koha.org>
 447
 448 =cut