1 package C4::Circulation::Issues;
5 #package to deal with Issues
6 #written 3/11/99 by chris@katipo.co.nz
8 # Copyright 2000-2002 Katipo Communications
10 # This file is part of Koha.
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
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.
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
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.
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.
45 use vars qw($VERSION @ISA @EXPORT);
47 # set the version for version checking
52 C4::Circulation::Issues - Miscellaneous functions related to Koha issues
56 use C4::Circulation::Issues;
60 This module provides a function for pretty-printing an item being
71 @EXPORT = qw(&Issue &formatitem);
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.
78 my $dbh = C4::Context->dbh;
83 my ($items,$items2,$amountdue);
85 $env->{'sysarea'} = "Issues";
87 while ($done eq "Issues") {
88 my ($bornum,$issuesallowed,$borrower,$reason,$amountdue) = &findborrower($env,$dbh);
89 #C4::Circulation::Borrowers
90 $env->{'loanlength'}="";
93 } elsif ($env->{'IssuesAllowed'} eq '0') {
94 error_msg($env,"No Issues Allowed =$env->{'IssuesAllowed'}");
96 $env->{'bornum'} = $bornum;
97 $env->{'bcard'} = $borrower->{'cardnumber'};
98 #deal with alternative loans
101 C4::Circulation::Main::pastitems($env,$bornum,$dbh); #from Circulation.pm
104 while ($done eq 'No'){
105 ($done,$items2,$it2p,$amountdue,$itemsdet) =
106 &processitems($env,$bornum,$borrower,$items,
107 $items2,$it2p,$amountdue,$itemsdet);
112 Cdk::refreshCdkScreen();
116 # FIXME - Not exported, but called by "telnet/borrwraper.pl".
117 # Presumably this function is obsolete.
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"));
126 $reason = "Finished user";
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;
137 $amountdue += $charge;
140 #check to see if more books to process for this user
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);
151 } elsif ($reason eq "Print"){
152 remoteprint($env,$itemsdet,$borrower);
153 @done = ("No",$items2,$it2p);
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);
163 #debug_msg($env, "return from issues $done[0]");
169 $line = &formatitem($env, $item, $datedue, $charge);
171 Pretty-prints a description of an item being issued, and returns the
172 pretty-printed string.
174 C<$env> is effectively ignored.
176 C<$item> is a reference-to-hash whose keys are fields from the items
177 table in the Koha database.
179 C<$datedue> is a string that will be prepended to the output.
181 C<$charge> is a number that will be appended to the output.
183 The return value C<$line> is a string of the form
185 I<$datedue $barcode $title: $author $type$dewey$subclass $charge>
187 where those values that are not passed in as arguments are obtained
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'};
202 $iclass = $iclass.$dewey.$item->{'subclass'}; # FIXME - .=
204 my $llen = 65 - length($iclass);
205 my $line = fmtstr($env,$line,"L".$llen);
206 # FIXME - Use sprintf() instead of &fmtstr.
207 my $line = $line." $iclass "; # FIXME - .=
208 my $line = $line.fmtdec($env,$charge,"22"); # FIXME - .=
212 # Only used internally
213 # FIXME - Only used by &processitems, which appears to be obsolete.
215 my ($env,$dbh,$itemnum,$bornum,$items)=@_;
216 $itemnum=uc $itemnum;
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) ";
224 my $datedue = $env->{'loanlength'};
225 my $sth=$dbh->prepare($query);
227 if ($item=$sth->fetchrow_hashref) {
229 #check if item is restricted
230 if ($item->{'notforloan'} == 1) {
231 error_msg($env,"Item Not for Loan");
233 } elsif ($item->{'wthdrawn'} == 1) {
234 error_msg($env,"Item Withdrawn");
236 # } elsif ($item->{'itemlost'} == 1) {
237 # error_msg($env,"Item Lost");
239 } elsif ($item->{'restricted'} == 1 ){
240 error_msg($env,"Restricted Item");
241 #check borrowers status to take out restricted items
242 # if borrower allowed {
247 } elsif ($item->{'itemtype'} eq 'REF'){
248 error_msg($env,"Item Not for Loan");
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") {
257 } elsif ($issuestat eq "R") {
260 $charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
262 createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
264 &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$item->{'itemnumber'},$item->{'itemtype'});
267 if ($canissue == 1) {
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
274 where reservedate = '$resrec->{'reservedate'}'
275 and borrowernumber = '$resrec->{'borrowernumber'}'
276 and biblionumber = '$resrec->{'biblionumber'}'";
277 my $rsth = $dbh->prepare($rquery);
280 } elsif ($resbor ne "") {
281 my $bquery = "select * from borrowers
282 where borrowernumber = '$resbor'";
283 my $btsh = $dbh->prepare($bquery);
285 my $resborrower = $btsh->fetchrow_hashref;
286 my $msgtxt = chr(7)."Res for $resborrower->{'cardnumber'},";
287 $msgtxt = $msgtxt." $resborrower->{'initials'} $resborrower->{'surname'}";
289 my $ans = msg_ny($env,$msgtxt,"Allow issue?");
292 printreserve($env,$resrec,$resborrower,$item);
295 my $ans = msg_ny($env,"Cancel reserve?");
297 my $rquery = "update reserves
299 where reservedate = '$resrec->{'reservedate'}'
300 and borrowernumber = '$resrec->{'borrowernumber'}'
301 and biblionumber = '$resrec->{'biblionumber'}'";
302 my $rsth = $dbh->prepare($rquery);
310 #if charge deal with it
312 if ($canissue == 1) {
313 $charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
315 if ($canissue == 1) {
317 $datedue=&updateissues($env,$item->{'itemnumber'},$item->{'biblioitemnumber'},$dbh,$bornum);
318 #debug_msg("","date $datedue");
319 &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$item->{'itemnumber'},$item->{'itemtype'});
321 createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
323 } elsif ($canissue == 0) {
324 info_msg($env,"Can't issue $item->{'cardnumber'}");
327 my $valid = checkdigit($env,$itemnum);
329 if (substr($itemnum,0,1) = "V") {
331 $env->{'newborrower'} = $itemnum;
333 error_msg($env,"$itemnum not found - rescan");
336 error_msg($env,"Invalid Number");
340 #debug_msg($env,"date $datedue");
341 return($item,$charge,$datedue);
344 # FIXME - A virtually identical function appears in
345 # C4::Circulation::Circ2. Pick one and stick with it.
347 my ($env,$dbh,$itemno,$bornum,$charge) = @_;
348 my $nextaccntno = getnextacctno($env,$bornum,$dbh);
349 my $query = "insert into accountlines
350 (borrowernumber,itemnumber,accountno,date,amount,
351 description,accounttype,amountoutstanding)
352 values ($bornum,$itemno,$nextaccntno,now(),$charge,'Rental','Rent',$charge)";
353 my $sth = $dbh->prepare($query);
359 # Only used internally
362 my ($env,$itemno,$bitno,$dbh,$bornum)=@_;
364 my $query="Select * from biblioitems,itemtypes
365 where (biblioitems.biblioitemnumber='$bitno')
366 and (biblioitems.itemtype = itemtypes.itemtype)";
367 my $sth=$dbh->prepare($query);
369 if (my $data=$sth->fetchrow_hashref) {
370 $loanlength = $data->{'loanlength'}
374 if ($env->{'loanlength'} eq "") {
376 my $datedue = time + ($loanlength * 86400);
377 my @datearr = localtime($datedue);
378 $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
380 $dateduef = $env->{'loanlength'};
382 $query = "Insert into issues (borrowernumber,itemnumber, date_due,branchcode)
383 values ($bornum,$itemno,'$dateduef','$env->{'branchcode'}')";
384 my $sth=$dbh->prepare($query);
387 $query = "Select * from items where itemnumber=$itemno";
388 $sth=$dbh->prepare($query);
390 my $item=$sth->fetchrow_hashref;
393 $query="Update items set issues=$item->{'issues'} where itemnumber=$itemno";
394 $sth=$dbh->prepare($query);
397 #my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($datedue);
398 my @datearr = split('-',$dateduef);
399 my $dateret = join('-',$datearr[2],$datearr[1],$datearr[0]);
400 # debug_msg($env,"query $query");
404 # FIXME - This is very similar to
405 # &C4::Circulation::Renewals2::calc_charges and
406 # &C4::Circulation::Circ2::calc_charges.
407 # Pick one and stick with it.
409 # Only used internally
411 # calculate charges due
412 my ($env, $dbh, $itemno, $bornum)=@_;
415 my $q1 = "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes
416 where (items.itemnumber ='$itemno')
417 and (biblioitems.biblioitemnumber = items.biblioitemnumber)
418 and (biblioitems.itemtype = itemtypes.itemtype)";
419 my $sth1= $dbh->prepare($q1);
421 if (my $data1=$sth1->fetchrow_hashref) {
422 $item_type = $data1->{'itemtype'};
423 $charge = $data1->{'rentalcharge'};
424 my $q2 = "select rentaldiscount from borrowers,categoryitem
425 where (borrowers.borrowernumber = '$bornum')
426 and (borrowers.categorycode = categoryitem.categorycode)
427 and (categoryitem.itemtype = '$item_type')";
428 my $sth2=$dbh->prepare($q2);
430 if (my $data2=$sth2->fetchrow_hashref) {
431 my $discount = $data2->{'rentaldiscount'};
432 $charge = ($charge *(100 - $discount)) / 100;
434 $sth2->{'finish'}; # FIXME - Was this supposed to be $sth2->finish ?
447 Koha Developement team <info@koha.org>