Bug 24031: Add safety checks in Koha::Plugins::call
[koha.git] / Koha / Account.pm
blob2a63856b524fbf4e9f9227d1c39636d8bac2b691
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 );
25 use Try::Tiny;
27 use C4::Circulation qw( ReturnLostItem CanBookBeRenewed AddRenewal );
28 use C4::Letters;
29 use C4::Log qw( logaction );
30 use C4::Stats qw( UpdateStats );
31 use C4::Overdues qw(GetFine);
33 use Koha::Patrons;
34 use Koha::Account::Lines;
35 use Koha::Account::Offsets;
36 use Koha::Account::DebitTypes;
37 use Koha::DateUtils qw( dt_from_string );
38 use Koha::Exceptions;
39 use Koha::Exceptions::Account;
41 =head1 NAME
43 Koha::Accounts - Module for managing payments and fees for patrons
45 =cut
47 sub new {
48 my ( $class, $params ) = @_;
50 Carp::croak("No patron id passed in!") unless $params->{patron_id};
52 return bless( $params, $class );
55 =head2 pay
57 This method allows payments to be made against fees/fines
59 Koha::Account->new( { patron_id => $borrowernumber } )->pay(
61 amount => $amount,
62 note => $note,
63 description => $description,
64 library_id => $branchcode,
65 lines => $lines, # Arrayref of Koha::Account::Line objects to pay
66 credit_type => $type, # credit_type_code code
67 offset_type => $offset_type, # offset type code
68 item_id => $itemnumber, # pass the itemnumber if this is a credit pertianing to a specific item (i.e LOST_FOUND)
72 =cut
74 sub pay {
75 my ( $self, $params ) = @_;
77 my $amount = $params->{amount};
78 my $description = $params->{description};
79 my $note = $params->{note} || q{};
80 my $library_id = $params->{library_id};
81 my $lines = $params->{lines};
82 my $type = $params->{type} || 'PAYMENT';
83 my $payment_type = $params->{payment_type} || undef;
84 my $credit_type = $params->{credit_type};
85 my $offset_type = $params->{offset_type} || $type eq 'WRITEOFF' ? 'Writeoff' : 'Payment';
86 my $cash_register = $params->{cash_register};
87 my $item_id = $params->{item_id};
89 my $userenv = C4::Context->userenv;
91 $credit_type ||=
92 $type eq 'WRITEOFF'
93 ? 'WRITEOFF'
94 : 'PAYMENT';
96 my $patron = Koha::Patrons->find( $self->{patron_id} );
98 my $manager_id = $userenv ? $userenv->{number} : 0;
99 my $interface = $params ? ( $params->{interface} || C4::Context->interface ) : C4::Context->interface;
100 Koha::Exceptions::Account::RegisterRequired->throw()
101 if ( C4::Context->preference("UseCashRegisters")
102 && defined($payment_type)
103 && ( $payment_type eq 'CASH' )
104 && !defined($cash_register) );
106 my @fines_paid; # List of account lines paid on with this payment
108 # The outcome of any attempted item renewals as a result of fines being
109 # paid off
110 my $renew_outcomes = [];
112 my $balance_remaining = $amount; # Set it now so we can adjust the amount if necessary
113 $balance_remaining ||= 0;
115 my @account_offsets;
117 # We were passed a specific line to pay
118 foreach my $fine ( @$lines ) {
119 my $amount_to_pay =
120 $fine->amountoutstanding > $balance_remaining
121 ? $balance_remaining
122 : $fine->amountoutstanding;
124 my $old_amountoutstanding = $fine->amountoutstanding;
125 my $new_amountoutstanding = $old_amountoutstanding - $amount_to_pay;
126 $fine->amountoutstanding($new_amountoutstanding)->store();
127 $balance_remaining = $balance_remaining - $amount_to_pay;
129 # Attempt to renew the item associated with this debit if
130 # appropriate
131 if ($fine->renewable) {
132 # We're ignoring the definition of $interface above, by all
133 # accounts we can't rely on C4::Context::interface, so here
134 # we're only using what we've been explicitly passed
135 my $outcome = $fine->renew_item({ interface => $interface });
136 push @{$renew_outcomes}, $outcome if $outcome;
139 # Same logic exists in Koha::Account::Line::apply
140 if ( C4::Context->preference('MarkLostItemsAsReturned') =~ m|onpayment|
141 && $fine->debit_type_code
142 && $fine->debit_type_code eq 'LOST'
143 && $new_amountoutstanding == 0
144 && $fine->itemnumber
145 && !( $credit_type eq 'LOST_FOUND'
146 && $item_id == $fine->itemnumber ) )
148 C4::Circulation::ReturnLostItem( $self->{patron_id},
149 $fine->itemnumber );
152 my $account_offset = Koha::Account::Offset->new(
154 debit_id => $fine->id,
155 type => $offset_type,
156 amount => $amount_to_pay * -1,
159 push( @account_offsets, $account_offset );
161 if ( C4::Context->preference("FinesLog") ) {
162 logaction(
163 "FINES", 'MODIFY',
164 $self->{patron_id},
165 Dumper(
167 action => 'fee_payment',
168 borrowernumber => $fine->borrowernumber,
169 old_amountoutstanding => $old_amountoutstanding,
170 new_amountoutstanding => 0,
171 amount_paid => $old_amountoutstanding,
172 accountlines_id => $fine->id,
173 manager_id => $manager_id,
174 note => $note,
177 $interface
179 push( @fines_paid, $fine->id );
183 # Were not passed a specific line to pay, or the payment was for more
184 # than the what was owed on the given line. In that case pay down other
185 # lines with remaining balance.
186 my @outstanding_fines;
187 @outstanding_fines = $self->lines->search(
189 amountoutstanding => { '>' => 0 },
191 ) if $balance_remaining > 0;
193 foreach my $fine (@outstanding_fines) {
194 my $amount_to_pay =
195 $fine->amountoutstanding > $balance_remaining
196 ? $balance_remaining
197 : $fine->amountoutstanding;
199 my $old_amountoutstanding = $fine->amountoutstanding;
200 $fine->amountoutstanding( $old_amountoutstanding - $amount_to_pay );
201 $fine->store();
203 # If we need to make a note of the item associated with this line,
204 # in order that we can potentially renew it, do so.
205 my $amt = $old_amountoutstanding - $amount_to_pay;
206 if ($fine->renewable) {
207 my $outcome = $fine->renew_item;
208 push @{$renew_outcomes}, $outcome;
211 if ( C4::Context->preference('MarkLostItemsAsReturned') =~ m|onpayment|
212 && $fine->debit_type_code
213 && $fine->debit_type_code eq 'LOST'
214 && $fine->amountoutstanding == 0
215 && $fine->itemnumber
216 && !( $credit_type eq 'LOST_FOUND'
217 && $item_id == $fine->itemnumber ) )
219 C4::Circulation::ReturnLostItem( $self->{patron_id},
220 $fine->itemnumber );
223 my $account_offset = Koha::Account::Offset->new(
225 debit_id => $fine->id,
226 type => $offset_type,
227 amount => $amount_to_pay * -1,
230 push( @account_offsets, $account_offset );
232 if ( C4::Context->preference("FinesLog") ) {
233 logaction(
234 "FINES", 'MODIFY',
235 $self->{patron_id},
236 Dumper(
238 action => "fee_$type",
239 borrowernumber => $fine->borrowernumber,
240 old_amountoutstanding => $old_amountoutstanding,
241 new_amountoutstanding => $fine->amountoutstanding,
242 amount_paid => $amount_to_pay,
243 accountlines_id => $fine->id,
244 manager_id => $manager_id,
245 note => $note,
248 $interface
250 push( @fines_paid, $fine->id );
253 $balance_remaining = $balance_remaining - $amount_to_pay;
254 last unless $balance_remaining > 0;
257 $description ||= $type eq 'WRITEOFF' ? 'Writeoff' : q{};
259 my $payment = Koha::Account::Line->new(
261 borrowernumber => $self->{patron_id},
262 date => dt_from_string(),
263 amount => 0 - $amount,
264 description => $description,
265 credit_type_code => $credit_type,
266 payment_type => $payment_type,
267 amountoutstanding => 0 - $balance_remaining,
268 manager_id => $manager_id,
269 interface => $interface,
270 branchcode => $library_id,
271 register_id => $cash_register,
272 note => $note,
273 itemnumber => $item_id,
275 )->store();
277 foreach my $o ( @account_offsets ) {
278 $o->credit_id( $payment->id() );
279 $o->store();
282 C4::Stats::UpdateStats(
284 branch => $library_id,
285 type => lc($type),
286 amount => $amount,
287 borrowernumber => $self->{patron_id},
291 if ( C4::Context->preference("FinesLog") ) {
292 logaction(
293 "FINES", 'CREATE',
294 $self->{patron_id},
295 Dumper(
297 action => "create_$type",
298 borrowernumber => $self->{patron_id},
299 amount => 0 - $amount,
300 amountoutstanding => 0 - $balance_remaining,
301 credit_type_code => $credit_type,
302 accountlines_paid => \@fines_paid,
303 manager_id => $manager_id,
306 $interface
310 if ( C4::Context->preference('UseEmailReceipts') ) {
311 if (
312 my $letter = C4::Letters::GetPreparedLetter(
313 module => 'circulation',
314 letter_code => uc("ACCOUNT_$type"),
315 message_transport_type => 'email',
316 lang => $patron->lang,
317 tables => {
318 borrowers => $self->{patron_id},
319 branches => $library_id,
321 substitute => {
322 credit => $payment,
323 offsets => \@account_offsets,
328 C4::Letters::EnqueueLetter(
330 letter => $letter,
331 borrowernumber => $self->{patron_id},
332 message_transport_type => 'email',
334 ) or warn "can't enqueue letter $letter";
338 return { payment_id => $payment->id, renew_result => $renew_outcomes };
341 =head3 add_credit
343 This method allows adding credits to a patron's account
345 my $credit_line = Koha::Account->new({ patron_id => $patron_id })->add_credit(
347 amount => $amount,
348 description => $description,
349 note => $note,
350 user_id => $user_id,
351 interface => $interface,
352 library_id => $library_id,
353 payment_type => $payment_type,
354 type => $credit_type,
355 item_id => $item_id
359 $credit_type can be any of:
360 - 'CREDIT'
361 - 'PAYMENT'
362 - 'FORGIVEN'
363 - 'LOST_FOUND'
364 - 'WRITEOFF'
366 =cut
368 sub add_credit {
370 my ( $self, $params ) = @_;
372 # check for mandatory params
373 my @mandatory = ( 'interface', 'amount' );
374 for my $param (@mandatory) {
375 unless ( defined( $params->{$param} ) ) {
376 Koha::Exceptions::MissingParameter->throw(
377 error => "The $param parameter is mandatory" );
381 # amount should always be passed as a positive value
382 my $amount = $params->{amount} * -1;
383 unless ( $amount < 0 ) {
384 Koha::Exceptions::Account::AmountNotPositive->throw(
385 error => 'Debit amount passed is not positive' );
388 my $description = $params->{description} // q{};
389 my $note = $params->{note} // q{};
390 my $user_id = $params->{user_id};
391 my $interface = $params->{interface};
392 my $library_id = $params->{library_id};
393 my $cash_register = $params->{cash_register};
394 my $payment_type = $params->{payment_type};
395 my $credit_type = $params->{type} || 'PAYMENT';
396 my $item_id = $params->{item_id};
398 Koha::Exceptions::Account::RegisterRequired->throw()
399 if ( C4::Context->preference("UseCashRegisters")
400 && defined($payment_type)
401 && ( $payment_type eq 'CASH' )
402 && !defined($cash_register) );
404 my $line;
405 my $schema = Koha::Database->new->schema;
406 try {
407 $schema->txn_do(
408 sub {
410 # Insert the account line
411 $line = Koha::Account::Line->new(
413 borrowernumber => $self->{patron_id},
414 date => \'NOW()',
415 amount => $amount,
416 description => $description,
417 credit_type_code => $credit_type,
418 amountoutstanding => $amount,
419 payment_type => $payment_type,
420 note => $note,
421 manager_id => $user_id,
422 interface => $interface,
423 branchcode => $library_id,
424 register_id => $cash_register,
425 itemnumber => $item_id,
427 )->store();
429 # Record the account offset
430 my $account_offset = Koha::Account::Offset->new(
432 credit_id => $line->id,
433 type => $Koha::Account::offset_type->{$credit_type} // $Koha::Account::offset_type->{CREDIT},
434 amount => $amount
436 )->store();
438 C4::Stats::UpdateStats(
440 branch => $library_id,
441 type => lc($credit_type),
442 amount => $amount,
443 borrowernumber => $self->{patron_id},
445 ) if grep { $credit_type eq $_ } ( 'PAYMENT', 'WRITEOFF' );
447 if ( C4::Context->preference("FinesLog") ) {
448 logaction(
449 "FINES", 'CREATE',
450 $self->{patron_id},
451 Dumper(
453 action => "create_$credit_type",
454 borrowernumber => $self->{patron_id},
455 amount => $amount,
456 description => $description,
457 amountoutstanding => $amount,
458 credit_type_code => $credit_type,
459 note => $note,
460 itemnumber => $item_id,
461 manager_id => $user_id,
462 branchcode => $library_id,
465 $interface
471 catch {
472 if ( ref($_) eq 'Koha::Exceptions::Object::FKConstraint' ) {
473 if ( $_->broken_fk eq 'credit_type_code' ) {
474 Koha::Exceptions::Account::UnrecognisedType->throw(
475 error => 'Type of credit not recognised' );
477 else {
478 $_->rethrow;
483 return $line;
486 =head3 add_debit
488 This method allows adding debits to a patron's account
490 my $debit_line = Koha::Account->new({ patron_id => $patron_id })->add_debit(
492 amount => $amount,
493 description => $description,
494 note => $note,
495 user_id => $user_id,
496 interface => $interface,
497 library_id => $library_id,
498 type => $debit_type,
499 item_id => $item_id,
500 issue_id => $issue_id
504 $debit_type can be any of:
505 - ACCOUNT
506 - ACCOUNT_RENEW
507 - RESERVE_EXPIRED
508 - LOST
509 - sundry
510 - NEW_CARD
511 - OVERDUE
512 - PROCESSING
513 - RENT
514 - RENT_DAILY
515 - RENT_RENEW
516 - RENT_DAILY_RENEW
517 - RESERVE
519 =cut
521 sub add_debit {
523 my ( $self, $params ) = @_;
525 # check for mandatory params
526 my @mandatory = ( 'interface', 'type', 'amount' );
527 for my $param (@mandatory) {
528 unless ( defined( $params->{$param} ) ) {
529 Koha::Exceptions::MissingParameter->throw(
530 error => "The $param parameter is mandatory" );
534 # amount should always be a positive value
535 my $amount = $params->{amount};
536 unless ( $amount > 0 ) {
537 Koha::Exceptions::Account::AmountNotPositive->throw(
538 error => 'Debit amount passed is not positive' );
541 my $description = $params->{description} // q{};
542 my $note = $params->{note} // q{};
543 my $user_id = $params->{user_id};
544 my $interface = $params->{interface};
545 my $library_id = $params->{library_id};
546 my $debit_type = $params->{type};
547 my $item_id = $params->{item_id};
548 my $issue_id = $params->{issue_id};
549 my $offset_type = $Koha::Account::offset_type->{$debit_type} // 'Manual Debit';
551 my $line;
552 my $schema = Koha::Database->new->schema;
553 try {
554 $schema->txn_do(
555 sub {
557 # Insert the account line
558 $line = Koha::Account::Line->new(
560 borrowernumber => $self->{patron_id},
561 date => \'NOW()',
562 amount => $amount,
563 description => $description,
564 debit_type_code => $debit_type,
565 amountoutstanding => $amount,
566 payment_type => undef,
567 note => $note,
568 manager_id => $user_id,
569 interface => $interface,
570 itemnumber => $item_id,
571 issue_id => $issue_id,
572 branchcode => $library_id,
574 $debit_type eq 'OVERDUE'
575 ? ( status => 'UNRETURNED' )
576 : ()
579 )->store();
581 # Record the account offset
582 my $account_offset = Koha::Account::Offset->new(
584 debit_id => $line->id,
585 type => $offset_type,
586 amount => $amount
588 )->store();
590 if ( C4::Context->preference("FinesLog") ) {
591 logaction(
592 "FINES", 'CREATE',
593 $self->{patron_id},
594 Dumper(
596 action => "create_$debit_type",
597 borrowernumber => $self->{patron_id},
598 amount => $amount,
599 description => $description,
600 amountoutstanding => $amount,
601 debit_type_code => $debit_type,
602 note => $note,
603 itemnumber => $item_id,
604 manager_id => $user_id,
607 $interface
613 catch {
614 if ( ref($_) eq 'Koha::Exceptions::Object::FKConstraint' ) {
615 if ( $_->broken_fk eq 'debit_type_code' ) {
616 Koha::Exceptions::Account::UnrecognisedType->throw(
617 error => 'Type of debit not recognised' );
619 else {
620 $_->rethrow;
625 return $line;
628 =head3 balance
630 my $balance = $self->balance
632 Return the balance (sum of amountoutstanding columns)
634 =cut
636 sub balance {
637 my ($self) = @_;
638 return $self->lines->total_outstanding;
641 =head3 outstanding_debits
643 my $lines = Koha::Account->new({ patron_id => $patron_id })->outstanding_debits;
645 It returns the debit lines with outstanding amounts for the patron.
647 In scalar context, it returns a Koha::Account::Lines iterator. In list context, it will
648 return a list of Koha::Account::Line objects.
650 =cut
652 sub outstanding_debits {
653 my ($self) = @_;
655 return $self->lines->search(
657 amount => { '>' => 0 },
658 amountoutstanding => { '>' => 0 }
663 =head3 outstanding_credits
665 my $lines = Koha::Account->new({ patron_id => $patron_id })->outstanding_credits;
667 It returns the credit lines with outstanding amounts for the patron.
669 In scalar context, it returns a Koha::Account::Lines iterator. In list context, it will
670 return a list of Koha::Account::Line objects.
672 =cut
674 sub outstanding_credits {
675 my ($self) = @_;
677 return $self->lines->search(
679 amount => { '<' => 0 },
680 amountoutstanding => { '<' => 0 }
685 =head3 non_issues_charges
687 my $non_issues_charges = $self->non_issues_charges
689 Calculates amount immediately owing by the patron - non-issue charges.
691 Charges exempt from non-issue are:
692 * Res (holds) if HoldsInNoissuesCharge syspref is set to false
693 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
694 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
696 =cut
698 sub non_issues_charges {
699 my ($self) = @_;
701 #NOTE: With bug 23049 these preferences could be moved to being attached
702 #to individual debit types to give more flexability and specificity.
703 my @not_fines;
704 push @not_fines, 'RESERVE'
705 unless C4::Context->preference('HoldsInNoissuesCharge');
706 push @not_fines, ( 'RENT', 'RENT_DAILY', 'RENT_RENEW', 'RENT_DAILY_RENEW' )
707 unless C4::Context->preference('RentalsInNoissuesCharge');
708 unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
709 my @man_inv = Koha::Account::DebitTypes->search({ is_system => 0 })->get_column('code');
710 push @not_fines, @man_inv;
713 return $self->lines->search(
715 debit_type_code => { -not_in => \@not_fines }
717 )->total_outstanding;
720 =head3 lines
722 my $lines = $self->lines;
724 Return all credits and debits for the user, outstanding or otherwise
726 =cut
728 sub lines {
729 my ($self) = @_;
731 return Koha::Account::Lines->search(
733 borrowernumber => $self->{patron_id},
738 =head3 reconcile_balance
740 $account->reconcile_balance();
742 Find outstanding credits and use them to pay outstanding debits.
743 Currently, this implicitly uses the 'First In First Out' rule for
744 applying credits against debits.
746 =cut
748 sub reconcile_balance {
749 my ($self) = @_;
751 my $outstanding_debits = $self->outstanding_debits;
752 my $outstanding_credits = $self->outstanding_credits;
754 while ( $outstanding_debits->total_outstanding > 0
755 and my $credit = $outstanding_credits->next )
757 # there's both outstanding debits and credits
758 $credit->apply( { debits => [ $outstanding_debits->as_list ] } ); # applying credit, no special offset
760 $outstanding_debits = $self->outstanding_debits;
764 return $self;
769 =head2 Name mappings
771 =head3 $offset_type
773 =cut
775 our $offset_type = {
776 'CREDIT' => 'Manual Credit',
777 'FORGIVEN' => 'Writeoff',
778 'LOST_FOUND' => 'Lost Item Found',
779 'PAYMENT' => 'Payment',
780 'WRITEOFF' => 'Writeoff',
781 'ACCOUNT' => 'Account Fee',
782 'ACCOUNT_RENEW' => 'Account Fee',
783 'RESERVE' => 'Reserve Fee',
784 'PROCESSING' => 'Processing Fee',
785 'LOST' => 'Lost Item',
786 'RENT' => 'Rental Fee',
787 'RENT_DAILY' => 'Rental Fee',
788 'RENT_RENEW' => 'Rental Fee',
789 'RENT_DAILY_RENEW' => 'Rental Fee',
790 'OVERDUE' => 'OVERDUE',
791 'RESERVE_EXPIRED' => 'Hold Expired'
794 =head1 AUTHORS
796 =encoding utf8
798 Kyle M Hall <kyle.m.hall@gmail.com>
799 Tomás Cohen Arazi <tomascohen@gmail.com>
800 Martin Renvoize <martin.renvoize@ptfs-europe.com>
802 =cut