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 .= $dewey.$item->{'subclass'};
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");
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 .= " $resborrower->{'initials'} $resborrower->{'surname'}";
288 my $ans = msg_ny($env,$msgtxt,"Allow issue?");
291 printreserve($env,$resrec,$resborrower,$item);
294 my $ans = msg_ny($env,"Cancel reserve?");
296 my $rquery = "update reserves
298 where reservedate = '$resrec->{'reservedate'}'
299 and borrowernumber = '$resrec->{'borrowernumber'}'
300 and biblionumber = '$resrec->{'biblionumber'}'";
301 my $rsth = $dbh->prepare($rquery);
309 #if charge deal with it
311 if ($canissue == 1) {
312 $charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
314 if ($canissue == 1) {
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'});
320 createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
322 } elsif ($canissue == 0) {
323 info_msg($env,"Can't issue $item->{'cardnumber'}");
326 my $valid = checkdigit($env,$itemnum, 1);
328 if (substr($itemnum,0,1) = "V") {
330 $env->{'newborrower'} = $itemnum;
332 error_msg($env,"$itemnum not found - rescan");
335 error_msg($env,"Invalid Number");
339 #debug_msg($env,"date $datedue");
340 return($item,$charge,$datedue);
343 # FIXME - A virtually identical function appears in
344 # C4::Circulation::Circ2. Pick one and stick with it.
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);
358 # Only used internally
361 my ($env,$itemno,$bitno,$dbh,$bornum)=@_;
363 my $query="Select * from biblioitems,itemtypes
364 where (biblioitems.biblioitemnumber='$bitno')
365 and (biblioitems.itemtype = itemtypes.itemtype)";
366 my $sth=$dbh->prepare($query);
368 if (my $data=$sth->fetchrow_hashref) {
369 $loanlength = $data->{'loanlength'}
373 if ($env->{'loanlength'} eq "") {
375 my $datedue = time + ($loanlength * 86400);
376 my @datearr = localtime($datedue);
377 $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
379 $dateduef = $env->{'loanlength'};
381 $query = "Insert into issues (borrowernumber,itemnumber, date_due,branchcode)
382 values ($bornum,$itemno,'$dateduef','$env->{'branchcode'}')";
383 my $sth=$dbh->prepare($query);
386 $query = "Select * from items where itemnumber=$itemno";
387 $sth=$dbh->prepare($query);
389 my $item=$sth->fetchrow_hashref;
392 $query="Update items set issues=$item->{'issues'} where itemnumber=$itemno";
393 $sth=$dbh->prepare($query);
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");
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.
408 # Only used internally
410 # calculate charges due
411 my ($env, $dbh, $itemno, $bornum)=@_;
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);
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);
429 if (my $data2=$sth2->fetchrow_hashref) {
430 my $discount = $data2->{'rentaldiscount'};
431 $charge = ($charge *(100 - $discount)) / 100;
433 $sth2->{'finish'}; # FIXME - Was this supposed to be $sth2->finish ?
446 Koha Developement team <info@koha.org>