Bug 21846: Add Koha::Tags::Approval(s) and Koha::Tags::Index(es)
[koha.git] / Koha / Account.pm
blob2bcd062d7d3feafbf13c989391f0f3cb2f701d91
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::Account;
37 =head1 NAME
39 Koha::Accounts - Module for managing payments and fees for patrons
41 =cut
43 sub new {
44 my ( $class, $params ) = @_;
46 Carp::croak("No patron id passed in!") unless $params->{patron_id};
48 return bless( $params, $class );
51 =head2 pay
53 This method allows payments to be made against fees/fines
55 Koha::Account->new( { patron_id => $borrowernumber } )->pay(
57 amount => $amount,
58 sip => $sipmode,
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 $sip = $params->{sip};
75 my $description = $params->{description};
76 my $note = $params->{note} || q{};
77 my $library_id = $params->{library_id};
78 my $lines = $params->{lines};
79 my $type = $params->{type} || 'payment';
80 my $payment_type = $params->{payment_type} || undef;
81 my $account_type = $params->{account_type};
82 my $offset_type = $params->{offset_type} || $type eq 'writeoff' ? 'Writeoff' : 'Payment';
84 my $userenv = C4::Context->userenv;
86 my $patron = Koha::Patrons->find( $self->{patron_id} );
88 # We should remove accountno, it is no longer needed
89 my $last = $self->lines->search(
90 {},
91 { order_by => 'accountno' } )->next();
92 my $accountno = $last ? $last->accountno + 1 : 1;
94 my $manager_id = $userenv ? $userenv->{number} : 0;
96 my @fines_paid; # List of account lines paid on with this payment
98 my $balance_remaining = $amount; # Set it now so we can adjust the amount if necessary
99 $balance_remaining ||= 0;
101 my @account_offsets;
103 # We were passed a specific line to pay
104 foreach my $fine ( @$lines ) {
105 my $amount_to_pay =
106 $fine->amountoutstanding > $balance_remaining
107 ? $balance_remaining
108 : $fine->amountoutstanding;
110 my $old_amountoutstanding = $fine->amountoutstanding;
111 my $new_amountoutstanding = $old_amountoutstanding - $amount_to_pay;
112 $fine->amountoutstanding($new_amountoutstanding)->store();
113 $balance_remaining = $balance_remaining - $amount_to_pay;
115 if ( $fine->itemnumber && $fine->accounttype && ( $fine->accounttype eq 'Rep' || $fine->accounttype eq 'L' ) )
117 C4::Circulation::ReturnLostItem( $self->{patron_id}, $fine->itemnumber );
120 my $account_offset = Koha::Account::Offset->new(
122 debit_id => $fine->id,
123 type => $offset_type,
124 amount => $amount_to_pay * -1,
127 push( @account_offsets, $account_offset );
129 if ( C4::Context->preference("FinesLog") ) {
130 logaction(
131 "FINES", 'MODIFY',
132 $self->{patron_id},
133 Dumper(
135 action => 'fee_payment',
136 borrowernumber => $fine->borrowernumber,
137 old_amountoutstanding => $old_amountoutstanding,
138 new_amountoutstanding => 0,
139 amount_paid => $old_amountoutstanding,
140 accountlines_id => $fine->id,
141 accountno => $fine->accountno,
142 manager_id => $manager_id,
143 note => $note,
147 push( @fines_paid, $fine->id );
151 # Were not passed a specific line to pay, or the payment was for more
152 # than the what was owed on the given line. In that case pay down other
153 # lines with remaining balance.
154 my @outstanding_fines;
155 @outstanding_fines = $self->lines->search(
157 amountoutstanding => { '>' => 0 },
159 ) if $balance_remaining > 0;
161 foreach my $fine (@outstanding_fines) {
162 my $amount_to_pay =
163 $fine->amountoutstanding > $balance_remaining
164 ? $balance_remaining
165 : $fine->amountoutstanding;
167 my $old_amountoutstanding = $fine->amountoutstanding;
168 $fine->amountoutstanding( $old_amountoutstanding - $amount_to_pay );
169 $fine->store();
171 my $account_offset = Koha::Account::Offset->new(
173 debit_id => $fine->id,
174 type => $offset_type,
175 amount => $amount_to_pay * -1,
178 push( @account_offsets, $account_offset );
180 if ( C4::Context->preference("FinesLog") ) {
181 logaction(
182 "FINES", 'MODIFY',
183 $self->{patron_id},
184 Dumper(
186 action => "fee_$type",
187 borrowernumber => $fine->borrowernumber,
188 old_amountoutstanding => $old_amountoutstanding,
189 new_amountoutstanding => $fine->amountoutstanding,
190 amount_paid => $amount_to_pay,
191 accountlines_id => $fine->id,
192 accountno => $fine->accountno,
193 manager_id => $manager_id,
194 note => $note,
198 push( @fines_paid, $fine->id );
201 $balance_remaining = $balance_remaining - $amount_to_pay;
202 last unless $balance_remaining > 0;
205 $account_type ||=
206 $type eq 'writeoff' ? 'W'
207 : defined($sip) ? "Pay$sip"
208 : 'Pay';
210 $description ||= $type eq 'writeoff' ? 'Writeoff' : q{};
212 my $payment = Koha::Account::Line->new(
214 borrowernumber => $self->{patron_id},
215 accountno => $accountno,
216 date => dt_from_string(),
217 amount => 0 - $amount,
218 description => $description,
219 accounttype => $account_type,
220 payment_type => $payment_type,
221 amountoutstanding => 0 - $balance_remaining,
222 manager_id => $manager_id,
223 branchcode => $library_id,
224 note => $note,
226 )->store();
228 foreach my $o ( @account_offsets ) {
229 $o->credit_id( $payment->id() );
230 $o->store();
233 UpdateStats(
235 branch => $library_id,
236 type => $type,
237 amount => $amount,
238 borrowernumber => $self->{patron_id},
239 accountno => $accountno,
243 if ( C4::Context->preference("FinesLog") ) {
244 logaction(
245 "FINES", 'CREATE',
246 $self->{patron_id},
247 Dumper(
249 action => "create_$type",
250 borrowernumber => $self->{patron_id},
251 accountno => $accountno,
252 amount => 0 - $amount,
253 amountoutstanding => 0 - $balance_remaining,
254 accounttype => $account_type,
255 accountlines_paid => \@fines_paid,
256 manager_id => $manager_id,
262 if ( C4::Context->preference('UseEmailReceipts') ) {
263 if (
264 my $letter = C4::Letters::GetPreparedLetter(
265 module => 'circulation',
266 letter_code => uc("ACCOUNT_$type"),
267 message_transport_type => 'email',
268 lang => $patron->lang,
269 tables => {
270 borrowers => $self->{patron_id},
271 branches => $self->{library_id},
273 substitute => {
274 credit => $payment,
275 offsets => \@account_offsets,
280 C4::Letters::EnqueueLetter(
282 letter => $letter,
283 borrowernumber => $self->{patron_id},
284 message_transport_type => 'email',
286 ) or warn "can't enqueue letter $letter";
290 return $payment->id;
293 =head3 add_credit
295 This method allows adding credits to a patron's account
297 my $credit_line = Koha::Account->new({ patron_id => $patron_id })->add_credit(
299 amount => $amount,
300 description => $description,
301 note => $note,
302 user_id => $user_id,
303 library_id => $library_id,
304 sip => $sip,
305 payment_type => $payment_type,
306 type => $credit_type,
307 item_id => $item_id
311 $credit_type can be any of:
312 - 'credit'
313 - 'payment'
314 - 'forgiven'
315 - 'lost_item_return'
316 - 'writeoff'
318 =cut
320 sub add_credit {
322 my ( $self, $params ) = @_;
324 # amount is passed as a positive value, but we store credit as negative values
325 my $amount = $params->{amount} * -1;
326 my $description = $params->{description} // q{};
327 my $note = $params->{note} // q{};
328 my $user_id = $params->{user_id};
329 my $library_id = $params->{library_id};
330 my $sip = $params->{sip};
331 my $payment_type = $params->{payment_type};
332 my $type = $params->{type} || 'payment';
333 my $item_id = $params->{item_id};
335 my $schema = Koha::Database->new->schema;
337 my $account_type = $Koha::Account::account_type_credit->{$type};
338 $account_type .= $sip
339 if defined $sip &&
340 $type eq 'payment';
342 my $line;
344 $schema->txn_do(
345 sub {
346 # We should remove accountno, it is no longer needed
347 my $last = $self->lines->search(
349 { order_by => 'accountno' } )->next();
350 my $accountno = $last ? $last->accountno + 1 : 1;
352 # Insert the account line
353 $line = Koha::Account::Line->new(
354 { borrowernumber => $self->{patron_id},
355 accountno => $accountno,
356 date => \'NOW()',
357 amount => $amount,
358 description => $description,
359 accounttype => $account_type,
360 amountoutstanding => $amount,
361 payment_type => $payment_type,
362 note => $note,
363 manager_id => $user_id,
364 branchcode => $library_id,
365 itemnumber => $item_id,
366 lastincrement => undef,
368 )->store();
370 # Record the account offset
371 my $account_offset = Koha::Account::Offset->new(
372 { credit_id => $line->id,
373 type => $Koha::Account::offset_type->{$type},
374 amount => $amount
376 )->store();
378 UpdateStats(
379 { branch => $library_id,
380 type => $type,
381 amount => $amount,
382 borrowernumber => $self->{patron_id},
383 accountno => $accountno,
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 accountno => $accountno,
395 amount => $amount,
396 description => $description,
397 amountoutstanding => $amount,
398 accounttype => $account_type,
399 note => $note,
400 itemnumber => $item_id,
401 manager_id => $user_id,
402 branchcode => $library_id,
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 library_id => $library_id,
424 type => $debit_type,
425 item_id => $item_id,
426 issue_id => $issue_id
430 $debit_type can be any of:
431 - fine
432 - lost_item
433 - new_card
434 - account
435 - sundry
436 - processing
437 - rent
438 - reserve
439 - overdue
440 - manual
442 =cut
444 sub add_debit {
446 my ( $self, $params ) = @_;
448 # amount should always be a positive value
449 my $amount = $params->{amount};
451 unless ( $amount > 0 ) {
452 Koha::Exceptions::Account::AmountNotPositive->throw(
453 error => 'Debit amount passed is not positive'
457 my $description = $params->{description} // q{};
458 my $note = $params->{note} // q{};
459 my $user_id = $params->{user_id};
460 my $library_id = $params->{library_id};
461 my $type = $params->{type};
462 my $item_id = $params->{item_id};
463 my $issue_id = $params->{issue_id};
465 my $schema = Koha::Database->new->schema;
467 unless ( exists($Koha::Account::account_type_debit->{$type}) ) {
468 Koha::Exceptions::Account::UnrecognisedType->throw(
469 error => 'Type of debit not recognised'
473 my $account_type = $Koha::Account::account_type_debit->{$type};
475 my $line;
477 $schema->txn_do(
478 sub {
479 # We should remove accountno, it is no longer needed
480 my $last = Koha::Account::Lines->search( { borrowernumber => $self->{patron_id} },
481 { order_by => 'accountno' } )->next();
482 my $accountno = $last ? $last->accountno + 1 : 1;
484 # Insert the account line
485 $line = Koha::Account::Line->new(
486 { borrowernumber => $self->{patron_id},
487 date => \'NOW()',
488 amount => $amount,
489 description => $description,
490 accounttype => $account_type,
491 amountoutstanding => $amount,
492 payment_type => undef,
493 note => $note,
494 manager_id => $user_id,
495 itemnumber => $item_id,
496 issue_id => $issue_id,
497 branchcode => $library_id,
498 ( $type eq 'fine' ? ( lastincrement => $amount ) : ()),
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 accountno => $accountno,
518 amount => $amount,
519 description => $description,
520 amountoutstanding => $amount,
521 accounttype => $account_type,
522 note => $note,
523 itemnumber => $item_id,
524 manager_id => $user_id,
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 'reserve' => 'Reserve Fee',
696 'processing' => 'Processing Fee',
697 'lost_item' => 'Lost Item',
698 'rent' => 'Rental Fee',
699 'fine' => 'Fine',
700 'manual_debit' => 'Manual Debit',
701 'hold_expired' => 'Hold Expired'
704 =head3 $account_type_credit
706 =cut
708 our $account_type_credit = {
709 'credit' => 'C',
710 'forgiven' => 'FOR',
711 'lost_item_return' => 'CR',
712 'payment' => 'Pay',
713 'writeoff' => 'W'
716 =head3 $account_type_debit
718 =cut
720 our $account_type_debit = {
721 'fine' => 'FU',
722 'lost_item' => 'L',
723 'new_card' => 'N',
724 'account' => 'A',
725 'sundry' => 'M',
726 'processing' => 'PF',
727 'rent' => 'Rent',
728 'reserve' => 'Res',
729 'overdue' => 'O',
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