Bug 22564: (QA follow-up) Correct copy-paste message
[koha.git] / Koha / Account.pm
blob9d66e70f7c831d024fb797e63f48e394adbce745
1 package Koha::Account;
3 # Copyright 2016 ByWater Solutions
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>.
20 use Modern::Perl;
22 use Carp;
23 use Data::Dumper;
24 use List::MoreUtils qw( uniq );
26 use C4::Circulation qw( ReturnLostItem );
27 use C4::Letters;
28 use C4::Log qw( logaction );
29 use C4::Stats qw( UpdateStats );
31 use Koha::Patrons;
32 use Koha::Account::Lines;
33 use Koha::Account::Offsets;
34 use Koha::DateUtils qw( dt_from_string );
35 use Koha::Exceptions;
36 use Koha::Exceptions::Account;
38 =head1 NAME
40 Koha::Accounts - Module for managing payments and fees for patrons
42 =cut
44 sub new {
45 my ( $class, $params ) = @_;
47 Carp::croak("No patron id passed in!") unless $params->{patron_id};
49 return bless( $params, $class );
52 =head2 pay
54 This method allows payments to be made against fees/fines
56 Koha::Account->new( { patron_id => $borrowernumber } )->pay(
58 amount => $amount,
59 sip => $sipmode,
60 note => $note,
61 description => $description,
62 library_id => $branchcode,
63 lines => $lines, # Arrayref of Koha::Account::Line objects to pay
64 account_type => $type, # accounttype code
65 offset_type => $offset_type, # offset type code
69 =cut
71 sub pay {
72 my ( $self, $params ) = @_;
74 my $amount = $params->{amount};
75 my $sip = $params->{sip};
76 my $description = $params->{description};
77 my $note = $params->{note} || q{};
78 my $library_id = $params->{library_id};
79 my $lines = $params->{lines};
80 my $type = $params->{type} || 'payment';
81 my $payment_type = $params->{payment_type} || undef;
82 my $account_type = $params->{account_type};
83 my $offset_type = $params->{offset_type} || $type eq 'writeoff' ? 'Writeoff' : 'Payment';
85 my $userenv = C4::Context->userenv;
87 my $patron = Koha::Patrons->find( $self->{patron_id} );
89 my $manager_id = $userenv ? $userenv->{number} : 0;
90 my $interface = $params ? ( $params->{interface} || C4::Context->interface ) : C4::Context->interface;
92 my @fines_paid; # List of account lines paid on with this payment
94 my $balance_remaining = $amount; # Set it now so we can adjust the amount if necessary
95 $balance_remaining ||= 0;
97 my @account_offsets;
99 # We were passed a specific line to pay
100 foreach my $fine ( @$lines ) {
101 my $amount_to_pay =
102 $fine->amountoutstanding > $balance_remaining
103 ? $balance_remaining
104 : $fine->amountoutstanding;
106 my $old_amountoutstanding = $fine->amountoutstanding;
107 my $new_amountoutstanding = $old_amountoutstanding - $amount_to_pay;
108 $fine->amountoutstanding($new_amountoutstanding)->store();
109 $balance_remaining = $balance_remaining - $amount_to_pay;
111 if ( $fine->itemnumber && $fine->accounttype && ( $fine->accounttype eq 'L' ) )
113 C4::Circulation::ReturnLostItem( $self->{patron_id}, $fine->itemnumber );
116 my $account_offset = Koha::Account::Offset->new(
118 debit_id => $fine->id,
119 type => $offset_type,
120 amount => $amount_to_pay * -1,
123 push( @account_offsets, $account_offset );
125 if ( C4::Context->preference("FinesLog") ) {
126 logaction(
127 "FINES", 'MODIFY',
128 $self->{patron_id},
129 Dumper(
131 action => 'fee_payment',
132 borrowernumber => $fine->borrowernumber,
133 old_amountoutstanding => $old_amountoutstanding,
134 new_amountoutstanding => 0,
135 amount_paid => $old_amountoutstanding,
136 accountlines_id => $fine->id,
137 manager_id => $manager_id,
138 note => $note,
141 $interface
143 push( @fines_paid, $fine->id );
147 # Were not passed a specific line to pay, or the payment was for more
148 # than the what was owed on the given line. In that case pay down other
149 # lines with remaining balance.
150 my @outstanding_fines;
151 @outstanding_fines = $self->lines->search(
153 amountoutstanding => { '>' => 0 },
155 ) if $balance_remaining > 0;
157 foreach my $fine (@outstanding_fines) {
158 my $amount_to_pay =
159 $fine->amountoutstanding > $balance_remaining
160 ? $balance_remaining
161 : $fine->amountoutstanding;
163 my $old_amountoutstanding = $fine->amountoutstanding;
164 $fine->amountoutstanding( $old_amountoutstanding - $amount_to_pay );
165 $fine->store();
167 my $account_offset = Koha::Account::Offset->new(
169 debit_id => $fine->id,
170 type => $offset_type,
171 amount => $amount_to_pay * -1,
174 push( @account_offsets, $account_offset );
176 if ( C4::Context->preference("FinesLog") ) {
177 logaction(
178 "FINES", 'MODIFY',
179 $self->{patron_id},
180 Dumper(
182 action => "fee_$type",
183 borrowernumber => $fine->borrowernumber,
184 old_amountoutstanding => $old_amountoutstanding,
185 new_amountoutstanding => $fine->amountoutstanding,
186 amount_paid => $amount_to_pay,
187 accountlines_id => $fine->id,
188 manager_id => $manager_id,
189 note => $note,
192 $interface
194 push( @fines_paid, $fine->id );
197 $balance_remaining = $balance_remaining - $amount_to_pay;
198 last unless $balance_remaining > 0;
201 $account_type ||=
202 $type eq 'writeoff' ? 'W'
203 : defined($sip) ? "Pay$sip"
204 : 'Pay';
206 $description ||= $type eq 'writeoff' ? 'Writeoff' : q{};
208 my $payment = Koha::Account::Line->new(
210 borrowernumber => $self->{patron_id},
211 date => dt_from_string(),
212 amount => 0 - $amount,
213 description => $description,
214 accounttype => $account_type,
215 payment_type => $payment_type,
216 amountoutstanding => 0 - $balance_remaining,
217 manager_id => $manager_id,
218 interface => $interface,
219 branchcode => $library_id,
220 note => $note,
222 )->store();
224 foreach my $o ( @account_offsets ) {
225 $o->credit_id( $payment->id() );
226 $o->store();
229 UpdateStats(
231 branch => $library_id,
232 type => $type,
233 amount => $amount,
234 borrowernumber => $self->{patron_id},
238 if ( C4::Context->preference("FinesLog") ) {
239 logaction(
240 "FINES", 'CREATE',
241 $self->{patron_id},
242 Dumper(
244 action => "create_$type",
245 borrowernumber => $self->{patron_id},
246 amount => 0 - $amount,
247 amountoutstanding => 0 - $balance_remaining,
248 accounttype => $account_type,
249 accountlines_paid => \@fines_paid,
250 manager_id => $manager_id,
253 $interface
257 if ( C4::Context->preference('UseEmailReceipts') ) {
258 if (
259 my $letter = C4::Letters::GetPreparedLetter(
260 module => 'circulation',
261 letter_code => uc("ACCOUNT_$type"),
262 message_transport_type => 'email',
263 lang => $patron->lang,
264 tables => {
265 borrowers => $self->{patron_id},
266 branches => $self->{library_id},
268 substitute => {
269 credit => $payment,
270 offsets => \@account_offsets,
275 C4::Letters::EnqueueLetter(
277 letter => $letter,
278 borrowernumber => $self->{patron_id},
279 message_transport_type => 'email',
281 ) or warn "can't enqueue letter $letter";
285 return $payment->id;
288 =head3 add_credit
290 This method allows adding credits to a patron's account
292 my $credit_line = Koha::Account->new({ patron_id => $patron_id })->add_credit(
294 amount => $amount,
295 description => $description,
296 note => $note,
297 user_id => $user_id,
298 interface => $interface,
299 library_id => $library_id,
300 sip => $sip,
301 payment_type => $payment_type,
302 type => $credit_type,
303 item_id => $item_id
307 $credit_type can be any of:
308 - 'credit'
309 - 'payment'
310 - 'forgiven'
311 - 'lost_item_return'
312 - 'writeoff'
314 =cut
316 sub add_credit {
318 my ( $self, $params ) = @_;
320 # amount is passed as a positive value, but we store credit as negative values
321 my $amount = $params->{amount} * -1;
322 my $description = $params->{description} // q{};
323 my $note = $params->{note} // q{};
324 my $user_id = $params->{user_id};
325 my $interface = $params->{interface};
326 my $library_id = $params->{library_id};
327 my $sip = $params->{sip};
328 my $payment_type = $params->{payment_type};
329 my $type = $params->{type} || 'payment';
330 my $item_id = $params->{item_id};
332 unless ( $interface ) {
333 Koha::Exceptions::MissingParameter->throw(
334 error => 'The interface parameter is mandatory'
338 my $schema = Koha::Database->new->schema;
340 my $account_type = $Koha::Account::account_type_credit->{$type};
341 $account_type .= $sip
342 if defined $sip &&
343 $type eq 'payment';
345 my $line;
347 $schema->txn_do(
348 sub {
350 # Insert the account line
351 $line = Koha::Account::Line->new(
352 { borrowernumber => $self->{patron_id},
353 date => \'NOW()',
354 amount => $amount,
355 description => $description,
356 accounttype => $account_type,
357 amountoutstanding => $amount,
358 payment_type => $payment_type,
359 note => $note,
360 manager_id => $user_id,
361 interface => $interface,
362 branchcode => $library_id,
363 itemnumber => $item_id,
365 )->store();
367 # Record the account offset
368 my $account_offset = Koha::Account::Offset->new(
369 { credit_id => $line->id,
370 type => $Koha::Account::offset_type->{$type},
371 amount => $amount
373 )->store();
375 UpdateStats(
376 { branch => $library_id,
377 type => $type,
378 amount => $amount,
379 borrowernumber => $self->{patron_id},
381 ) if grep { $type eq $_ } ('payment', 'writeoff') ;
383 if ( C4::Context->preference("FinesLog") ) {
384 logaction(
385 "FINES", 'CREATE',
386 $self->{patron_id},
387 Dumper(
388 { action => "create_$type",
389 borrowernumber => $self->{patron_id},
390 amount => $amount,
391 description => $description,
392 amountoutstanding => $amount,
393 accounttype => $account_type,
394 note => $note,
395 itemnumber => $item_id,
396 manager_id => $user_id,
397 branchcode => $library_id,
400 $interface
406 return $line;
409 =head3 add_debit
411 This method allows adding debits to a patron's account
413 my $debit_line = Koha::Account->new({ patron_id => $patron_id })->add_debit(
415 amount => $amount,
416 description => $description,
417 note => $note,
418 user_id => $user_id,
419 interface => $interface,
420 library_id => $library_id,
421 type => $debit_type,
422 item_id => $item_id,
423 issue_id => $issue_id
427 $debit_type can be any of:
428 - overdue
429 - lost_item
430 - new_card
431 - account
432 - sundry
433 - processing
434 - rent
435 - reserve
436 - manual
438 =cut
440 sub add_debit {
442 my ( $self, $params ) = @_;
444 # amount should always be a positive value
445 my $amount = $params->{amount};
447 unless ( $amount > 0 ) {
448 Koha::Exceptions::Account::AmountNotPositive->throw(
449 error => 'Debit amount passed is not positive'
453 my $description = $params->{description} // q{};
454 my $note = $params->{note} // q{};
455 my $user_id = $params->{user_id};
456 my $interface = $params->{interface};
457 my $library_id = $params->{library_id};
458 my $type = $params->{type};
459 my $item_id = $params->{item_id};
460 my $issue_id = $params->{issue_id};
462 unless ( $interface ) {
463 Koha::Exceptions::MissingParameter->throw(
464 error => 'The interface parameter is mandatory'
468 my $schema = Koha::Database->new->schema;
470 unless ( exists($Koha::Account::account_type_debit->{$type}) ) {
471 Koha::Exceptions::Account::UnrecognisedType->throw(
472 error => 'Type of debit not recognised'
476 my $account_type = $Koha::Account::account_type_debit->{$type};
478 my $line;
480 $schema->txn_do(
481 sub {
483 # Insert the account line
484 $line = Koha::Account::Line->new(
485 { borrowernumber => $self->{patron_id},
486 date => \'NOW()',
487 amount => $amount,
488 description => $description,
489 accounttype => $account_type,
490 amountoutstanding => $amount,
491 payment_type => undef,
492 note => $note,
493 manager_id => $user_id,
494 interface => $interface,
495 itemnumber => $item_id,
496 issue_id => $issue_id,
497 branchcode => $library_id,
498 ( $type eq 'overdue' ? ( status => 'UNRETURNED' ) : ()),
500 )->store();
502 # Record the account offset
503 my $account_offset = Koha::Account::Offset->new(
504 { debit_id => $line->id,
505 type => $Koha::Account::offset_type->{$type},
506 amount => $amount
508 )->store();
510 if ( C4::Context->preference("FinesLog") ) {
511 logaction(
512 "FINES", 'CREATE',
513 $self->{patron_id},
514 Dumper(
515 { action => "create_$type",
516 borrowernumber => $self->{patron_id},
517 amount => $amount,
518 description => $description,
519 amountoutstanding => $amount,
520 accounttype => $account_type,
521 note => $note,
522 itemnumber => $item_id,
523 manager_id => $user_id,
526 $interface
532 return $line;
535 =head3 balance
537 my $balance = $self->balance
539 Return the balance (sum of amountoutstanding columns)
541 =cut
543 sub balance {
544 my ($self) = @_;
545 return $self->lines->total_outstanding;
548 =head3 outstanding_debits
550 my $lines = Koha::Account->new({ patron_id => $patron_id })->outstanding_debits;
552 It returns the debit lines with outstanding amounts for the patron.
554 In scalar context, it returns a Koha::Account::Lines iterator. In list context, it will
555 return a list of Koha::Account::Line objects.
557 =cut
559 sub outstanding_debits {
560 my ($self) = @_;
562 return $self->lines->search(
564 amount => { '>' => 0 },
565 amountoutstanding => { '>' => 0 }
570 =head3 outstanding_credits
572 my $lines = Koha::Account->new({ patron_id => $patron_id })->outstanding_credits;
574 It returns the credit lines with outstanding amounts for the patron.
576 In scalar context, it returns a Koha::Account::Lines iterator. In list context, it will
577 return a list of Koha::Account::Line objects.
579 =cut
581 sub outstanding_credits {
582 my ($self) = @_;
584 return $self->lines->search(
586 amount => { '<' => 0 },
587 amountoutstanding => { '<' => 0 }
592 =head3 non_issues_charges
594 my $non_issues_charges = $self->non_issues_charges
596 Calculates amount immediately owing by the patron - non-issue charges.
598 Charges exempt from non-issue are:
599 * Res (holds) if HoldsInNoissuesCharge syspref is set to false
600 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
601 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
603 =cut
605 sub non_issues_charges {
606 my ($self) = @_;
608 # FIXME REMOVE And add a warning in the about page + update DB if length(MANUAL_INV) > 5
609 my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
611 my @not_fines;
612 push @not_fines, 'Res'
613 unless C4::Context->preference('HoldsInNoissuesCharge');
614 push @not_fines, 'Rent'
615 unless C4::Context->preference('RentalsInNoissuesCharge');
616 unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
617 my $dbh = C4::Context->dbh;
618 push @not_fines,
620 $dbh->selectcol_arrayref(q|
621 SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'
625 @not_fines = map { substr( $_, 0, $ACCOUNT_TYPE_LENGTH ) } uniq(@not_fines);
627 return $self->lines->search(
629 accounttype => { -not_in => \@not_fines }
631 )->total_outstanding;
634 =head3 lines
636 my $lines = $self->lines;
638 Return all credits and debits for the user, outstanding or otherwise
640 =cut
642 sub lines {
643 my ($self) = @_;
645 return Koha::Account::Lines->search(
647 borrowernumber => $self->{patron_id},
652 =head3 reconcile_balance
654 $account->reconcile_balance();
656 Find outstanding credits and use them to pay outstanding debits.
657 Currently, this implicitly uses the 'First In First Out' rule for
658 applying credits against debits.
660 =cut
662 sub reconcile_balance {
663 my ($self) = @_;
665 my $outstanding_debits = $self->outstanding_debits;
666 my $outstanding_credits = $self->outstanding_credits;
668 while ( $outstanding_debits->total_outstanding > 0
669 and my $credit = $outstanding_credits->next )
671 # there's both outstanding debits and credits
672 $credit->apply( { debits => $outstanding_debits } ); # applying credit, no special offset
674 $outstanding_debits = $self->outstanding_debits;
678 return $self;
683 =head2 Name mappings
685 =head3 $offset_type
687 =cut
689 our $offset_type = {
690 'credit' => 'Manual Credit',
691 'forgiven' => 'Writeoff',
692 'lost_item_return' => 'Lost Item',
693 'payment' => 'Payment',
694 'writeoff' => 'Writeoff',
695 'account' => 'Account Fee',
696 'reserve' => 'Reserve Fee',
697 'processing' => 'Processing Fee',
698 'lost_item' => 'Lost Item',
699 'rent' => 'Rental Fee',
700 'overdue' => 'OVERDUE',
701 'manual_debit' => 'Manual Debit',
702 'hold_expired' => 'Hold Expired'
705 =head3 $account_type_credit
707 =cut
709 our $account_type_credit = {
710 'credit' => 'C',
711 'forgiven' => 'FOR',
712 'lost_item_return' => 'CR',
713 'payment' => 'Pay',
714 'writeoff' => 'W'
717 =head3 $account_type_debit
719 =cut
721 our $account_type_debit = {
722 'account' => 'A',
723 'overdue' => 'OVERDUE',
724 'lost_item' => 'L',
725 'new_card' => 'N',
726 'sundry' => 'M',
727 'processing' => 'PF',
728 'rent' => 'Rent',
729 'reserve' => 'Res',
730 'manual_debit' => 'M',
731 'hold_expired' => 'HE'
734 =head1 AUTHORS
736 =encoding utf8
738 Kyle M Hall <kyle.m.hall@gmail.com>
739 Tomás Cohen Arazi <tomascohen@gmail.com>
740 Martin Renvoize <martin.renvoize@ptfs-europe.com>
742 =cut