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;
86 my $checkout = Koha
::Checkouts
->find({ itemnumber
=> $itemnumber });
87 my $issue_id = $checkout ?
$checkout->issue_id : undef;
89 my $account = Koha
::Account
->new({ patron_id
=> $borrowernumber });
90 # first make sure the borrower hasn't already been charged for this item (for this issuance)
91 my $existing_charges = $account->lines->search(
93 itemnumber
=> $itemnumber,
94 debit_type_code
=> 'LOST',
100 unless ($existing_charges) {
102 if ($processfee && $processfee > 0){
103 my $accountline = $account->add_debit(
105 amount
=> $processfee,
106 description
=> $description,
107 note
=> $processingfeenote,
108 user_id
=> C4
::Context
->userenv ? C4
::Context
->userenv->{'number'} : undef,
109 interface
=> C4
::Context
->interface,
110 library_id
=> C4
::Context
->userenv ? C4
::Context
->userenv->{'branch'} : undef,
111 type
=> 'PROCESSING',
112 item_id
=> $itemnumber,
113 issue_id
=> $issue_id,
118 if ($replacementprice > 0){
119 my $accountline = $account->add_debit(
121 amount
=> $replacementprice,
122 description
=> $description,
124 user_id
=> C4
::Context
->userenv ? C4
::Context
->userenv->{'number'} : undef,
125 interface
=> C4
::Context
->interface,
126 library_id
=> C4
::Context
->userenv ? C4
::Context
->userenv->{'branch'} : undef,
128 item_id
=> $itemnumber,
129 issue_id
=> $issue_id,
138 &manualinvoice($borrowernumber, $itemnumber, $description, $type,
141 This function is now deprecated and not used anywhere within koha. It is due for complete removal in 19.11
146 my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_;
148 deprecated
"C4::Accounts::manualinvoice is deprecated in favor of Koha::Account->add_debit";
150 my $manager_id = C4
::Context
->userenv ? C4
::Context
->userenv->{'number'} : undef;
151 my $dbh = C4
::Context
->dbh;
153 my $amountleft = $amount;
155 my $branchcode = C4
::Context
->userenv ? C4
::Context
->userenv->{'branch'} : undef;
158 if ( $type eq 'LOST' && $itemnum ) {
159 my $checkouts = Koha
::Checkouts
->search(
160 { itemnumber
=> $itemnum, borrowernumber
=> $borrowernumber } );
164 : Koha
::Old
::Checkouts
->search(
165 { itemnumber
=> $itemnum, borrowernumber
=> $borrowernumber },
166 { order_by
=> { -desc
=> 'returndate' }, rows
=> 1 }
168 $issue_id = $checkout ?
$checkout->issue_id : undef;
171 my $accountline = Koha
::Account
::Line
->new(
173 borrowernumber
=> $borrowernumber,
176 description => $desc,
177 debit_type_code => $type,
178 amountoutstanding => $amountleft,
179 itemnumber => $itemnum || undef,
180 issue_id => $issue_id,
182 manager_id => $manager_id,
183 interface => C4::Context->interface,
184 branchcode => $branchcode,
188 my $account_offset = Koha::Account::Offset->new(
190 debit_id => $accountline->id,
191 type => 'Manual Debit
',
196 if ( C4::Context->preference("FinesLog") ) {
197 logaction("FINES", 'CREATE
',$borrowernumber,Dumper({
198 action => 'create_fee
',
199 borrowernumber => $borrowernumber,
201 description => $desc,
202 debit_type_code => $type,
203 amountoutstanding => $amountleft,
205 itemnumber => $itemnum,
206 manager_id => $manager_id,
213 =head2 purge_zero_balance_fees
215 purge_zero_balance_fees( $days );
217 Delete accountlines entries where amountoutstanding is 0 or NULL which are more than a given number of days old.
219 B<$days> -- Zero balance fees older than B<$days> days old will be deleted.
221 B<Warning:> Because fines and payments are not linked in accountlines, it is
222 possible for a fine to be deleted without the accompanying payment,
223 or vise versa. This won't affect the account balance
, but might be
228 sub purge_zero_balance_fees
{
232 my $dbh = C4
::Context
->dbh;
233 my $sth = $dbh->prepare(
235 DELETE a1 FROM accountlines a1
237 LEFT JOIN account_offsets credit_offset ON ( a1.accountlines_id = credit_offset.credit_id )
238 LEFT JOIN accountlines a2 ON ( credit_offset.debit_id = a2.accountlines_id )
240 LEFT JOIN account_offsets debit_offset ON ( a1.accountlines_id = debit_offset.debit_id )
241 LEFT JOIN accountlines a3 ON ( debit_offset.credit_id = a3.accountlines_id )
243 WHERE a1.date < date_sub(curdate(), INTERVAL ? DAY)
244 AND ( a1.amountoutstanding = 0 OR a1.amountoutstanding IS NULL )
245 AND ( a2.amountoutstanding = 0 OR a2.amountoutstanding IS NULL )
246 AND ( a3.amountoutstanding = 0 OR a3.amountoutstanding IS NULL )
249 $sth->execute($days) or die $dbh->errstr;
252 END { } # module clean-up code here (global destructor)