C4/Accounts.pm

   1 package C4::Accounts; #assumes C4/Accounts
   2
   3
   4 # Copyright 2000-2002 Katipo Communications
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it under the
   9 # terms of the GNU General Public License as published by the Free Software
  10 # Foundation; either version 2 of the License, or (at your option) any later
  11 # version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License along with
  18 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  19 # Suite 330, Boston, MA  02111-1307 USA
  20
  21 use strict;
  22 require Exporter;
  23 use DBI;
  24 use C4::Database;
  25 use C4::Format;
  26 use C4::Search;
  27 use C4::Stats;
  28 use C4::InterfaceCDK;
  29 use C4::Interface::AccountsCDK;
  30 use vars qw($VERSION @ISA @EXPORT);
  31
  32 # set the version for version checking
  33 $VERSION = 0.01;
  34
  35 =head1 NAME
  36
  37 C4::Accounts - FIXME
  38
  39 =head1 SYNOPSIS
  40
  41   use C4::Accounts;
  42
  43 FIXME
  44
  45 =head1 DESCRIPTION
  46
  47 FIXME
  48
  49 =head1 FUNCTIONS
  50
  51 =over 2
  52
  53 =cut
  54
  55 @ISA = qw(Exporter);
  56 @EXPORT = qw(&checkaccount &reconcileaccount &getnextacctno);
  57 # FIXME - This is never used
  58 sub displayaccounts{
  59   my ($env)=@_;
  60 }
  61
  62 =item checkaccount
  63
  64   $owed = &checkaccount($env, $borrowernumber, $dbh);
  65
  66 Looks up the total amount of money owed by a borrower (fines, etc.).
  67
  68 C<$borrowernumber> specifies the borrower to look up.
  69
  70 C<$dbh> is a DBI::db handle for the Koha database.
  71
  72 C<$env> is ignored.
  73
  74 =cut
  75 #'
  76 sub checkaccount  {
  77   #take borrower number
  78   #check accounts and list amounts owing
  79   my ($env,$bornumber,$dbh)=@_;
  80   my $sth=$dbh->prepare("Select sum(amountoutstanding) from accountlines where
  81   borrowernumber=$bornumber and amountoutstanding<>0");
  82   $sth->execute;
  83   my $total=0;
  84   while (my $data=$sth->fetchrow_hashref){
  85     $total += $data->{'sum(amountoutstanding)'};
  86   }
  87   $sth->finish;
  88   # output(1,2,"borrower owes $total");
  89   #if ($total > 0){
  90   #  # output(1,2,"borrower owes $total");
  91   #  if ($total > 5){
  92   #    reconcileaccount($env,$dbh,$bornumber,$total);
  93   #  }
  94   #}
  95   #  pause();
  96   return($total);
  97 }
  98
  99 # XXX - POD. Need to figure out C4/Interface/AccountsCDK.pm first,
 100 # though
 101 # FIXME - It looks as though this function really wants to be part of
 102 # a curses-based script.
 103 sub reconcileaccount {
 104   #print put money owing give person opportunity to pay it off
 105   my ($env,$dummy,$bornumber,$total)=@_;
 106   my $dbh = &C4Connect;
 107   #get borrower record
 108   my $sth=$dbh->prepare("select * from borrowers
 109     where borrowernumber=$bornumber");
 110   $sth->execute;
 111   my $borrower=$sth->fetchrow_hashref;
 112   $sth->finish();
 113   #get borrower information
 114   $sth=$dbh->prepare("Select * from accountlines where
 115   borrowernumber=$bornumber and amountoutstanding<>0 order by date");
 116   $sth->execute;
 117   #display account information
 118   &clearscreen();
 119   #&helptext('F11 quits');
 120   output(20,0,"Accounts");
 121   my @accountlines;
 122   my $row=4;
 123   my $i=0;
 124   my $text;
 125   #output (1,2,"Account Info");
 126   #output (1,3,"Item\tDate      \tAmount\tDescription");
 127   while (my $data=$sth->fetchrow_hashref){
 128     my $line=$i+1;
 129     my $amount=0+$data->{'amountoutstanding'};
 130     my $itemdata = itemnodata($env,$dbh,$data->{'itemnumber'});
 131     $line= $data->{'accountno'}." ".$data->{'date'}." ".$data->{'accounttype'}." ";
 132     my $title = $itemdata->{'title'};
 133     if (length($title) > 15 ) {$title = substr($title,0,15);}
 134     $line= $line.$itemdata->{'barcode'}." $title ".$data->{'description'};
 135     $line = fmtstr($env,$line,"L65")." ".fmtdec($env,$amount,"52");
 136     push @accountlines,$line;
 137     $i++;
 138   }
 139   #get amount paid and update database
 140   my ($data,$reason)=
 141     &accountsdialog($env,"Payment Entry",$borrower,\@accountlines,$total);
 142   if ($data>0) {
 143     &recordpayment($env,$bornumber,$dbh,$data);
 144     #Check if the borrower still owes
 145     $total=&checkaccount($env,$bornumber,$dbh);
 146   }
 147   $dbh->disconnect;
 148   return($total);
 149
 150 }
 151
 152 # FIXME - This function is never used. Then again, it's not exported,
 153 # either.
 154 sub recordpayment{
 155   #here we update both the accountoffsets and the account lines
 156   my ($env,$bornumber,$dbh,$data)=@_;
 157   my $updquery = "";
 158   my $newamtos = 0;
 159   my $accdata = "";
 160   my $amountleft = $data;
 161   # begin transaction
 162 #  my $sth = $dbh->prepare("begin");
 163 #  $sth->execute;
 164   my $nextaccntno = getnextacctno($env,$bornumber,$dbh);
 165   # get lines with outstanding amounts to offset
 166   my $query = "select * from accountlines
 167   where (borrowernumber = '$bornumber') and (amountoutstanding<>0)
 168   order by date";
 169   my $sth = $dbh->prepare($query);
 170   $sth->execute;
 171   # offset transactions
 172   while (($accdata=$sth->fetchrow_hashref) and ($amountleft>0)){
 173      if ($accdata->{'amountoutstanding'} < $amountleft) {
 174         $newamtos = 0;
 175         $amountleft = $amountleft - $accdata->{'amountoutstanding'};
 176      }  else {
 177         $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
 178         $amountleft = 0;
 179      }
 180      my $thisacct = $accdata->{accountno};
 181      $updquery = "update accountlines set amountoutstanding= '$newamtos'
 182      where (borrowernumber = '$bornumber') and (accountno='$thisacct')";
 183      my $usth = $dbh->prepare($updquery);
 184      $usth->execute;
 185      $usth->finish;
 186      $updquery = "insert into accountoffsets
 187      (borrowernumber, accountno, offsetaccount,  offsetamount)
 188      values ($bornumber,$accdata->{'accountno'},$nextaccntno,$newamtos)";
 189      my $usth = $dbh->prepare($updquery);
 190 #     print $updquery
 191      $usth->execute;
 192      $usth->finish;
 193   }
 194   # create new line
 195   #$updquery = "insert into accountlines (borrowernumber,
 196   #accountno,date,amount,description,accounttype,amountoutstanding) values
 197   #($bornumber,$nextaccntno,datetime('now'::abstime),0-$data,'Payment,thanks',
 198   #'Pay',0-$amountleft)";
 199   $updquery = "insert into accountlines
 200   (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding)
 201   values ($bornumber,$nextaccntno,now(),0-$data,'Payment,thanks',
 202   'Pay',0-$amountleft)";
 203   my $usth = $dbh->prepare($updquery);
 204   $usth->execute;
 205   $usth->finish;
 206   UpdateStats($env,'branch','payment',$data)
 207 #  $sth->finish;
 208 #  $query = "commit";
 209 #  $sth = $dbh->prepare;
 210 #  $sth->execute;
 211 #  $sth-finish;
 212 }
 213
 214 =item getnextacctno
 215
 216   $nextacct = &getnextacctno($env, $borrowernumber, $dbh);
 217
 218 Returns the next unused account number for the patron with the given
 219 borrower number.
 220
 221 C<$dbh> is a DBI::db handle to the Koha database.
 222
 223 C<$env> is ignored.
 224
 225 =cut
 226 # FIXME - Okay, so what does the above actually _mean_?
 227 sub getnextacctno {
 228   my ($env,$bornumber,$dbh)=@_;
 229   my $nextaccntno = 1;
 230   # FIXME - This could just be
 231   #     SELECT max(accountno)+1 from accountlines;
 232   my $query = "select * from accountlines
 233   where (borrowernumber = '$bornumber')
 234   order by accountno desc";
 235   my $sth = $dbh->prepare($query);
 236   $sth->execute;
 237   if (my $accdata=$sth->fetchrow_hashref){
 238     $nextaccntno = $accdata->{'accountno'} + 1;
 239   }
 240   $sth->finish;
 241   return($nextaccntno);
 242 }
 243
 244 END { }       # module clean-up code here (global destructor)
 245
 246 1;
 247 __END__
 248 =back
 249
 250 =head1 SEE ALSO
 251
 252 L<DBI(3)|DBI>
 253
 254 =cut