Initial revision
[wip/koha-chris_n.git] / C4 / Circulation / Returns.pm
1 package C4::Circulation::Returns; #assumes C4/Circulation/Returns
2
3 #package to deal with Returns
4 #written 3/11/99 by olwen@katipo.co.nz
5
6 use strict;
7 require Exporter;
8 use DBI;
9 use C4::Database;
10 use C4::Accounts;
11 use C4::InterfaceCDK;
12 use C4::Circulation::Main;
13 use C4::Format;
14 use C4::Scan;
15 use C4::Stats;
16 use C4::Search;
17 use C4::Print;
18
19 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
20   
21 # set the version for version checking
22 $VERSION = 0.01;
23     
24 @ISA = qw(Exporter);
25 @EXPORT = qw(&returnrecord &calc_odues &Returns);
26 %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
27                   
28 # your exported package globals go here,
29 # as well as any optionally exported functions
30
31 @EXPORT_OK   = qw($Var1 %Hashit);
32
33
34 # non-exported package globals go here
35 use vars qw(@more $stuff);
36         
37 # initalize package globals, first exported ones
38
39 my $Var1   = '';
40 my %Hashit = ();
41                     
42 # then the others (which are still accessible as $Some::Module::stuff)
43 my $stuff  = '';
44 my @more   = ();
45         
46 # all file-scoped lexicals must be created before
47 # the functions below that use them.
48                 
49 # file-private lexicals go here
50 my $priv_var    = '';
51 my %secret_hash = ();
52                             
53 # here's a file-private function as a closure,
54 # callable as &$priv_func;  it cannot be prototyped.
55 my $priv_func = sub {
56   # stuff goes here.
57 };
58                                                     
59 # make all your functions, whether exported or not;
60
61 sub Returns {
62   my ($env)=@_;
63   my $dbh=&C4Connect;  
64   my @items;
65   @items[0]=" "x50;
66   my $reason;
67   my $item;
68   my $reason;
69   my $borrower;
70   my $itemno;
71   my $itemrec;
72   my $bornum;
73   my $amt_owing;
74   my $odues;
75   my $issues;
76   my $resp;
77 # until (($reason eq "Circ") || ($reason eq "Quit")) {
78   until ($reason ne "") {
79     ($reason,$item) =  
80       returnwindow($env,"Enter Returns",
81       $item,\@items,$borrower,$amt_owing,$odues,$dbh,$resp); #C4::Circulation
82     #debug_msg($env,"item = $item");
83     #if (($reason ne "Circ") && ($reason ne "Quit")) {
84     if ($reason eq "")  {
85       $resp = "";
86       ($resp,$bornum,$borrower,$itemno,$itemrec,$amt_owing) = 
87          checkissue($env,$dbh,$item);
88       if ($bornum ne "") {
89          ($issues,$odues,$amt_owing) = borrdata2($env,$bornum);
90       } else {
91         $issues = "";
92         $odues = "";
93         $amt_owing = "";
94       } 
95       if ($resp ne "") {
96         #if ($resp eq "Returned") {
97         if ($itemno ne "" ) {
98           my $item = itemnodata($env,$dbh,$itemno);
99           my $fmtitem = C4::Circulation::Issues::formatitem($env,$item,"",$amt_owing);
100           unshift @items,$fmtitem;
101           if ($items[20] > "") {
102             pop @items;
103           }  
104         }
105         #} elsif ($resp ne "") {
106         #  error_msg($env,"$resp");
107         #}
108         #if ($resp ne "Returned") {
109         #  error_msg($env,"$resp");
110         #  $bornum = ""; 
111         #}
112       }
113     }
114   }
115 #  clearscreen;
116   $dbh->disconnect;
117   return($reason);
118   }
119   
120 sub checkissue {
121   my ($env,$dbh, $item) = @_;
122   my $reason='Circ';
123   my $bornum;
124   my $borrower;
125   my $itemno;
126   my $itemrec;
127   my $amt_owing;
128   $item = uc $item;
129   my $query = "select * from items,biblio 
130     where barcode = '$item'
131     and (biblio.biblionumber=items.biblionumber)";
132   my $sth=$dbh->prepare($query); 
133   $sth->execute;
134   if ($itemrec=$sth->fetchrow_hashref) {
135      $sth->finish;
136      $itemno = $itemrec->{'itemnumber'};
137      $query = "select * from issues
138        where (itemnumber='$itemrec->{'itemnumber'}')
139        and (returndate is null)";
140      my $sth=$dbh->prepare($query);
141      $sth->execute;
142      if (my $issuerec=$sth->fetchrow_hashref) {
143        $sth->finish;
144        $query = "select * from borrowers where
145        (borrowernumber = '$issuerec->{'borrowernumber'}')";
146        my $sth= $dbh->prepare($query);
147        $sth->execute;
148        $env->{'bornum'}=$issuerec->{'borrowernumber'};
149        $borrower = $sth->fetchrow_hashref;
150        $bornum = $issuerec->{'borrowernumber'};
151        $itemno = $issuerec->{'itemnumber'};
152        $amt_owing = returnrecord($env,$dbh,$bornum,$itemno);     
153        $reason = "Returned";    
154      } else {
155        $sth->finish;
156        updatelastseen($env,$dbh,$itemrec->{'itemnumber'});
157        $reason = "Item not issued";
158      }
159      my ($resfound,$resrec) = find_reserves($env,$dbh,$itemrec->{'itemnumber'});
160      if ($resfound eq "y") {
161        my $bquery = "select * from borrowers 
162           where borrowernumber = '$resrec->{'borrowernumber'}'";
163        my $btsh = $dbh->prepare($bquery);
164        $btsh->execute;                   
165        my $resborrower = $btsh->fetchrow_hashref;
166        #printreserve($env,$resrec,$resborrower,$itemrec);
167        my $mess = "Reserved for collection at branch $resrec->{'branchcode'}"; 
168        C4::InterfaceCDK::error_msg($env,$mess);
169        $btsh->finish;
170      }  
171    } else {
172      $sth->finish;
173      $reason = "Item not found";
174   }   
175   return ($reason,$bornum,$borrower,$itemno,$itemrec,$amt_owing);
176   # end checkissue
177   }
178   
179 sub returnrecord {
180   # mark items as returned
181   my ($env,$dbh,$bornum,$itemno)=@_;
182   #my $amt_owing = calc_odues($env,$dbh,$bornum,$itemno);
183   my @datearr = localtime(time);
184   my $dateret = (1900+$datearr[5])."-".$datearr[4]."-".$datearr[3];
185   my $query = "update issues set returndate = now(), branchcode ='$env->{'branchcode'}' where 
186     (borrowernumber = '$bornum') and (itemnumber = '$itemno') 
187     and (returndate is null)";  
188   my $sth = $dbh->prepare($query);
189   $sth->execute;
190   $sth->finish;
191   updatelastseen($env,$dbh,$itemno);
192   # check for overdue fine
193   my $oduecharge;
194   my $query = "select * from accountlines
195     where (borrowernumber = '$bornum')
196     and (itemnumber = '$itemno')
197     and (accounttype = 'FU' or accounttype='O')";
198   my $sth = $dbh->prepare($query);
199     $sth->execute;
200     if (my $data = $sth->fetchrow_hashref) {
201        # alter fine to show that the book has been returned.
202        my $uquery = "update accountlines
203          set accounttype = 'F'
204          where (borrowernumber = '$bornum')
205          and (itemnumber = '$itemno')
206          and (accountno = '$data->{'accountno'}') ";
207        my $usth = $dbh->prepare($uquery);
208        $usth->execute();
209        $usth->finish();
210        $oduecharge = $data->{'amountoutstanding'};
211     }
212     $sth->finish;
213   # check for charge made for lost book
214   my $query = "select * from accountlines 
215     where (borrowernumber = '$bornum') 
216     and (itemnumber = '$itemno')
217     and (accounttype = 'L')";
218   my $sth = $dbh->prepare($query);
219   $sth->execute;
220   if (my $data = $sth->fetchrow_hashref) {
221     # writeoff this amount 
222     my $offset;
223     my $amount = $data->{'amount'};
224     my $acctno = $data->{'accountno'};
225     my $amountleft;
226     if ($data->{'amountoutstanding'} == $amount) {
227        $offset = $data->{'amount'};
228        $amountleft = 0;
229     } else {
230        $offset = $amount - $data->{'amountoutstanding'};
231        $amountleft = $data->{'amountoutstanding'} - $amount;
232     }
233     my $uquery = "update accountlines
234       set accounttype = 'LR',amountoutstanding='0'
235       where (borrowernumber = '$bornum')
236       and (itemnumber = '$itemno')
237       and (accountno = '$acctno') ";
238     my $usth = $dbh->prepare($uquery);
239     $usth->execute();
240     $usth->finish;
241     my $nextaccntno = C4::Accounts::getnextacctno($env,$bornum,$dbh);
242     $uquery = "insert into accountlines
243       (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
244       values ($bornum,$nextaccntno,now(),0-$amount,'Book Returned',
245       'CR',$amountleft)";
246     $usth = $dbh->prepare($uquery);
247     $usth->execute;
248     $usth->finish;
249     $uquery = "insert into accountoffsets
250       (borrowernumber, accountno, offsetaccount,  offsetamount)
251       values ($bornum,$data->{'accountno'},$nextaccntno,$offset)";
252     $usth = $dbh->prepare($uquery);
253     $usth->execute;
254     $usth->finish;
255   } 
256   $sth->finish;
257   UpdateStats($env,'branch','return','0','',$itemno);
258   return($oduecharge);
259 }
260
261 sub calc_odues {
262   # calculate overdue fees
263   my ($env,$dbh,$bornum,$itemno)=@_;
264   my $amt_owing;
265   return($amt_owing);
266 }  
267
268 sub updatelastseen {
269   my ($env,$dbh,$itemnumber)= @_;
270   my $br = $env->{'branchcode'};
271   my $query = "update items 
272     set datelastseen = now(), holdingbranch = '$br'
273     where (itemnumber = '$itemnumber')";
274   my $sth = $dbh->prepare($query);
275   $sth->execute;
276   $sth->finish;
277      
278 }
279 sub find_reserves {
280   my ($env,$dbh,$itemno) = @_;
281   my $itemdata = itemnodata($env,$dbh,$itemno);
282   my $query = "select * from reserves where found is null 
283   and biblionumber = $itemdata->{'biblionumber'} and cancellationdate is NULL
284   order by priority,reservedate ";
285   my $sth = $dbh->prepare($query);
286   $sth->execute;
287   my $resfound = "n";
288   my $resrec;
289   while (($resrec=$sth->fetchrow_hashref) && ($resfound eq "n")) {
290     if ($resrec->{'found'} eq "W") {
291       if ($resrec->{'itemnumber'} eq $itemno) {
292         $resfound = "y";
293       }
294     } elsif ($resrec->{'constrainttype'} eq "a") {
295       $resfound = "y";
296     } else {
297       my $conquery = "select * from reserveconstraints where borrowernumber
298 = $resrec->{'borrowernumber'} and reservedate = '$resrec->{'reservedate'}' and biblionumber = $resrec->{'biblionumber'} and biblioitemnumber = $itemdata->{'biblioitemnumber'}";
299       my $consth = $dbh->prepare($conquery);
300       $consth->execute;
301       if (my $conrec=$consth->fetchrow_hashref) {
302         if ($resrec->{'constrainttype'} eq "o") {
303            $resfound = "y";
304          }
305       } else {
306         if ($resrec->{'constrainttype'} eq "e") {
307           $resfound = "y";
308         }
309       }
310       $consth->finish;
311     }
312     if ($resfound eq "y") {
313       my $updquery = "update reserves 
314         set found = 'W',itemnumber='$itemno'
315         where borrowernumber = $resrec->{'borrowernumber'}
316         and reservedate = '$resrec->{'reservedate'}'
317         and biblionumber = $resrec->{'biblionumber'}";
318       my $updsth = $dbh->prepare($updquery);
319       $updsth->execute;
320       $updsth->finish;
321       my $itbr = $resrec->{'branchcode'};
322       if ($resrec->{'branchcode'} ne $env->{'branchcode'}) {
323          my $updquery = "update items
324           set holdingbranch = 'TR'
325           where itemnumber = $itemno";
326         my $updsth = $dbh->prepare($updquery);
327         $updsth->execute;
328         $updsth->finish;
329       } 
330     }
331   }
332   $sth->finish;
333   return ($resfound,$resrec);   
334 }
335 END { }       # module clean-up code here (global destructor)