Bug 6759: DBRev 19.06.00.028
[koha.git] / Koha / Account.pm
blob35b438a0e102cb0e56419fb90e2a1445875d7257
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 note => $note,
60 description => $description,
61 library_id => $branchcode,
62 lines => $lines, # Arrayref of Koha::Account::Line objects to pay
63 account_type => $type, # accounttype code
64 offset_type => $offset_type, # offset type code
68 =cut
70 sub pay {
71 my ( $self, $params ) = @_;
73 my $amount = $params->{amount};
74 my $description = $params->{description};
75 my $note = $params->{note} || q{};
76 my $library_id = $params->{library_id};
77 my $lines = $params->{lines};
78 my $type = $params->{type} || 'payment';
79 my $payment_type = $params->{payment_type} || undef;
80 my $account_type = $params->{account_type};
81 my $offset_type = $params->{offset_type} || $type eq 'writeoff' ? 'Writeoff' : 'Payment';
83 my $userenv = C4::Context->userenv;
85 my $patron = Koha::Patrons->find( $self->{patron_id} );
87 my $manager_id = $userenv ? $userenv->{number} : 0;
88 my $interface = $params ? ( $params->{interface} || C4::Context->interface ) : C4::Context->interface;
90 my @fines_paid; # List of account lines paid on with this payment
92 my $balance_remaining = $amount; # Set it now so we can adjust the amount if necessary
93 $balance_remaining ||= 0;
95 my @account_offsets;
97 # We were passed a specific line to pay
98 foreach my $fine ( @$lines ) {
99 my $amount_to_pay =
100 $fine->amountoutstanding > $balance_remaining
101 ? $balance_remaining
102 : $fine->amountoutstanding;
104 my $old_amountoutstanding = $fine->amountoutstanding;
105 my $new_amountoutstanding = $old_amountoutstanding - $amount_to_pay;
106 $fine->amountoutstanding($new_amountoutstanding)->store();
107 $balance_remaining = $balance_remaining - $amount_to_pay;
109 # Same logic exists in Koha::Account::Line::apply
110 if ( $new_amountoutstanding == 0
111 && $fine->itemnumber
112 && $fine->accounttype
113 && ( $fine->accounttype eq 'LOST' ) )
115 C4::Circulation::ReturnLostItem( $self->{patron_id}, $fine->itemnumber );
118 my $account_offset = Koha::Account::Offset->new(
120 debit_id => $fine->id,
121 type => $offset_type,
122 amount => $amount_to_pay * -1,
125 push( @account_offsets, $account_offset );
127 if ( C4::Context->preference("FinesLog") ) {
128 logaction(
129 "FINES", 'MODIFY',
130 $self->{patron_id},
131 Dumper(
133 action => 'fee_payment',
134 borrowernumber => $fine->borrowernumber,
135 old_amountoutstanding => $old_amountoutstanding,
136 new_amountoutstanding => 0,
137 amount_paid => $old_amountoutstanding,
138 accountlines_id => $fine->id,
139 manager_id => $manager_id,
140 note => $note,
143 $interface
145 push( @fines_paid, $fine->id );
149 # Were not passed a specific line to pay, or the payment was for more
150 # than the what was owed on the given line. In that case pay down other
151 # lines with remaining balance.
152 my @outstanding_fines;
153 @outstanding_fines = $self->lines->search(
155 amountoutstanding => { '>' => 0 },
157 ) if $balance_remaining > 0;
159 foreach my $fine (@outstanding_fines) {
160 my $amount_to_pay =
161 $fine->amountoutstanding > $balance_remaining
162 ? $balance_remaining
163 : $fine->amountoutstanding;
165 my $old_amountoutstanding = $fine->amountoutstanding;
166 $fine->amountoutstanding( $old_amountoutstanding - $amount_to_pay );
167 $fine->store();
169 if ( $fine->amountoutstanding == 0
170 && $fine->itemnumber
171 && $fine->accounttype
172 && ( $fine->accounttype eq 'LOST' ) )
174 C4::Circulation::ReturnLostItem( $self->{patron_id}, $fine->itemnumber );
177 my $account_offset = Koha::Account::Offset->new(
179 debit_id => $fine->id,
180 type => $offset_type,
181 amount => $amount_to_pay * -1,
184 push( @account_offsets, $account_offset );
186 if ( C4::Context->preference("FinesLog") ) {
187 logaction(
188 "FINES", 'MODIFY',
189 $self->{patron_id},
190 Dumper(
192 action => "fee_$type",
193 borrowernumber => $fine->borrowernumber,
194 old_amountoutstanding => $old_amountoutstanding,
195 new_amountoutstanding => $fine->amountoutstanding,
196 amount_paid => $amount_to_pay,
197 accountlines_id => $fine->id,
198 manager_id => $manager_id,
199 note => $note,
202 $interface
204 push( @fines_paid, $fine->id );
207 $balance_remaining = $balance_remaining - $amount_to_pay;
208 last unless $balance_remaining > 0;
211 $account_type ||=
212 $type eq 'writeoff'
213 ? 'W'
214 : 'Pay';
216 $description ||= $type eq 'writeoff' ? 'Writeoff' : q{};
218 my $payment = Koha::Account::Line->new(
220 borrowernumber => $self->{patron_id},
221 date => dt_from_string(),
222 amount => 0 - $amount,
223 description => $description,
224 accounttype => $account_type,
225 payment_type => $payment_type,
226 amountoutstanding => 0 - $balance_remaining,
227 manager_id => $manager_id,
228 interface => $interface,
229 branchcode => $library_id,
230 note => $note,
232 )->store();
234 foreach my $o ( @account_offsets ) {
235 $o->credit_id( $payment->id() );
236 $o->store();
239 UpdateStats(
241 branch => $library_id,
242 type => $type,
243 amount => $amount,
244 borrowernumber => $self->{patron_id},
248 if ( C4::Context->preference("FinesLog") ) {
249 logaction(
250 "FINES", 'CREATE',
251 $self->{patron_id},
252 Dumper(
254 action => "create_$type",
255 borrowernumber => $self->{patron_id},
256 amount => 0 - $amount,
257 amountoutstanding => 0 - $balance_remaining,
258 accounttype => $account_type,
259 accountlines_paid => \@fines_paid,
260 manager_id => $manager_id,
263 $interface
267 if ( C4::Context->preference('UseEmailReceipts') ) {
268 if (
269 my $letter = C4::Letters::GetPreparedLetter(
270 module => 'circulation',
271 letter_code => uc("ACCOUNT_$type"),
272 message_transport_type => 'email',
273 lang => $patron->lang,
274 tables => {
275 borrowers => $self->{patron_id},
276 branches => $self->{library_id},
278 substitute => {
279 credit => $payment,
280 offsets => \@account_offsets,
285 C4::Letters::EnqueueLetter(
287 letter => $letter,
288 borrowernumber => $self->{patron_id},
289 message_transport_type => 'email',
291 ) or warn "can't enqueue letter $letter";
295 return $payment->id;
298 =head3 add_credit
300 This method allows adding credits to a patron's account
302 my $credit_line = Koha::Account->new({ patron_id => $patron_id })->add_credit(
304 amount => $amount,
305 description => $description,
306 note => $note,
307 user_id => $user_id,
308 interface => $interface,
309 library_id => $library_id,
310 payment_type => $payment_type,
311 type => $credit_type,
312 item_id => $item_id
316 $credit_type can be any of:
317 - 'credit'
318 - 'payment'
319 - 'forgiven'
320 - 'lost_item_return'
321 - 'writeoff'
323 =cut
325 sub add_credit {
327 my ( $self, $params ) = @_;
329 # amount is passed as a positive value, but we store credit as negative values
330 my $amount = $params->{amount} * -1;
331 my $description = $params->{description} // q{};
332 my $note = $params->{note} // q{};
333 my $user_id = $params->{user_id};
334 my $interface = $params->{interface};
335 my $library_id = $params->{library_id};
336 my $payment_type = $params->{payment_type};
337 my $type = $params->{type} || 'payment';
338 my $item_id = $params->{item_id};
340 unless ( $interface ) {
341 Koha::Exceptions::MissingParameter->throw(
342 error => 'The interface parameter is mandatory'
346 my $schema = Koha::Database->new->schema;
348 my $account_type = $Koha::Account::account_type_credit->{$type};
349 my $line;
351 $schema->txn_do(
352 sub {
354 # Insert the account line
355 $line = Koha::Account::Line->new(
356 { borrowernumber => $self->{patron_id},
357 date => \'NOW()',
358 amount => $amount,
359 description => $description,
360 accounttype => $account_type,
361 amountoutstanding => $amount,
362 payment_type => $payment_type,
363 note => $note,
364 manager_id => $user_id,
365 interface => $interface,
366 branchcode => $library_id,
367 itemnumber => $item_id,
369 )->store();
371 # Record the account offset
372 my $account_offset = Koha::Account::Offset->new(
373 { credit_id => $line->id,
374 type => $Koha::Account::offset_type->{$type},
375 amount => $amount
377 )->store();
379 UpdateStats(
380 { branch => $library_id,
381 type => $type,
382 amount => $amount,
383 borrowernumber => $self->{patron_id},
385 ) if grep { $type eq $_ } ('payment', 'writeoff') ;
387 if ( C4::Context->preference("FinesLog") ) {
388 logaction(
389 "FINES", 'CREATE',
390 $self->{patron_id},
391 Dumper(
392 { action => "create_$type",
393 borrowernumber => $self->{patron_id},
394 amount => $amount,
395 description => $description,
396 amountoutstanding => $amount,
397 accounttype => $account_type,
398 note => $note,
399 itemnumber => $item_id,
400 manager_id => $user_id,
401 branchcode => $library_id,
404 $interface
410 return $line;
413 =head3 add_debit
415 This method allows adding debits to a patron's account
417 my $debit_line = Koha::Account->new({ patron_id => $patron_id })->add_debit(
419 amount => $amount,
420 description => $description,
421 note => $note,
422 user_id => $user_id,
423 interface => $interface,
424 library_id => $library_id,
425 type => $debit_type,
426 item_id => $item_id,
427 issue_id => $issue_id
431 $debit_type can be any of:
432 - overdue
433 - lost_item
434 - new_card
435 - account
436 - account_renew
437 - sundry
438 - processing
439 - rent
440 - rent_daily
441 - rent_renewal
442 - rent_daily_renewal
443 - reserve
444 - manual
446 =cut
448 sub add_debit {
450 my ( $self, $params ) = @_;
452 # amount should always be a positive value
453 my $amount = $params->{amount};
455 unless ( $amount > 0 ) {
456 Koha::Exceptions::Account::AmountNotPositive->throw(
457 error => 'Debit amount passed is not positive'
461 my $description = $params->{description} // q{};
462 my $note = $params->{note} // q{};
463 my $user_id = $params->{user_id};
464 my $interface = $params->{interface};
465 my $library_id = $params->{library_id};
466 my $type = $params->{type};
467 my $item_id = $params->{item_id};
468 my $issue_id = $params->{issue_id};
470 unless ( $interface ) {
471 Koha::Exceptions::MissingParameter->throw(
472 error => 'The interface parameter is mandatory'
476 my $schema = Koha::Database->new->schema;
478 unless ( exists($Koha::Account::account_type_debit->{$type}) ) {
479 Koha::Exceptions::Account::UnrecognisedType->throw(
480 error => 'Type of debit not recognised'
484 my $account_type = $Koha::Account::account_type_debit->{$type};
486 my $line;
488 $schema->txn_do(
489 sub {
491 # Insert the account line
492 $line = Koha::Account::Line->new(
493 { borrowernumber => $self->{patron_id},
494 date => \'NOW()',
495 amount => $amount,
496 description => $description,
497 accounttype => $account_type,
498 amountoutstanding => $amount,
499 payment_type => undef,
500 note => $note,
501 manager_id => $user_id,
502 interface => $interface,
503 itemnumber => $item_id,
504 issue_id => $issue_id,
505 branchcode => $library_id,
506 ( $type eq 'overdue' ? ( status => 'UNRETURNED' ) : ()),
508 )->store();
510 # Record the account offset
511 my $account_offset = Koha::Account::Offset->new(
512 { debit_id => $line->id,
513 type => $Koha::Account::offset_type->{$type},
514 amount => $amount
516 )->store();
518 if ( C4::Context->preference("FinesLog") ) {
519 logaction(
520 "FINES", 'CREATE',
521 $self->{patron_id},
522 Dumper(
523 { action => "create_$type",
524 borrowernumber => $self->{patron_id},
525 amount => $amount,
526 description => $description,
527 amountoutstanding => $amount,
528 accounttype => $account_type,
529 note => $note,
530 itemnumber => $item_id,
531 manager_id => $user_id,
534 $interface
540 return $line;
543 =head3 balance
545 my $balance = $self->balance
547 Return the balance (sum of amountoutstanding columns)
549 =cut
551 sub balance {
552 my ($self) = @_;
553 return $self->lines->total_outstanding;
556 =head3 outstanding_debits
558 my $lines = Koha::Account->new({ patron_id => $patron_id })->outstanding_debits;
560 It returns the debit lines with outstanding amounts for the patron.
562 In scalar context, it returns a Koha::Account::Lines iterator. In list context, it will
563 return a list of Koha::Account::Line objects.
565 =cut
567 sub outstanding_debits {
568 my ($self) = @_;
570 return $self->lines->search(
572 amount => { '>' => 0 },
573 amountoutstanding => { '>' => 0 }
578 =head3 outstanding_credits
580 my $lines = Koha::Account->new({ patron_id => $patron_id })->outstanding_credits;
582 It returns the credit lines with outstanding amounts for the patron.
584 In scalar context, it returns a Koha::Account::Lines iterator. In list context, it will
585 return a list of Koha::Account::Line objects.
587 =cut
589 sub outstanding_credits {
590 my ($self) = @_;
592 return $self->lines->search(
594 amount => { '<' => 0 },
595 amountoutstanding => { '<' => 0 }
600 =head3 non_issues_charges
602 my $non_issues_charges = $self->non_issues_charges
604 Calculates amount immediately owing by the patron - non-issue charges.
606 Charges exempt from non-issue are:
607 * Res (holds) if HoldsInNoissuesCharge syspref is set to false
608 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
609 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
611 =cut
613 sub non_issues_charges {
614 my ($self) = @_;
616 # FIXME REMOVE And add a warning in the about page + update DB if length(MANUAL_INV) > 5
617 my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
619 my @not_fines;
620 push @not_fines, 'Res'
621 unless C4::Context->preference('HoldsInNoissuesCharge');
622 push @not_fines, 'Rent'
623 unless C4::Context->preference('RentalsInNoissuesCharge');
624 unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
625 my $dbh = C4::Context->dbh;
626 push @not_fines,
628 $dbh->selectcol_arrayref(q|
629 SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'
633 @not_fines = map { substr( $_, 0, $ACCOUNT_TYPE_LENGTH ) } uniq(@not_fines);
635 return $self->lines->search(
637 accounttype => { -not_in => \@not_fines }
639 )->total_outstanding;
642 =head3 lines
644 my $lines = $self->lines;
646 Return all credits and debits for the user, outstanding or otherwise
648 =cut
650 sub lines {
651 my ($self) = @_;
653 return Koha::Account::Lines->search(
655 borrowernumber => $self->{patron_id},
660 =head3 reconcile_balance
662 $account->reconcile_balance();
664 Find outstanding credits and use them to pay outstanding debits.
665 Currently, this implicitly uses the 'First In First Out' rule for
666 applying credits against debits.
668 =cut
670 sub reconcile_balance {
671 my ($self) = @_;
673 my $outstanding_debits = $self->outstanding_debits;
674 my $outstanding_credits = $self->outstanding_credits;
676 while ( $outstanding_debits->total_outstanding > 0
677 and my $credit = $outstanding_credits->next )
679 # there's both outstanding debits and credits
680 $credit->apply( { debits => $outstanding_debits } ); # applying credit, no special offset
682 $outstanding_debits = $self->outstanding_debits;
686 return $self;
691 =head2 Name mappings
693 =head3 $offset_type
695 =cut
697 our $offset_type = {
698 'credit' => 'Manual Credit',
699 'forgiven' => 'Writeoff',
700 'lost_item_return' => 'Lost Item',
701 'payment' => 'Payment',
702 'writeoff' => 'Writeoff',
703 'account' => 'Account Fee',
704 'account_renew' => 'Account Fee',
705 'reserve' => 'Reserve Fee',
706 'processing' => 'Processing Fee',
707 'lost_item' => 'Lost Item',
708 'rent' => 'Rental Fee',
709 'rent_daily' => 'Rental Fee',
710 'rent_renew' => 'Rental Fee',
711 'rent_daily_renew' => 'Rental Fee',
712 'overdue' => 'OVERDUE',
713 'manual_debit' => 'Manual Debit',
714 'hold_expired' => 'Hold Expired'
717 =head3 $account_type_credit
719 =cut
721 our $account_type_credit = {
722 'credit' => 'C',
723 'forgiven' => 'FOR',
724 'lost_item_return' => 'LOST_RETURN',
725 'payment' => 'Pay',
726 'writeoff' => 'W'
729 =head3 $account_type_debit
731 =cut
733 our $account_type_debit = {
734 'account' => 'ACCOUNT',
735 'account_renew' => 'ACCOUNT_RENEW',
736 'overdue' => 'OVERDUE',
737 'lost_item' => 'LOST',
738 'new_card' => 'N',
739 'sundry' => 'M',
740 'processing' => 'PF',
741 'rent' => 'RENT',
742 'rent_daily' => 'RENT_DAILY',
743 'rent_renew' => 'RENT_RENEW',
744 'rent_daily_renew' => 'RENT_DAILY_RENEW',
745 'reserve' => 'Res',
746 'manual_debit' => 'M',
747 'hold_expired' => 'HE'
750 =head1 AUTHORS
752 =encoding utf8
754 Kyle M Hall <kyle.m.hall@gmail.com>
755 Tomás Cohen Arazi <tomascohen@gmail.com>
756 Martin Renvoize <martin.renvoize@ptfs-europe.com>
758 =cut