Bug 21801: Make paycollect.pl pass library_id when calling ->pay
[koha.git] / Koha / Account.pm
blob4607fc2acb10a67b32ce7332d76e899c6d59b755
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 # Same logic exists in Koha::Account::Line::apply
112 if ( $new_amountoutstanding == 0 && $fine->itemnumber && $fine->accounttype && ( $fine->accounttype eq 'L' ) )
114 C4::Circulation::ReturnLostItem( $self->{patron_id}, $fine->itemnumber );
117 my $account_offset = Koha::Account::Offset->new(
119 debit_id => $fine->id,
120 type => $offset_type,
121 amount => $amount_to_pay * -1,
124 push( @account_offsets, $account_offset );
126 if ( C4::Context->preference("FinesLog") ) {
127 logaction(
128 "FINES", 'MODIFY',
129 $self->{patron_id},
130 Dumper(
132 action => 'fee_payment',
133 borrowernumber => $fine->borrowernumber,
134 old_amountoutstanding => $old_amountoutstanding,
135 new_amountoutstanding => 0,
136 amount_paid => $old_amountoutstanding,
137 accountlines_id => $fine->id,
138 manager_id => $manager_id,
139 note => $note,
142 $interface
144 push( @fines_paid, $fine->id );
148 # Were not passed a specific line to pay, or the payment was for more
149 # than the what was owed on the given line. In that case pay down other
150 # lines with remaining balance.
151 my @outstanding_fines;
152 @outstanding_fines = $self->lines->search(
154 amountoutstanding => { '>' => 0 },
156 ) if $balance_remaining > 0;
158 foreach my $fine (@outstanding_fines) {
159 my $amount_to_pay =
160 $fine->amountoutstanding > $balance_remaining
161 ? $balance_remaining
162 : $fine->amountoutstanding;
164 my $old_amountoutstanding = $fine->amountoutstanding;
165 $fine->amountoutstanding( $old_amountoutstanding - $amount_to_pay );
166 $fine->store();
168 if ( $fine->amountoutstanding == 0 && $fine->itemnumber && $fine->accounttype && ( $fine->accounttype eq 'L' ) )
170 C4::Circulation::ReturnLostItem( $self->{patron_id}, $fine->itemnumber );
173 my $account_offset = Koha::Account::Offset->new(
175 debit_id => $fine->id,
176 type => $offset_type,
177 amount => $amount_to_pay * -1,
180 push( @account_offsets, $account_offset );
182 if ( C4::Context->preference("FinesLog") ) {
183 logaction(
184 "FINES", 'MODIFY',
185 $self->{patron_id},
186 Dumper(
188 action => "fee_$type",
189 borrowernumber => $fine->borrowernumber,
190 old_amountoutstanding => $old_amountoutstanding,
191 new_amountoutstanding => $fine->amountoutstanding,
192 amount_paid => $amount_to_pay,
193 accountlines_id => $fine->id,
194 manager_id => $manager_id,
195 note => $note,
198 $interface
200 push( @fines_paid, $fine->id );
203 $balance_remaining = $balance_remaining - $amount_to_pay;
204 last unless $balance_remaining > 0;
207 $account_type ||=
208 $type eq 'writeoff' ? 'W'
209 : defined($sip) ? "Pay$sip"
210 : 'Pay';
212 $description ||= $type eq 'writeoff' ? 'Writeoff' : q{};
214 my $payment = Koha::Account::Line->new(
216 borrowernumber => $self->{patron_id},
217 date => dt_from_string(),
218 amount => 0 - $amount,
219 description => $description,
220 accounttype => $account_type,
221 payment_type => $payment_type,
222 amountoutstanding => 0 - $balance_remaining,
223 manager_id => $manager_id,
224 interface => $interface,
225 branchcode => $library_id,
226 note => $note,
228 )->store();
230 foreach my $o ( @account_offsets ) {
231 $o->credit_id( $payment->id() );
232 $o->store();
235 UpdateStats(
237 branch => $library_id,
238 type => $type,
239 amount => $amount,
240 borrowernumber => $self->{patron_id},
244 if ( C4::Context->preference("FinesLog") ) {
245 logaction(
246 "FINES", 'CREATE',
247 $self->{patron_id},
248 Dumper(
250 action => "create_$type",
251 borrowernumber => $self->{patron_id},
252 amount => 0 - $amount,
253 amountoutstanding => 0 - $balance_remaining,
254 accounttype => $account_type,
255 accountlines_paid => \@fines_paid,
256 manager_id => $manager_id,
259 $interface
263 if ( C4::Context->preference('UseEmailReceipts') ) {
264 if (
265 my $letter = C4::Letters::GetPreparedLetter(
266 module => 'circulation',
267 letter_code => uc("ACCOUNT_$type"),
268 message_transport_type => 'email',
269 lang => $patron->lang,
270 tables => {
271 borrowers => $self->{patron_id},
272 branches => $self->{library_id},
274 substitute => {
275 credit => $payment,
276 offsets => \@account_offsets,
281 C4::Letters::EnqueueLetter(
283 letter => $letter,
284 borrowernumber => $self->{patron_id},
285 message_transport_type => 'email',
287 ) or warn "can't enqueue letter $letter";
291 return $payment->id;
294 =head3 add_credit
296 This method allows adding credits to a patron's account
298 my $credit_line = Koha::Account->new({ patron_id => $patron_id })->add_credit(
300 amount => $amount,
301 description => $description,
302 note => $note,
303 user_id => $user_id,
304 interface => $interface,
305 library_id => $library_id,
306 sip => $sip,
307 payment_type => $payment_type,
308 type => $credit_type,
309 item_id => $item_id
313 $credit_type can be any of:
314 - 'credit'
315 - 'payment'
316 - 'forgiven'
317 - 'lost_item_return'
318 - 'writeoff'
320 =cut
322 sub add_credit {
324 my ( $self, $params ) = @_;
326 # amount is passed as a positive value, but we store credit as negative values
327 my $amount = $params->{amount} * -1;
328 my $description = $params->{description} // q{};
329 my $note = $params->{note} // q{};
330 my $user_id = $params->{user_id};
331 my $interface = $params->{interface};
332 my $library_id = $params->{library_id};
333 my $sip = $params->{sip};
334 my $payment_type = $params->{payment_type};
335 my $type = $params->{type} || 'payment';
336 my $item_id = $params->{item_id};
338 unless ( $interface ) {
339 Koha::Exceptions::MissingParameter->throw(
340 error => 'The interface parameter is mandatory'
344 my $schema = Koha::Database->new->schema;
346 my $account_type = $Koha::Account::account_type_credit->{$type};
347 $account_type .= $sip
348 if defined $sip &&
349 $type eq 'payment';
351 my $line;
353 $schema->txn_do(
354 sub {
356 # Insert the account line
357 $line = Koha::Account::Line->new(
358 { borrowernumber => $self->{patron_id},
359 date => \'NOW()',
360 amount => $amount,
361 description => $description,
362 accounttype => $account_type,
363 amountoutstanding => $amount,
364 payment_type => $payment_type,
365 note => $note,
366 manager_id => $user_id,
367 interface => $interface,
368 branchcode => $library_id,
369 itemnumber => $item_id,
371 )->store();
373 # Record the account offset
374 my $account_offset = Koha::Account::Offset->new(
375 { credit_id => $line->id,
376 type => $Koha::Account::offset_type->{$type},
377 amount => $amount
379 )->store();
381 UpdateStats(
382 { branch => $library_id,
383 type => $type,
384 amount => $amount,
385 borrowernumber => $self->{patron_id},
387 ) if grep { $type eq $_ } ('payment', 'writeoff') ;
389 if ( C4::Context->preference("FinesLog") ) {
390 logaction(
391 "FINES", 'CREATE',
392 $self->{patron_id},
393 Dumper(
394 { action => "create_$type",
395 borrowernumber => $self->{patron_id},
396 amount => $amount,
397 description => $description,
398 amountoutstanding => $amount,
399 accounttype => $account_type,
400 note => $note,
401 itemnumber => $item_id,
402 manager_id => $user_id,
403 branchcode => $library_id,
406 $interface
412 return $line;
415 =head3 add_debit
417 This method allows adding debits to a patron's account
419 my $debit_line = Koha::Account->new({ patron_id => $patron_id })->add_debit(
421 amount => $amount,
422 description => $description,
423 note => $note,
424 user_id => $user_id,
425 interface => $interface,
426 library_id => $library_id,
427 type => $debit_type,
428 item_id => $item_id,
429 issue_id => $issue_id
433 $debit_type can be any of:
434 - overdue
435 - lost_item
436 - new_card
437 - account
438 - sundry
439 - processing
440 - rent
441 - reserve
442 - manual
444 =cut
446 sub add_debit {
448 my ( $self, $params ) = @_;
450 # amount should always be a positive value
451 my $amount = $params->{amount};
453 unless ( $amount > 0 ) {
454 Koha::Exceptions::Account::AmountNotPositive->throw(
455 error => 'Debit amount passed is not positive'
459 my $description = $params->{description} // q{};
460 my $note = $params->{note} // q{};
461 my $user_id = $params->{user_id};
462 my $interface = $params->{interface};
463 my $library_id = $params->{library_id};
464 my $type = $params->{type};
465 my $item_id = $params->{item_id};
466 my $issue_id = $params->{issue_id};
468 unless ( $interface ) {
469 Koha::Exceptions::MissingParameter->throw(
470 error => 'The interface parameter is mandatory'
474 my $schema = Koha::Database->new->schema;
476 unless ( exists($Koha::Account::account_type_debit->{$type}) ) {
477 Koha::Exceptions::Account::UnrecognisedType->throw(
478 error => 'Type of debit not recognised'
482 my $account_type = $Koha::Account::account_type_debit->{$type};
484 my $line;
486 $schema->txn_do(
487 sub {
489 # Insert the account line
490 $line = Koha::Account::Line->new(
491 { borrowernumber => $self->{patron_id},
492 date => \'NOW()',
493 amount => $amount,
494 description => $description,
495 accounttype => $account_type,
496 amountoutstanding => $amount,
497 payment_type => undef,
498 note => $note,
499 manager_id => $user_id,
500 interface => $interface,
501 itemnumber => $item_id,
502 issue_id => $issue_id,
503 branchcode => $library_id,
504 ( $type eq 'overdue' ? ( status => 'UNRETURNED' ) : ()),
506 )->store();
508 # Record the account offset
509 my $account_offset = Koha::Account::Offset->new(
510 { debit_id => $line->id,
511 type => $Koha::Account::offset_type->{$type},
512 amount => $amount
514 )->store();
516 if ( C4::Context->preference("FinesLog") ) {
517 logaction(
518 "FINES", 'CREATE',
519 $self->{patron_id},
520 Dumper(
521 { action => "create_$type",
522 borrowernumber => $self->{patron_id},
523 amount => $amount,
524 description => $description,
525 amountoutstanding => $amount,
526 accounttype => $account_type,
527 note => $note,
528 itemnumber => $item_id,
529 manager_id => $user_id,
532 $interface
538 return $line;
541 =head3 balance
543 my $balance = $self->balance
545 Return the balance (sum of amountoutstanding columns)
547 =cut
549 sub balance {
550 my ($self) = @_;
551 return $self->lines->total_outstanding;
554 =head3 outstanding_debits
556 my $lines = Koha::Account->new({ patron_id => $patron_id })->outstanding_debits;
558 It returns the debit lines with outstanding amounts for the patron.
560 In scalar context, it returns a Koha::Account::Lines iterator. In list context, it will
561 return a list of Koha::Account::Line objects.
563 =cut
565 sub outstanding_debits {
566 my ($self) = @_;
568 return $self->lines->search(
570 amount => { '>' => 0 },
571 amountoutstanding => { '>' => 0 }
576 =head3 outstanding_credits
578 my $lines = Koha::Account->new({ patron_id => $patron_id })->outstanding_credits;
580 It returns the credit lines with outstanding amounts for the patron.
582 In scalar context, it returns a Koha::Account::Lines iterator. In list context, it will
583 return a list of Koha::Account::Line objects.
585 =cut
587 sub outstanding_credits {
588 my ($self) = @_;
590 return $self->lines->search(
592 amount => { '<' => 0 },
593 amountoutstanding => { '<' => 0 }
598 =head3 non_issues_charges
600 my $non_issues_charges = $self->non_issues_charges
602 Calculates amount immediately owing by the patron - non-issue charges.
604 Charges exempt from non-issue are:
605 * Res (holds) if HoldsInNoissuesCharge syspref is set to false
606 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
607 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
609 =cut
611 sub non_issues_charges {
612 my ($self) = @_;
614 # FIXME REMOVE And add a warning in the about page + update DB if length(MANUAL_INV) > 5
615 my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
617 my @not_fines;
618 push @not_fines, 'Res'
619 unless C4::Context->preference('HoldsInNoissuesCharge');
620 push @not_fines, 'Rent'
621 unless C4::Context->preference('RentalsInNoissuesCharge');
622 unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
623 my $dbh = C4::Context->dbh;
624 push @not_fines,
626 $dbh->selectcol_arrayref(q|
627 SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'
631 @not_fines = map { substr( $_, 0, $ACCOUNT_TYPE_LENGTH ) } uniq(@not_fines);
633 return $self->lines->search(
635 accounttype => { -not_in => \@not_fines }
637 )->total_outstanding;
640 =head3 lines
642 my $lines = $self->lines;
644 Return all credits and debits for the user, outstanding or otherwise
646 =cut
648 sub lines {
649 my ($self) = @_;
651 return Koha::Account::Lines->search(
653 borrowernumber => $self->{patron_id},
658 =head3 reconcile_balance
660 $account->reconcile_balance();
662 Find outstanding credits and use them to pay outstanding debits.
663 Currently, this implicitly uses the 'First In First Out' rule for
664 applying credits against debits.
666 =cut
668 sub reconcile_balance {
669 my ($self) = @_;
671 my $outstanding_debits = $self->outstanding_debits;
672 my $outstanding_credits = $self->outstanding_credits;
674 while ( $outstanding_debits->total_outstanding > 0
675 and my $credit = $outstanding_credits->next )
677 # there's both outstanding debits and credits
678 $credit->apply( { debits => $outstanding_debits } ); # applying credit, no special offset
680 $outstanding_debits = $self->outstanding_debits;
684 return $self;
689 =head2 Name mappings
691 =head3 $offset_type
693 =cut
695 our $offset_type = {
696 'credit' => 'Manual Credit',
697 'forgiven' => 'Writeoff',
698 'lost_item_return' => 'Lost Item',
699 'payment' => 'Payment',
700 'writeoff' => 'Writeoff',
701 'account' => 'Account Fee',
702 'reserve' => 'Reserve Fee',
703 'processing' => 'Processing Fee',
704 'lost_item' => 'Lost Item',
705 'rent' => 'Rental Fee',
706 'overdue' => 'OVERDUE',
707 'manual_debit' => 'Manual Debit',
708 'hold_expired' => 'Hold Expired'
711 =head3 $account_type_credit
713 =cut
715 our $account_type_credit = {
716 'credit' => 'C',
717 'forgiven' => 'FOR',
718 'lost_item_return' => 'CR',
719 'payment' => 'Pay',
720 'writeoff' => 'W'
723 =head3 $account_type_debit
725 =cut
727 our $account_type_debit = {
728 'account' => 'A',
729 'overdue' => 'OVERDUE',
730 'lost_item' => 'L',
731 'new_card' => 'N',
732 'sundry' => 'M',
733 'processing' => 'PF',
734 'rent' => 'Rent',
735 'reserve' => 'Res',
736 'manual_debit' => 'M',
737 'hold_expired' => 'HE'
740 =head1 AUTHORS
742 =encoding utf8
744 Kyle M Hall <kyle.m.hall@gmail.com>
745 Tomás Cohen Arazi <tomascohen@gmail.com>
746 Martin Renvoize <martin.renvoize@ptfs-europe.com>
748 =cut