Bug 20434: Update UNIMARC framework - auth (NP)
[koha.git] / Koha / Account.pm
blobafff2358229afc17fd0249841912f2152c3ceceb
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';
82 my $cash_register = $params->{cash_register};
84 my $userenv = C4::Context->userenv;
86 my $patron = Koha::Patrons->find( $self->{patron_id} );
88 my $manager_id = $userenv ? $userenv->{number} : 0;
89 my $interface = $params ? ( $params->{interface} || C4::Context->interface ) : C4::Context->interface;
90 Koha::Exceptions::Account::RegisterRequired->throw()
91 if ( C4::Context->preference("UseCashRegisters")
92 && defined($payment_type)
93 && ( $payment_type eq 'CASH' )
94 && !defined($cash_register) );
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 # Same logic exists in Koha::Account::Line::apply
116 if ( $new_amountoutstanding == 0
117 && $fine->itemnumber
118 && $fine->accounttype
119 && ( $fine->accounttype eq 'LOST' ) )
121 C4::Circulation::ReturnLostItem( $self->{patron_id}, $fine->itemnumber );
124 my $account_offset = Koha::Account::Offset->new(
126 debit_id => $fine->id,
127 type => $offset_type,
128 amount => $amount_to_pay * -1,
131 push( @account_offsets, $account_offset );
133 if ( C4::Context->preference("FinesLog") ) {
134 logaction(
135 "FINES", 'MODIFY',
136 $self->{patron_id},
137 Dumper(
139 action => 'fee_payment',
140 borrowernumber => $fine->borrowernumber,
141 old_amountoutstanding => $old_amountoutstanding,
142 new_amountoutstanding => 0,
143 amount_paid => $old_amountoutstanding,
144 accountlines_id => $fine->id,
145 manager_id => $manager_id,
146 note => $note,
149 $interface
151 push( @fines_paid, $fine->id );
155 # Were not passed a specific line to pay, or the payment was for more
156 # than the what was owed on the given line. In that case pay down other
157 # lines with remaining balance.
158 my @outstanding_fines;
159 @outstanding_fines = $self->lines->search(
161 amountoutstanding => { '>' => 0 },
163 ) if $balance_remaining > 0;
165 foreach my $fine (@outstanding_fines) {
166 my $amount_to_pay =
167 $fine->amountoutstanding > $balance_remaining
168 ? $balance_remaining
169 : $fine->amountoutstanding;
171 my $old_amountoutstanding = $fine->amountoutstanding;
172 $fine->amountoutstanding( $old_amountoutstanding - $amount_to_pay );
173 $fine->store();
175 if ( $fine->amountoutstanding == 0
176 && $fine->itemnumber
177 && $fine->accounttype
178 && ( $fine->accounttype eq 'LOST' ) )
180 C4::Circulation::ReturnLostItem( $self->{patron_id}, $fine->itemnumber );
183 my $account_offset = Koha::Account::Offset->new(
185 debit_id => $fine->id,
186 type => $offset_type,
187 amount => $amount_to_pay * -1,
190 push( @account_offsets, $account_offset );
192 if ( C4::Context->preference("FinesLog") ) {
193 logaction(
194 "FINES", 'MODIFY',
195 $self->{patron_id},
196 Dumper(
198 action => "fee_$type",
199 borrowernumber => $fine->borrowernumber,
200 old_amountoutstanding => $old_amountoutstanding,
201 new_amountoutstanding => $fine->amountoutstanding,
202 amount_paid => $amount_to_pay,
203 accountlines_id => $fine->id,
204 manager_id => $manager_id,
205 note => $note,
208 $interface
210 push( @fines_paid, $fine->id );
213 $balance_remaining = $balance_remaining - $amount_to_pay;
214 last unless $balance_remaining > 0;
217 $account_type ||=
218 $type eq 'writeoff'
219 ? 'W'
220 : 'Pay';
222 $description ||= $type eq 'writeoff' ? 'Writeoff' : q{};
224 my $payment = Koha::Account::Line->new(
226 borrowernumber => $self->{patron_id},
227 date => dt_from_string(),
228 amount => 0 - $amount,
229 description => $description,
230 accounttype => $account_type,
231 payment_type => $payment_type,
232 amountoutstanding => 0 - $balance_remaining,
233 manager_id => $manager_id,
234 interface => $interface,
235 branchcode => $library_id,
236 register_id => $cash_register,
237 note => $note,
239 )->store();
241 foreach my $o ( @account_offsets ) {
242 $o->credit_id( $payment->id() );
243 $o->store();
246 UpdateStats(
248 branch => $library_id,
249 type => $type,
250 amount => $amount,
251 borrowernumber => $self->{patron_id},
255 if ( C4::Context->preference("FinesLog") ) {
256 logaction(
257 "FINES", 'CREATE',
258 $self->{patron_id},
259 Dumper(
261 action => "create_$type",
262 borrowernumber => $self->{patron_id},
263 amount => 0 - $amount,
264 amountoutstanding => 0 - $balance_remaining,
265 accounttype => $account_type,
266 accountlines_paid => \@fines_paid,
267 manager_id => $manager_id,
270 $interface
274 if ( C4::Context->preference('UseEmailReceipts') ) {
275 if (
276 my $letter = C4::Letters::GetPreparedLetter(
277 module => 'circulation',
278 letter_code => uc("ACCOUNT_$type"),
279 message_transport_type => 'email',
280 lang => $patron->lang,
281 tables => {
282 borrowers => $self->{patron_id},
283 branches => $self->{library_id},
285 substitute => {
286 credit => $payment,
287 offsets => \@account_offsets,
292 C4::Letters::EnqueueLetter(
294 letter => $letter,
295 borrowernumber => $self->{patron_id},
296 message_transport_type => 'email',
298 ) or warn "can't enqueue letter $letter";
302 return $payment->id;
305 =head3 add_credit
307 This method allows adding credits to a patron's account
309 my $credit_line = Koha::Account->new({ patron_id => $patron_id })->add_credit(
311 amount => $amount,
312 description => $description,
313 note => $note,
314 user_id => $user_id,
315 interface => $interface,
316 library_id => $library_id,
317 payment_type => $payment_type,
318 type => $credit_type,
319 item_id => $item_id
323 $credit_type can be any of:
324 - 'credit'
325 - 'payment'
326 - 'forgiven'
327 - 'lost_item_return'
328 - 'writeoff'
330 =cut
332 sub add_credit {
334 my ( $self, $params ) = @_;
336 # amount is passed as a positive value, but we store credit as negative values
337 my $amount = $params->{amount} * -1;
338 my $description = $params->{description} // q{};
339 my $note = $params->{note} // q{};
340 my $user_id = $params->{user_id};
341 my $interface = $params->{interface};
342 my $library_id = $params->{library_id};
343 my $cash_register = $params->{cash_register};
344 my $payment_type = $params->{payment_type};
345 my $type = $params->{type} || 'payment';
346 my $item_id = $params->{item_id};
348 unless ( $interface ) {
349 Koha::Exceptions::MissingParameter->throw(
350 error => 'The interface parameter is mandatory'
354 Koha::Exceptions::Account::RegisterRequired->throw()
355 if ( C4::Context->preference("UseCashRegisters")
356 && defined($payment_type)
357 && ( $payment_type eq 'CASH' )
358 && !defined($cash_register) );
360 my $schema = Koha::Database->new->schema;
362 my $account_type = $Koha::Account::account_type_credit->{$type};
363 my $line;
365 $schema->txn_do(
366 sub {
368 # Insert the account line
369 $line = Koha::Account::Line->new(
370 { borrowernumber => $self->{patron_id},
371 date => \'NOW()',
372 amount => $amount,
373 description => $description,
374 accounttype => $account_type,
375 amountoutstanding => $amount,
376 payment_type => $payment_type,
377 note => $note,
378 manager_id => $user_id,
379 interface => $interface,
380 branchcode => $library_id,
381 register_id => $cash_register,
382 itemnumber => $item_id,
384 )->store();
386 # Record the account offset
387 my $account_offset = Koha::Account::Offset->new(
388 { credit_id => $line->id,
389 type => $Koha::Account::offset_type->{$type},
390 amount => $amount
392 )->store();
394 UpdateStats(
395 { branch => $library_id,
396 type => $type,
397 amount => $amount,
398 borrowernumber => $self->{patron_id},
400 ) if grep { $type eq $_ } ('payment', 'writeoff') ;
402 if ( C4::Context->preference("FinesLog") ) {
403 logaction(
404 "FINES", 'CREATE',
405 $self->{patron_id},
406 Dumper(
407 { action => "create_$type",
408 borrowernumber => $self->{patron_id},
409 amount => $amount,
410 description => $description,
411 amountoutstanding => $amount,
412 accounttype => $account_type,
413 note => $note,
414 itemnumber => $item_id,
415 manager_id => $user_id,
416 branchcode => $library_id,
419 $interface
425 return $line;
428 =head3 add_debit
430 This method allows adding debits to a patron's account
432 my $debit_line = Koha::Account->new({ patron_id => $patron_id })->add_debit(
434 amount => $amount,
435 description => $description,
436 note => $note,
437 user_id => $user_id,
438 interface => $interface,
439 library_id => $library_id,
440 type => $debit_type,
441 item_id => $item_id,
442 issue_id => $issue_id
446 $debit_type can be any of:
447 - overdue
448 - lost_item
449 - new_card
450 - account
451 - account_renew
452 - sundry
453 - processing
454 - rent
455 - rent_daily
456 - rent_renewal
457 - rent_daily_renewal
458 - reserve
459 - manual
461 =cut
463 sub add_debit {
465 my ( $self, $params ) = @_;
467 # amount should always be a positive value
468 my $amount = $params->{amount};
470 unless ( $amount > 0 ) {
471 Koha::Exceptions::Account::AmountNotPositive->throw(
472 error => 'Debit amount passed is not positive'
476 my $description = $params->{description} // q{};
477 my $note = $params->{note} // q{};
478 my $user_id = $params->{user_id};
479 my $interface = $params->{interface};
480 my $library_id = $params->{library_id};
481 my $type = $params->{type};
482 my $item_id = $params->{item_id};
483 my $issue_id = $params->{issue_id};
485 unless ( $interface ) {
486 Koha::Exceptions::MissingParameter->throw(
487 error => 'The interface parameter is mandatory'
491 my $schema = Koha::Database->new->schema;
493 unless ( exists($Koha::Account::account_type_debit->{$type}) ) {
494 Koha::Exceptions::Account::UnrecognisedType->throw(
495 error => 'Type of debit not recognised'
499 my $account_type = $Koha::Account::account_type_debit->{$type};
501 my $line;
503 $schema->txn_do(
504 sub {
506 # Insert the account line
507 $line = Koha::Account::Line->new(
508 { borrowernumber => $self->{patron_id},
509 date => \'NOW()',
510 amount => $amount,
511 description => $description,
512 accounttype => $account_type,
513 amountoutstanding => $amount,
514 payment_type => undef,
515 note => $note,
516 manager_id => $user_id,
517 interface => $interface,
518 itemnumber => $item_id,
519 issue_id => $issue_id,
520 branchcode => $library_id,
521 ( $type eq 'overdue' ? ( status => 'UNRETURNED' ) : ()),
523 )->store();
525 # Record the account offset
526 my $account_offset = Koha::Account::Offset->new(
527 { debit_id => $line->id,
528 type => $Koha::Account::offset_type->{$type},
529 amount => $amount
531 )->store();
533 if ( C4::Context->preference("FinesLog") ) {
534 logaction(
535 "FINES", 'CREATE',
536 $self->{patron_id},
537 Dumper(
538 { action => "create_$type",
539 borrowernumber => $self->{patron_id},
540 amount => $amount,
541 description => $description,
542 amountoutstanding => $amount,
543 accounttype => $account_type,
544 note => $note,
545 itemnumber => $item_id,
546 manager_id => $user_id,
549 $interface
555 return $line;
558 =head3 balance
560 my $balance = $self->balance
562 Return the balance (sum of amountoutstanding columns)
564 =cut
566 sub balance {
567 my ($self) = @_;
568 return $self->lines->total_outstanding;
571 =head3 outstanding_debits
573 my $lines = Koha::Account->new({ patron_id => $patron_id })->outstanding_debits;
575 It returns the debit lines with outstanding amounts for the patron.
577 In scalar context, it returns a Koha::Account::Lines iterator. In list context, it will
578 return a list of Koha::Account::Line objects.
580 =cut
582 sub outstanding_debits {
583 my ($self) = @_;
585 return $self->lines->search(
587 amount => { '>' => 0 },
588 amountoutstanding => { '>' => 0 }
593 =head3 outstanding_credits
595 my $lines = Koha::Account->new({ patron_id => $patron_id })->outstanding_credits;
597 It returns the credit lines with outstanding amounts for the patron.
599 In scalar context, it returns a Koha::Account::Lines iterator. In list context, it will
600 return a list of Koha::Account::Line objects.
602 =cut
604 sub outstanding_credits {
605 my ($self) = @_;
607 return $self->lines->search(
609 amount => { '<' => 0 },
610 amountoutstanding => { '<' => 0 }
615 =head3 non_issues_charges
617 my $non_issues_charges = $self->non_issues_charges
619 Calculates amount immediately owing by the patron - non-issue charges.
621 Charges exempt from non-issue are:
622 * Res (holds) if HoldsInNoissuesCharge syspref is set to false
623 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
624 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
626 =cut
628 sub non_issues_charges {
629 my ($self) = @_;
631 # FIXME REMOVE And add a warning in the about page + update DB if length(MANUAL_INV) > 5
632 my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
634 my @not_fines;
635 push @not_fines, 'Res'
636 unless C4::Context->preference('HoldsInNoissuesCharge');
637 push @not_fines, 'Rent'
638 unless C4::Context->preference('RentalsInNoissuesCharge');
639 unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
640 my $dbh = C4::Context->dbh;
641 push @not_fines,
643 $dbh->selectcol_arrayref(q|
644 SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'
648 @not_fines = map { substr( $_, 0, $ACCOUNT_TYPE_LENGTH ) } uniq(@not_fines);
650 return $self->lines->search(
652 accounttype => { -not_in => \@not_fines }
654 )->total_outstanding;
657 =head3 lines
659 my $lines = $self->lines;
661 Return all credits and debits for the user, outstanding or otherwise
663 =cut
665 sub lines {
666 my ($self) = @_;
668 return Koha::Account::Lines->search(
670 borrowernumber => $self->{patron_id},
675 =head3 reconcile_balance
677 $account->reconcile_balance();
679 Find outstanding credits and use them to pay outstanding debits.
680 Currently, this implicitly uses the 'First In First Out' rule for
681 applying credits against debits.
683 =cut
685 sub reconcile_balance {
686 my ($self) = @_;
688 my $outstanding_debits = $self->outstanding_debits;
689 my $outstanding_credits = $self->outstanding_credits;
691 while ( $outstanding_debits->total_outstanding > 0
692 and my $credit = $outstanding_credits->next )
694 # there's both outstanding debits and credits
695 $credit->apply( { debits => [ $outstanding_debits->as_list ] } ); # applying credit, no special offset
697 $outstanding_debits = $self->outstanding_debits;
701 return $self;
706 =head2 Name mappings
708 =head3 $offset_type
710 =cut
712 our $offset_type = {
713 'credit' => 'Manual Credit',
714 'forgiven' => 'Writeoff',
715 'lost_item_return' => 'Lost Item',
716 'payment' => 'Payment',
717 'writeoff' => 'Writeoff',
718 'account' => 'Account Fee',
719 'account_renew' => 'Account Fee',
720 'reserve' => 'Reserve Fee',
721 'processing' => 'Processing Fee',
722 'lost_item' => 'Lost Item',
723 'rent' => 'Rental Fee',
724 'rent_daily' => 'Rental Fee',
725 'rent_renew' => 'Rental Fee',
726 'rent_daily_renew' => 'Rental Fee',
727 'overdue' => 'OVERDUE',
728 'manual_debit' => 'Manual Debit',
729 'hold_expired' => 'Hold Expired'
732 =head3 $account_type_credit
734 =cut
736 our $account_type_credit = {
737 'credit' => 'C',
738 'forgiven' => 'FOR',
739 'lost_item_return' => 'LOST_RETURN',
740 'payment' => 'Pay',
741 'writeoff' => 'W'
744 =head3 $account_type_debit
746 =cut
748 our $account_type_debit = {
749 'account' => 'ACCOUNT',
750 'account_renew' => 'ACCOUNT_RENEW',
751 'overdue' => 'OVERDUE',
752 'lost_item' => 'LOST',
753 'new_card' => 'N',
754 'sundry' => 'M',
755 'processing' => 'PF',
756 'rent' => 'RENT',
757 'rent_daily' => 'RENT_DAILY',
758 'rent_renew' => 'RENT_RENEW',
759 'rent_daily_renew' => 'RENT_DAILY_RENEW',
760 'reserve' => 'Res',
761 'manual_debit' => 'M',
762 'hold_expired' => 'HE'
765 =head1 AUTHORS
767 =encoding utf8
769 Kyle M Hall <kyle.m.hall@gmail.com>
770 Tomás Cohen Arazi <tomascohen@gmail.com>
771 Martin Renvoize <martin.renvoize@ptfs-europe.com>
773 =cut