3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22 #use warnings; FIXME - Bug 2505
26 use C4::Log qw(logaction);
28 use Koha::Account::Lines;
29 use Koha::Account::Offsets;
32 use Mojo::Util qw(deprecated);
33 use Data::Dumper qw(Dumper);
35 use vars qw(@ISA @EXPORT);
42 &purge_zero_balance_fees
48 C4::Accounts - Functions for dealing with Koha accounts
56 The functions in this module deal with the monetary aspect of Koha,
57 including looking up and modifying the amount of money owed by a
64 In a default install of Koha the following lost values are set
69 FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that a charge has been added
70 FIXME : if no replacement price, borrower just doesn't get charged?
75 my $dbh = C4::Context->dbh();
76 my ($borrowernumber, $itemnumber, $amount, $description) = @_;
77 my $itype = Koha::ItemTypes->find({ itemtype => Koha::Items->find($itemnumber)->effective_itemtype() });
78 my $replacementprice = $amount;
79 my $defaultreplacecost = $itype->defaultreplacecost;
80 my $processfee = $itype->processfee;
81 my $usedefaultreplacementcost = C4::Context->preference("useDefaultReplacementCost");
82 my $processingfeenote = C4::Context->preference("ProcessingFeeNote");
83 if ($usedefaultreplacementcost && $amount == 0 && $defaultreplacecost){
84 $replacementprice = $defaultreplacecost;
87 my $account = Koha::Account->new({ patron_id => $borrowernumber });
88 # first make sure the borrower hasn't already been charged for this item
89 # FIXME this should be more exact
90 # there is no reason a user can't lose an item, find and return it, and lost it again
91 my $existing_charges = $account->lines->search(
93 itemnumber => $itemnumber,
99 unless ($existing_charges) {
100 my $checkout = Koha::Checkouts->find({ itemnumber => $itemnumber });
101 my $issue_id = $checkout ? $checkout->issue_id : undef;
103 if ($processfee && $processfee > 0){
104 my $accountline = $account->add_debit(
106 amount => $processfee,
107 description => $description,
108 note => $processingfeenote,
109 user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
110 interface => C4::Context->interface,
111 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
112 type => 'processing',
113 item_id => $itemnumber,
114 issue_id => $issue_id,
119 if ($replacementprice > 0){
120 my $accountline = $account->add_debit(
122 amount => $replacementprice,
123 description => $description,
125 user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
126 interface => C4::Context->interface,
127 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
129 item_id => $itemnumber,
130 issue_id => $issue_id,
139 &manualinvoice($borrowernumber, $itemnumber, $description, $type,
142 This function is now deprecated and not used anywhere within koha. It is due for complete removal in 19.11
147 my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_;
149 deprecated "C4::Accounts::manualinvoice is deprecated in favor of Koha::Account->add_debit";
151 my $manager_id = C4::Context->userenv ? C4::Context->userenv->{'number'} : undef;
152 my $dbh = C4::Context->dbh;
154 my $amountleft = $amount;
156 my $branchcode = C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
158 my $accountline = Koha::Account::Line->new(
160 borrowernumber => $borrowernumber,
163 description => $desc,
164 accounttype => $type,
165 amountoutstanding => $amountleft,
166 itemnumber => $itemnum || undef,
168 manager_id => $manager_id,
169 branchcode => $branchcode,
173 my $account_offset = Koha::Account::Offset->new(
175 debit_id => $accountline->id,
176 type => 'Manual Debit',
181 if ( C4::Context->preference("FinesLog") ) {
182 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
183 action => 'create_fee',
184 borrowernumber => $borrowernumber,
186 description => $desc,
187 accounttype => $type,
188 amountoutstanding => $amountleft,
190 itemnumber => $itemnum,
191 manager_id => $manager_id,
198 =head2 purge_zero_balance_fees
200 purge_zero_balance_fees( $days );
202 Delete accountlines entries where amountoutstanding is 0 or NULL which are more than a given number of days old.
204 B<$days> -- Zero balance fees older than B<$days> days old will be deleted.
206 B<Warning:> Because fines and payments are not linked in accountlines, it is
207 possible for a fine to be deleted without the accompanying payment,
208 or vise versa. This won't affect the account balance, but might be
213 sub purge_zero_balance_fees {
217 my $dbh = C4::Context->dbh;
218 my $sth = $dbh->prepare(
220 DELETE a1 FROM accountlines a1
222 LEFT JOIN account_offsets credit_offset ON ( a1.accountlines_id = credit_offset.credit_id )
223 LEFT JOIN accountlines a2 ON ( credit_offset.debit_id = a2.accountlines_id )
225 LEFT JOIN account_offsets debit_offset ON ( a1.accountlines_id = debit_offset.debit_id )
226 LEFT JOIN accountlines a3 ON ( debit_offset.credit_id = a3.accountlines_id )
228 WHERE a1.date < date_sub(curdate(), INTERVAL ? DAY)
229 AND ( a1.amountoutstanding = 0 OR a1.amountoutstanding IS NULL )
230 AND ( a2.amountoutstanding = 0 OR a2.amountoutstanding IS NULL )
231 AND ( a3.amountoutstanding = 0 OR a3.amountoutstanding IS NULL )
234 $sth->execute($days) or die $dbh->errstr;
237 END { } # module clean-up code here (global destructor)