Bug 23442: (RM follow-up) Fix for missing 'uc' in offset_type call
[koha.git] / Koha / Account / Line.pm
blob1fac85d10c0e0b37456e55286119b76d57ae9fd4
1 package Koha::Account::Line;
3 # This file is part of Koha.
5 # Koha is free software; you can redistribute it and/or modify it under the
6 # terms of the GNU General Public License as published by the Free Software
7 # Foundation; either version 3 of the License, or (at your option) any later
8 # version.
10 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
11 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
14 # You should have received a copy of the GNU General Public License along
15 # with Koha; if not, write to the Free Software Foundation, Inc.,
16 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
18 use Modern::Perl;
20 use Carp;
21 use Data::Dumper;
23 use C4::Log qw(logaction);
25 use Koha::Account::CreditType;
26 use Koha::Account::DebitType;
27 use Koha::Account::Offsets;
28 use Koha::Database;
29 use Koha::Exceptions::Account;
30 use Koha::Items;
32 use base qw(Koha::Object);
34 =encoding utf8
36 =head1 NAME
38 Koha::Account::Line - Koha accountline Object class
40 =head1 API
42 =head2 Class methods
44 =cut
46 =head3 patron
48 Return the patron linked to this account line
50 =cut
52 sub patron {
53 my ( $self ) = @_;
54 my $rs = $self->_result->borrowernumber;
55 return unless $rs;
56 return Koha::Patron->_new_from_dbic( $rs );
59 =head3 item
61 Return the item linked to this account line if exists
63 =cut
65 sub item {
66 my ( $self ) = @_;
67 my $rs = $self->_result->itemnumber;
68 return unless $rs;
69 return Koha::Item->_new_from_dbic( $rs );
72 =head3 checkout
74 Return the checkout linked to this account line if exists
76 =cut
78 sub checkout {
79 my ( $self ) = @_;
80 return unless $self->issue_id ;
82 $self->{_checkout} ||= Koha::Checkouts->find( $self->issue_id );
83 $self->{_checkout} ||= Koha::Old::Checkouts->find( $self->issue_id );
84 return $self->{_checkout};
87 =head3 credit_type
89 Return the credit_type linked to this account line
91 =cut
93 sub credit_type {
94 my ( $self ) = @_;
95 my $rs = $self->_result->credit_type_code;
96 return unless $rs;
97 return Koha::Account::CreditType->_new_from_dbic( $rs );
100 =head3 debit_type
102 Return the debit_type linked to this account line
104 =cut
106 sub debit_type {
107 my ( $self ) = @_;
108 my $rs = $self->_result->debit_type_code;
109 return unless $rs;
110 return Koha::Account::DebitType->_new_from_dbic( $rs );
113 =head3 credit_offsets
115 Return the credit_offsets linked to this account line if some exist
117 =cut
119 sub credit_offsets {
120 my ( $self ) = @_;
121 my $rs = $self->_result->account_offsets_credits;
122 return unless $rs;
123 return Koha::Account::Offsets->_new_from_dbic($rs);
126 =head3 debit_offsets
128 Return the debit_offsets linked to this account line if some exist
130 =cut
132 sub debit_offsets {
133 my ( $self ) = @_;
134 my $rs = $self->_result->account_offsets_debits;
135 return unless $rs;
136 return Koha::Account::Offsets->_new_from_dbic($rs);
140 =head3 credits
142 my $credits = $accountline->credits;
143 my $credits = $accountline->credits( $cond, $attr );
145 Return the credits linked to this account line if some exist.
146 Search conditions and attributes may be passed if you wish to filter
147 the resultant resultant resultset.
149 =cut
151 sub credits {
152 my ( $self, $cond, $attr ) = @_;
154 unless ( $self->is_debit ) {
155 Koha::Exceptions::Account::IsNotCredit->throw(
156 error => 'Account line ' . $self->id . ' is not a debit'
160 my $rs =
161 $self->_result->search_related('account_offsets_debits')
162 ->search_related( 'credit', $cond, $attr );
163 return unless $rs;
164 return Koha::Account::Lines->_new_from_dbic($rs);
167 =head3 debits
169 my $debits = $accountline->debits;
170 my $debits = $accountline->debits( $cond, $attr );
172 Return the debits linked to this account line if some exist.
173 Search conditions and attributes may be passed if you wish to filter
174 the resultant resultant resultset.
176 =cut
178 sub debits {
179 my ( $self, $cond, $attr ) = @_;
181 unless ( $self->is_credit ) {
182 Koha::Exceptions::Account::IsNotCredit->throw(
183 error => 'Account line ' . $self->id . ' is not a credit'
187 my $rs =
188 $self->_result->search_related('account_offsets_credits')
189 ->search_related( 'debit', $cond, $attr );
190 return unless $rs;
191 return Koha::Account::Lines->_new_from_dbic($rs);
194 =head3 void
196 $payment_accountline->void();
198 Used to 'void' (or reverse) a payment/credit. It will roll back any offsets
199 created by the application of this credit upon any debits and mark the credit
200 as 'void' by updating it's status to "VOID".
202 =cut
204 sub void {
205 my ($self) = @_;
207 # Make sure it is a payment we are voiding
208 return unless $self->amount < 0;
210 my @account_offsets =
211 Koha::Account::Offsets->search(
212 { credit_id => $self->id, amount => { '<' => 0 } } );
214 $self->_result->result_source->schema->txn_do(
215 sub {
216 foreach my $account_offset (@account_offsets) {
217 my $fee_paid =
218 Koha::Account::Lines->find( $account_offset->debit_id );
220 next unless $fee_paid;
222 my $amount_paid = $account_offset->amount * -1; # amount paid is stored as a negative amount
223 my $new_amount = $fee_paid->amountoutstanding + $amount_paid;
224 $fee_paid->amountoutstanding($new_amount);
225 $fee_paid->store();
227 Koha::Account::Offset->new(
229 credit_id => $self->id,
230 debit_id => $fee_paid->id,
231 amount => $amount_paid,
232 type => 'Void Payment',
234 )->store();
237 if ( C4::Context->preference("FinesLog") ) {
238 logaction(
239 "FINES", 'VOID',
240 $self->borrowernumber,
241 Dumper(
243 action => 'void_payment',
244 borrowernumber => $self->borrowernumber,
245 amount => $self->amount,
246 amountoutstanding => $self->amountoutstanding,
247 description => $self->description,
248 credit_type_code => $self->credit_type_code,
249 payment_type => $self->payment_type,
250 note => $self->note,
251 itemnumber => $self->itemnumber,
252 manager_id => $self->manager_id,
253 offsets =>
254 [ map { $_->unblessed } @account_offsets ],
260 $self->set(
262 status => 'VOID',
263 amountoutstanding => 0,
264 amount => 0,
267 $self->store();
273 =head3 reduce
275 $charge_accountline->reduce({
276 reduction_type => $reduction_type
279 Used to 'reduce' a charge/debit by adding a credit to offset against the amount
280 outstanding.
282 May be used to apply a discount whilst retaining the original debit amounts or
283 to apply a full or partial refund for example when a lost item is found and
284 returned.
286 It will immediately be applied to the given debit unless the debit has already
287 been paid, in which case a 'zero' offset will be added to maintain a link to
288 the debit but the outstanding credit will be left so it may be applied to other
289 debts.
291 Reduction type may be one of:
293 * REFUND
295 Returns the reduction accountline (which will be a credit)
297 =cut
299 sub reduce {
300 my ( $self, $params ) = @_;
302 # Make sure it is a charge we are reducing
303 unless ( $self->is_debit ) {
304 Koha::Exceptions::Account::IsNotDebit->throw(
305 error => 'Account line ' . $self->id . 'is not a debit' );
307 if ( $self->debit_type_code eq 'PAYOUT' ) {
308 Koha::Exceptions::Account::IsNotDebit->throw(
309 error => 'Account line ' . $self->id . 'is a payout' );
312 # Check for mandatory parameters
313 my @mandatory = ( 'interface', 'reduction_type', 'amount' );
314 for my $param (@mandatory) {
315 unless ( defined( $params->{$param} ) ) {
316 Koha::Exceptions::MissingParameter->throw(
317 error => "The $param parameter is mandatory" );
321 # More mandatory parameters
322 if ( $params->{interface} eq 'intranet' ) {
323 my @optional = ( 'staff_id', 'branch' );
324 for my $param (@optional) {
325 unless ( defined( $params->{$param} ) ) {
326 Koha::Exceptions::MissingParameter->throw( error =>
327 "The $param parameter is mandatory when interface is set to 'intranet'"
333 # Make sure the reduction isn't more than the original
334 my $original = $self->amount;
335 Koha::Exceptions::Account::AmountNotPositive->throw(
336 error => 'Reduce amount passed is not positive' )
337 unless ( $params->{amount} > 0 );
338 Koha::Exceptions::ParameterTooHigh->throw( error =>
339 "Amount to reduce ($params->{amount}) is higher than original amount ($original)"
340 ) unless ( $original >= $params->{amount} );
341 my $reduced =
342 $self->credits( { credit_type_code => [ 'REFUND' ] } )->total;
343 Koha::Exceptions::ParameterTooHigh->throw( error =>
344 "Combined reduction ($params->{amount} + $reduced) is higher than original amount ("
345 . abs($original)
346 . ")" )
347 unless ( $original >= ( $params->{amount} + abs($reduced) ) );
349 my $status = { 'REFUND' => 'REFUNDED' };
351 my $reduction;
352 $self->_result->result_source->schema->txn_do(
353 sub {
355 # A 'reduction' is a 'credit'
356 $reduction = Koha::Account::Line->new(
358 date => \'NOW()',
359 amount => 0 - $params->{amount},
360 credit_type_code => $params->{reduction_type},
361 status => 'ADDED',
362 amountoutstanding => 0 - $params->{amount},
363 manager_id => $params->{staff_id},
364 borrowernumber => $self->borrowernumber,
365 interface => $params->{interface},
366 branchcode => $params->{branch},
368 )->store();
370 my $reduction_offset = Koha::Account::Offset->new(
372 credit_id => $reduction->accountlines_id,
373 type => uc( $params->{reduction_type} ),
374 amount => $params->{amount}
376 )->store();
378 # Link reduction to charge (and apply as required)
379 my $debit_outstanding = $self->amountoutstanding;
380 if ( $debit_outstanding >= $params->{amount} ) {
382 $reduction->apply(
384 debits => [$self],
385 offset_type => uc( $params->{reduction_type} )
388 $reduction->status('APPLIED')->store();
390 else {
392 # Zero amount offset used to link original 'debit' to reduction 'credit'
393 my $link_reduction_offset = Koha::Account::Offset->new(
395 credit_id => $reduction->accountlines_id,
396 debit_id => $self->accountlines_id,
397 type => uc( $params->{reduction_type} ),
398 amount => 0
400 )->store();
403 # Update status of original debit
404 $self->status( $status->{ $params->{reduction_type} } )->store;
408 $reduction->discard_changes;
409 return $reduction;
412 =head3 apply
414 my $debits = $account->outstanding_debits;
415 my $outstanding_amount = $credit->apply( { debits => $debits, [ offset_type => $offset_type ] } );
417 Applies the credit to a given debits array reference.
419 =head4 arguments hashref
421 =over 4
423 =item debits - Koha::Account::Lines object set of debits
425 =item offset_type (optional) - a string indicating the offset type (valid values are those from
426 the 'account_offset_types' table)
428 =back
430 =cut
432 sub apply {
433 my ( $self, $params ) = @_;
435 my $debits = $params->{debits};
436 my $offset_type = $params->{offset_type} // 'Credit Applied';
438 unless ( $self->is_credit ) {
439 Koha::Exceptions::Account::IsNotCredit->throw(
440 error => 'Account line ' . $self->id . ' is not a credit'
444 my $available_credit = $self->amountoutstanding * -1;
446 unless ( $available_credit > 0 ) {
447 Koha::Exceptions::Account::NoAvailableCredit->throw(
448 error => 'Outstanding credit is ' . $available_credit . ' and cannot be applied'
452 my $schema = Koha::Database->new->schema;
454 $schema->txn_do( sub {
455 for my $debit ( @{$debits} ) {
457 unless ( $debit->is_debit ) {
458 Koha::Exceptions::Account::IsNotDebit->throw(
459 error => 'Account line ' . $debit->id . 'is not a debit'
462 my $amount_to_cancel;
463 my $owed = $debit->amountoutstanding;
465 if ( $available_credit >= $owed ) {
466 $amount_to_cancel = $owed;
468 else { # $available_credit < $debit->amountoutstanding
469 $amount_to_cancel = $available_credit;
472 # record the account offset
473 Koha::Account::Offset->new(
474 { credit_id => $self->id,
475 debit_id => $debit->id,
476 amount => $amount_to_cancel * -1,
477 type => $offset_type,
479 )->store();
481 $available_credit -= $amount_to_cancel;
483 $self->amountoutstanding( $available_credit * -1 )->store;
484 $debit->amountoutstanding( $owed - $amount_to_cancel )->store;
486 # Same logic exists in Koha::Account::pay
487 if ( $debit->amountoutstanding == 0
488 && $debit->itemnumber
489 && $debit->debit_type_code
490 && $debit->debit_type_code eq 'LOST' )
492 C4::Circulation::ReturnLostItem( $self->borrowernumber, $debit->itemnumber );
498 return $available_credit;
501 =head3 payout
503 $credit_accountline->payout(
505 payout_type => $payout_type,
506 register_id => $register_id,
507 staff_id => $staff_id,
508 interface => 'intranet',
509 amount => $amount
513 Used to 'pay out' a credit to a user.
515 Payout type may be one of any existing payment types
517 Returns the payout debit line that is created via this transaction.
519 =cut
521 sub payout {
522 my ( $self, $params ) = @_;
524 # Make sure it is a credit we are paying out
525 unless ( $self->is_credit ) {
526 Koha::Exceptions::Account::IsNotCredit->throw(
527 error => 'Account line ' . $self->id . ' is not a credit' );
530 # Check for mandatory parameters
531 my @mandatory =
532 ( 'interface', 'staff_id', 'branch', 'payout_type', 'amount' );
533 for my $param (@mandatory) {
534 unless ( defined( $params->{$param} ) ) {
535 Koha::Exceptions::MissingParameter->throw(
536 error => "The $param parameter is mandatory" );
540 # Make sure there is outstanding credit to pay out
541 my $outstanding = -1 * $self->amountoutstanding;
542 my $amount =
543 $params->{amount} ? $params->{amount} : $outstanding;
544 Koha::Exceptions::Account::AmountNotPositive->throw(
545 error => 'Payout amount passed is not positive' )
546 unless ( $amount > 0 );
547 Koha::Exceptions::ParameterTooHigh->throw(
548 error => "Amount to payout ($amount) is higher than amountoutstanding ($outstanding)" )
549 unless ($outstanding >= $amount );
551 # Make sure we record the cash register for cash transactions
552 Koha::Exceptions::Account::RegisterRequired->throw()
553 if ( C4::Context->preference("UseCashRegisters")
554 && defined( $params->{payout_type} )
555 && ( $params->{payout_type} eq 'CASH' )
556 && !defined( $params->{cash_register} ) );
558 my $payout;
559 $self->_result->result_source->schema->txn_do(
560 sub {
562 # A 'payout' is a 'debit'
563 $payout = Koha::Account::Line->new(
565 date => \'NOW()',
566 amount => $amount,
567 debit_type_code => 'PAYOUT',
568 payment_type => $params->{payout_type},
569 amountoutstanding => $amount,
570 manager_id => $params->{staff_id},
571 borrowernumber => $self->borrowernumber,
572 interface => $params->{interface},
573 branchcode => $params->{branch},
574 register_id => $params->{cash_register}
576 )->store();
578 my $payout_offset = Koha::Account::Offset->new(
580 debit_id => $payout->accountlines_id,
581 type => 'PAYOUT',
582 amount => $amount
584 )->store();
586 $self->apply( { debits => [$payout], offset_type => 'PAYOUT' } );
587 $self->status('PAID')->store;
591 $payout->discard_changes;
592 return $payout;
595 =head3 adjust
597 This method allows updating a debit or credit on a patron's account
599 $account_line->adjust(
601 amount => $amount,
602 type => $update_type,
603 interface => $interface
607 $update_type can be any of:
608 - overdue_update
610 Authors Note: The intention here is that this method is only used
611 to adjust accountlines where the final amount is not yet known/fixed.
612 Incrementing fines are the only existing case at the time of writing,
613 all other forms of 'adjustment' should be recorded as distinct credits
614 or debits and applied, via an offset, to the corresponding debit or credit.
616 =cut
618 sub adjust {
619 my ( $self, $params ) = @_;
621 my $amount = $params->{amount};
622 my $update_type = $params->{type};
623 my $interface = $params->{interface};
625 unless ( exists($Koha::Account::Line::allowed_update->{$update_type}) ) {
626 Koha::Exceptions::Account::UnrecognisedType->throw(
627 error => 'Update type not recognised'
631 my $debit_type_code = $self->debit_type_code;
632 my $account_status = $self->status;
633 unless (
635 exists(
636 $Koha::Account::Line::allowed_update->{$update_type}
637 ->{$debit_type_code}
639 && ( $Koha::Account::Line::allowed_update->{$update_type}
640 ->{$debit_type_code} eq $account_status )
644 Koha::Exceptions::Account::UnrecognisedType->throw(
645 error => 'Update type not allowed on this debit_type' );
648 my $schema = Koha::Database->new->schema;
650 $schema->txn_do(
651 sub {
653 my $amount_before = $self->amount;
654 my $amount_outstanding_before = $self->amountoutstanding;
655 my $difference = $amount - $amount_before;
656 my $new_outstanding = $amount_outstanding_before + $difference;
658 my $offset_type = $debit_type_code;
659 $offset_type .= ( $difference > 0 ) ? "_INCREASE" : "_DECREASE";
661 # Catch cases that require patron refunds
662 if ( $new_outstanding < 0 ) {
663 my $account =
664 Koha::Patrons->find( $self->borrowernumber )->account;
665 my $credit = $account->add_credit(
667 amount => $new_outstanding * -1,
668 description => 'Overpayment refund',
669 type => 'CREDIT',
670 interface => $interface,
671 ( $update_type eq 'overdue_update' ? ( item_id => $self->itemnumber ) : ()),
674 $new_outstanding = 0;
677 # Update the account line
678 $self->set(
680 date => \'NOW()',
681 amount => $amount,
682 amountoutstanding => $new_outstanding,
684 )->store();
686 # Record the account offset
687 my $account_offset = Koha::Account::Offset->new(
689 debit_id => $self->id,
690 type => $offset_type,
691 amount => $difference
693 )->store();
695 if ( C4::Context->preference("FinesLog") ) {
696 logaction(
697 "FINES", 'UPDATE', #undef becomes UPDATE in UpdateFine
698 $self->borrowernumber,
699 Dumper(
700 { action => $update_type,
701 borrowernumber => $self->borrowernumber,
702 amount => $amount,
703 description => undef,
704 amountoutstanding => $new_outstanding,
705 debit_type_code => $self->debit_type_code,
706 note => undef,
707 itemnumber => $self->itemnumber,
708 manager_id => undef,
711 ) if ( $update_type eq 'overdue_update' );
716 return $self;
719 =head3 is_credit
721 my $bool = $line->is_credit;
723 =cut
725 sub is_credit {
726 my ($self) = @_;
728 return ( $self->amount < 0 );
731 =head3 is_debit
733 my $bool = $line->is_debit;
735 =cut
737 sub is_debit {
738 my ($self) = @_;
740 return !$self->is_credit;
743 =head3 to_api_mapping
745 This method returns the mapping for representing a Koha::Account::Line object
746 on the API.
748 =cut
750 sub to_api_mapping {
751 return {
752 accountlines_id => 'account_line_id',
753 credit_type_code => 'credit_type',
754 debit_type_code => 'debit_type',
755 amountoutstanding => 'amount_outstanding',
756 borrowernumber => 'patron_id',
757 branchcode => 'library_id',
758 issue_id => 'checkout_id',
759 itemnumber => 'item_id',
760 manager_id => 'user_id',
761 note => 'internal_note',
765 =head2 Internal methods
767 =cut
769 =head3 _type
771 =cut
773 sub _type {
774 return 'Accountline';
779 =head2 Name mappings
781 =head3 $allowed_update
783 =cut
785 our $allowed_update = { 'overdue_update' => { 'OVERDUE' => 'UNRETURNED' } };
787 =head1 AUTHORS
789 Kyle M Hall <kyle@bywatersolutions.com >
790 Tomás Cohen Arazi <tomascohen@theke.io>
791 Martin Renvoize <martin.renvoize@ptfs-europe.com>
793 =cut