1 package C4::Circulation::Issues; #asummes C4/Circulation/Issues
3 #package to deal with Issues
4 #written 3/11/99 by chris@katipo.co.nz
7 # Copyright 2000-2002 Katipo Communications
9 # This file is part of Koha.
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
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.
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
30 use C4::Circulation::Main;
31 use C4::Circulation::Borrower;
37 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
39 # set the version for version checking
43 @EXPORT = qw(&Issue &formatitem);
44 %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
46 # your exported package globals go here,
47 # as well as any optionally exported functions
49 @EXPORT_OK = qw($Var1 %Hashit);
52 # non-exported package globals go here
53 use vars qw(@more $stuff);
55 # initalize package globals, first exported ones
60 # then the others (which are still accessible as $Some::Module::stuff)
64 # all file-scoped lexicals must be created before
65 # the functions below that use them.
67 # file-private lexicals go here
71 # here's a file-private function as a closure,
72 # callable as &$priv_func; it cannot be prototyped.
77 # make all your functions, whether exported or not;
87 my ($items,$items2,$amountdue);
89 $env->{'sysarea'} = "Issues";
91 while ($done eq "Issues") {
92 my ($bornum,$issuesallowed,$borrower,$reason,$amountdue) = &findborrower($env,$dbh);
93 #C4::Circulation::Borrowers
94 $env->{'loanlength'}="";
97 } elsif ($env->{'IssuesAllowed'} eq '0') {
98 error_msg($env,"No Issues Allowed =$env->{'IssuesAllowed'}");
100 $env->{'bornum'} = $bornum;
101 $env->{'bcard'} = $borrower->{'cardnumber'};
102 #deal with alternative loans
105 C4::Circulation::Main::pastitems($env,$bornum,$dbh); #from Circulation.pm
108 while ($done eq 'No'){
109 ($done,$items2,$it2p,$amountdue,$itemsdet) =
110 &processitems($env,$bornum,$borrower,$items,
111 $items2,$it2p,$amountdue,$itemsdet);
117 Cdk::refreshCdkScreen();
123 #process a users items
124 my ($env,$bornum,$borrower,$items,$items2,$it2p,$amountdue,$itemsdet,$odues)=@_;
126 $env->{'newborrower'} = "";
127 my ($itemnum,$reason) =
128 issuewindow($env,'Issues',$dbh,$items,$items2,$borrower,fmtdec($env,$amountdue,"32"));
130 $reason = "Finished user";
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;
141 $amountdue += $charge;
145 #check to see if more books to process for this user
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);
156 } elsif ($reason eq "Print"){
157 remoteprint($env,$itemsdet,$borrower);
158 @done = ("No",$items2,$it2p);
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);
168 #debug_msg($env, "return from issues $done[0]");
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'};
181 $iclass = $iclass.$dewey.$item->{'subclass'};
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");
191 my ($env,$dbh,$itemnum,$bornum,$items)=@_;
192 $itemnum=uc $itemnum;
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) ";
200 my $datedue = $env->{'loanlength'};
201 my $sth=$dbh->prepare($query);
203 if ($item=$sth->fetchrow_hashref) {
205 #check if item is restricted
206 if ($item->{'notforloan'} == 1) {
207 error_msg($env,"Item Not for Loan");
209 } elsif ($item->{'wthdrawn'} == 1) {
210 error_msg($env,"Item Withdrawn");
212 # } elsif ($item->{'itemlost'} == 1) {
213 # error_msg($env,"Item Lost");
215 } elsif ($item->{'restricted'} == 1 ){
216 error_msg($env,"Restricted Item");
217 #check borrowers status to take out restricted items
218 # if borrower allowed {
223 } elsif ($item->{'itemtype'} eq 'REF'){
224 error_msg($env,"Item Not for Loan");
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") {
233 } elsif ($issuestat eq "R") {
236 $charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
238 createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
240 &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$item->{'itemnumber'},$item->{'itemtype'});
243 if ($canissue == 1) {
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
250 where reservedate = '$resrec->{'reservedate'}'
251 and borrowernumber = '$resrec->{'borrowernumber'}'
252 and biblionumber = '$resrec->{'biblionumber'}'";
253 my $rsth = $dbh->prepare($rquery);
256 } elsif ($resbor ne "") {
257 my $bquery = "select * from borrowers
258 where borrowernumber = '$resbor'";
259 my $btsh = $dbh->prepare($bquery);
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?");
267 printreserve($env,$resrec,$resborrower,$item);
270 my $ans = msg_ny($env,"Cancel reserve?");
272 my $rquery = "update reserves
274 where reservedate = '$resrec->{'reservedate'}'
275 and borrowernumber = '$resrec->{'borrowernumber'}'
276 and biblionumber = '$resrec->{'biblionumber'}'";
277 my $rsth = $dbh->prepare($rquery);
285 #if charge deal with it
287 if ($canissue == 1) {
288 $charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
290 if ($canissue == 1) {
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'});
296 createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
298 } elsif ($canissue == 0) {
299 info_msg($env,"Can't issue $item->{'cardnumber'}");
302 my $valid = checkdigit($env,$itemnum);
304 if (substr($itemnum,0,1) = "V") {
306 $env->{'newborrower'} = $itemnum;
308 error_msg($env,"$itemnum not found - rescan");
311 error_msg($env,"Invalid Number");
315 #debug_msg($env,"date $datedue");
316 return($item,$charge,$datedue);
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);
335 my ($env,$itemno,$bitno,$dbh,$bornum)=@_;
337 my $query="Select * from biblioitems,itemtypes
338 where (biblioitems.biblioitemnumber='$bitno')
339 and (biblioitems.itemtype = itemtypes.itemtype)";
340 my $sth=$dbh->prepare($query);
342 if (my $data=$sth->fetchrow_hashref) {
343 $loanlength = $data->{'loanlength'}
347 if ($env->{'loanlength'} eq "") {
349 my $datedue = time + ($loanlength * 86400);
350 my @datearr = localtime($datedue);
351 $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
353 $dateduef = $env->{'loanlength'};
355 $query = "Insert into issues (borrowernumber,itemnumber, date_due,branchcode)
356 values ($bornum,$itemno,'$dateduef','$env->{'branchcode'}')";
357 my $sth=$dbh->prepare($query);
360 $query = "Select * from items where itemnumber=$itemno";
361 $sth=$dbh->prepare($query);
363 my $item=$sth->fetchrow_hashref;
366 $query="Update items set issues=$item->{'issues'} where itemnumber=$itemno";
367 $sth=$dbh->prepare($query);
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");
378 # calculate charges due
379 my ($env, $dbh, $itemno, $bornum)=@_;
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);
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);
397 if (my $data2=$sth2->fetchrow_hashref) {
398 my $discount = $data2->{'rentaldiscount'};
399 $charge = ($charge *(100 - $discount)) / 100;
407 END { } # module clean-up code here (global destructor)