Kumara - predecessor to Koha
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

307 lines
9.1 KiB

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