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 $item;
 220    my $charge;
 221    my $datedue = $env->{'loanlength'};
 222    my $sth=$dbh->prepare("Select * from items,biblio,biblioitems where (barcode=?) and
 223       (items.biblionumber=biblio.biblionumber) and
 224       (items.biblioitemnumber=biblioitems.biblioitemnumber) ");
 225    $sth->execute($itemnum);
 226    if ($item=$sth->fetchrow_hashref) {
 227      $sth->finish;
 228      #check if item is restricted
 229      if ($item->{'notforloan'} == 1) {
 230        error_msg($env,"Item Not for Loan");
 231        $canissue = 0;
 232      } elsif ($item->{'wthdrawn'} == 1) {
 233        error_msg($env,"Item Withdrawn");
 234        $canissue = 0;
 235 #     } elsif ($item->{'itemlost'} == 1) {
 236 #       error_msg($env,"Item Lost");
 237 #       $canissue = 0;
 238      } elsif ($item->{'restricted'} == 1 ){
 239        error_msg($env,"Restricted Item");
 240        #check borrowers status to take out restricted items
 241        # if borrower allowed {
 242        #  $canissue = 1
 243        # } else {
 244        $canissue = 0;
 245        # }
 246      } elsif ($item->{'itemtype'} eq 'REF'){
 247        error_msg($env,"Item Not for Loan");
 248        $canissue=0;
 249      }
 250      #check if item is on issue already
 251      if ($canissue == 1) {
 252        my ($currbor,$issuestat,$newdate) =
 253          &C4::Circulation::Main::previousissue($env,$item->{'itemnumber'},$dbh,$bornum);
 254        if ($issuestat eq "N") {
 255          $canissue = 0;
 256        } elsif ($issuestat eq "R") {
 257          $canissue = -1;
 258          $datedue = $newdate;
 259          $charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
 260          if ($charge > 0) {
 261            createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
 262          }
 263          &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$item->{'itemnumber'},$item->{'itemtype'});
 264        }
 265      }
 266      if ($canissue == 1) {
 267        #check reserve
 268        my ($resbor,$resrec) =  &C4::Circulation::Main::checkreserve($env,$dbh,$item->{'itemnumber'});
 269        #debug_msg($env,$resbor);
 270        if ($resbor eq $bornum) {
 271          my $rsth = $dbh->prepare("update reserves
 272            set found = 'F'
 273            where reservedate = ?
 274            and borrowernumber = ?
 275            and biblionumber = ?");
 276          $rsth->execute($resrec->{'reservedate'},$resrec->{'borrowernumber'},$resrec->{'biblionumber'});
 277          $rsth->finish;
 278        } elsif ($resbor ne "") {
 279          my $btsh = $dbh->prepare("select * from borrowers where borrowernumber = ?");
 280          $btsh->execute($resbor);
 281          my $resborrower = $btsh->fetchrow_hashref;
 282          my $msgtxt = chr(7)."Res for $resborrower->{'cardnumber'},";
 283          $msgtxt .= " $resborrower->{'initials'} $resborrower->{'surname'}";
 284          my $ans = msg_ny($env,$msgtxt,"Allow issue?");
 285          if ($ans eq "N") {
 286             # print a docket;
 287             printreserve($env,$resrec,$resborrower,$item);
 288             $canissue = 0;
 289          } else {
 290            my $ans = msg_ny($env,"Cancel reserve?");
 291            if ($ans eq "Y") {
 292                         my $rsth = $dbh->prepare("update reserves
 293                set found = 'F'
 294                where reservedate = ?
 295                and borrowernumber = ?
 296                and biblionumber = ?");
 297                         $rsth->execute($resrec->{'reservedate'},$resrec->{'borrowernumber'},$resrec->{'biblionumber'});
 298                         $rsth->finish;
 299                 }
 300          }
 301          $btsh->finish();
 302        };
 303      }
 304      #if charge deal with it
 305
 306      if ($canissue == 1) {
 307        $charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
 308      }
 309      if ($canissue == 1) {
 310        #now mark as issued
 311        $datedue=&updateissues($env,$item->{'itemnumber'},$item->{'biblioitemnumber'},$dbh,$bornum);
 312        #debug_msg("","date $datedue");
 313        &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$item->{'itemnumber'},$item->{'itemtype'});
 314        if ($charge > 0) {
 315          createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
 316        }
 317      } elsif ($canissue == 0) {
 318        info_msg($env,"Can't issue $item->{'cardnumber'}");
 319      }
 320    } else {
 321      my $valid = checkdigit($env,$itemnum, 1);
 322      if ($valid ==1) {
 323        if (substr($itemnum,0,1) = "V") {
 324          #this is a borrower
 325          $env->{'newborrower'} = $itemnum;
 326        } else {
 327          error_msg($env,"$itemnum not found - rescan");
 328        }
 329      } else {
 330        error_msg($env,"Invalid Number");
 331      }
 332    }
 333    $sth->finish;
 334    #debug_msg($env,"date $datedue");
 335    return($item,$charge,$datedue);
 336 }
 337
 338 # FIXME - A virtually identical function appears in
 339 # C4::Circulation::Circ2. Pick one and stick with it.
 340 sub createcharge {
 341   my ($env,$dbh,$itemno,$bornum,$charge) = @_;
 342   my $nextaccntno = getnextacctno($env,$bornum,$dbh);
 343   my $sth = $dbh->prepare("insert into accountlines
 344      (borrowernumber,itemnumber,accountno,date,amount,
 345      description,accounttype,amountoutstanding)
 346      values (?,?,?,now(),?,'Rental','Rent',?)");
 347   $sth->execute($bornum,$itemno,$nextaccntno,$charge,$charge);
 348   $sth->finish;
 349 }
 350
 351
 352 # Only used internally
 353 sub updateissues{
 354   # issue the book
 355   my ($env,$itemno,$bitno,$dbh,$bornum)=@_;
 356   my $loanlength=21;
 357   my $sth=$dbh->prepare("Select *  from biblioitems,itemtypes
 358   where (biblioitems.biblioitemnumber=?)
 359   and (biblioitems.itemtype = itemtypes.itemtype)");
 360   $sth->execute($bitno);
 361   if (my $data=$sth->fetchrow_hashref) {
 362     $loanlength = $data->{'loanlength'}
 363   }
 364   $sth->finish;
 365   my $dateduef;
 366   if ($env->{'loanlength'} eq "") {
 367     my $ti = time;
 368     my $datedue = time + ($loanlength * 86400);
 369     my @datearr = localtime($datedue);
 370     $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
 371   } else {
 372     $dateduef = $env->{'loanlength'};
 373   }
 374   #FIXME: what is going on above? Replaces with MySQL function or strftime?
 375   my $sth=$dbh->prepare("Insert into issues (borrowernumber,itemnumber, date_due,branchcode)
 376   values (?,?,?,?)");
 377   $sth->execute($bornum,$itemno,$dateduef,$env->{'branchcode'});
 378   $sth->finish;
 379   $sth=$dbh->prepare("Select * from items where itemnumber=?");
 380   $sth->execute($itemno);
 381   my $item=$sth->fetchrow_hashref;
 382   $sth->finish;
 383   $item->{'issues'}++;
 384   $sth=$dbh->prepare("Update items set issues=? where itemnumber=?");
 385   $sth->execute($item->{'issues'},$itemno);
 386   $sth->finish;
 387   #my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($datedue);
 388   my @datearr = split('-',$dateduef);
 389   my $dateret = join('-',$datearr[2],$datearr[1],$datearr[0]);
 390 #  debug_msg($env,"query $query");
 391   return($dateret);
 392 }
 393
 394 # FIXME - This is very similar to
 395 # &C4::Circulation::Renewals2::calc_charges and
 396 # &C4::Circulation::Circ2::calc_charges.
 397 # Pick one and stick with it.
 398
 399 # Only used internally
 400 sub calc_charges {
 401   # calculate charges due
 402   my ($env, $dbh, $itemno, $bornum)=@_;
 403   my $charge=0;
 404   my $item_type;
 405   my $sth1= $dbh->prepare("select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes
 406     where (items.itemnumber =?)
 407     and (biblioitems.biblioitemnumber = items.biblioitemnumber)
 408     and (biblioitems.itemtype = itemtypes.itemtype)");
 409   $sth1->execute($itemno);
 410   if (my $data1=$sth1->fetchrow_hashref) {
 411      $item_type = $data1->{'itemtype'};
 412      $charge = $data1->{'rentalcharge'};
 413      my $sth2=$dbh->prepare("select rentaldiscount from borrowers,categoryitem
 414         where (borrowers.borrowernumber = ?)
 415         and (borrowers.categorycode = categoryitem.categorycode)
 416         and (categoryitem.itemtype = ?)");
 417      $sth2->execute($bornum,$item_type);
 418      if (my $data2=$sth2->fetchrow_hashref) {
 419         my $discount = $data2->{'rentaldiscount'};
 420         $charge = ($charge *(100 - $discount)) / 100;
 421      }
 422      $sth2->finish;
 423   }
 424   $sth1->finish;
 425   return ($charge);
 426 }
 427
 428 1;
 429 __END__
 430
 431 =back
 432
 433 =head1 AUTHOR
 434
 435 Koha Developement team <info@koha.org>
 436
 437 =cut