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
6 # under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 3 of the License, or
8 # (at your option) any later version.
10 # Koha is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with Koha; if not, see <http://www.gnu.org/licenses>.
23 use C4
::Log
qw(logaction);
24 use C4
::Overdues
qw(GetFine);
26 use Koha
::Account
::CreditType
;
27 use Koha
::Account
::DebitType
;
28 use Koha
::Account
::Offsets
;
31 use Koha
::Exceptions
::Account
;
34 use base
qw(Koha::Object);
40 Koha::Account::Line - Koha accountline Object class
50 Return the patron linked to this account line
56 my $rs = $self->_result->borrowernumber;
58 return Koha
::Patron
->_new_from_dbic( $rs );
63 Return the item linked to this account line if exists
69 my $rs = $self->_result->itemnumber;
71 return Koha
::Item
->_new_from_dbic( $rs );
76 Return the checkout linked to this account line if exists
82 return unless $self->issue_id ;
84 $self->{_checkout
} ||= Koha
::Checkouts
->find( $self->issue_id );
85 $self->{_checkout
} ||= Koha
::Old
::Checkouts
->find( $self->issue_id );
86 return $self->{_checkout
};
91 Returns a Koha::Library object representing where the accountline was recorded
97 my $rs = $self->_result->library;
99 return Koha
::Library
->_new_from_dbic($rs);
104 Return the credit_type linked to this account line
110 my $rs = $self->_result->credit_type_code;
112 return Koha
::Account
::CreditType
->_new_from_dbic( $rs );
117 Return the debit_type linked to this account line
123 my $rs = $self->_result->debit_type_code;
125 return Koha
::Account
::DebitType
->_new_from_dbic( $rs );
128 =head3 credit_offsets
130 Return the credit_offsets linked to this account line if some exist
136 my $rs = $self->_result->account_offsets_credits;
138 return Koha
::Account
::Offsets
->_new_from_dbic($rs);
143 Return the debit_offsets linked to this account line if some exist
149 my $rs = $self->_result->account_offsets_debits;
151 return Koha
::Account
::Offsets
->_new_from_dbic($rs);
157 my $credits = $accountline->credits;
158 my $credits = $accountline->credits( $cond, $attr );
160 Return the credits linked to this account line if some exist.
161 Search conditions and attributes may be passed if you wish to filter
162 the resultant resultant resultset.
167 my ( $self, $cond, $attr ) = @_;
169 unless ( $self->is_debit ) {
170 Koha
::Exceptions
::Account
::IsNotDebit
->throw(
171 error
=> 'Account line ' . $self->id . ' is not a debit'
175 my $cond_m = { map { "credit.".$_ => $cond->{$_} } keys %{$cond}};
177 $self->_result->search_related('account_offsets_debits')
178 ->search_related( 'credit', $cond_m, $attr );
180 return Koha
::Account
::Lines
->_new_from_dbic($rs);
185 my $debits = $accountline->debits;
186 my $debits = $accountline->debits( $cond, $attr );
188 Return the debits linked to this account line if some exist.
189 Search conditions and attributes may be passed if you wish to filter
190 the resultant resultant resultset.
195 my ( $self, $cond, $attr ) = @_;
197 unless ( $self->is_credit ) {
198 Koha
::Exceptions
::Account
::IsNotCredit
->throw(
199 error
=> 'Account line ' . $self->id . ' is not a credit'
203 my $cond_m = { map { "debit.".$_ => $cond->{$_} } keys %{$cond}};
205 $self->_result->search_related('account_offsets_credits')
206 ->search_related( 'debit', $cond_m, $attr );
208 return Koha
::Account
::Lines
->_new_from_dbic($rs);
213 $payment_accountline->void();
215 Used to 'void' (or reverse) a payment/credit. It will roll back any offsets
216 created by the application of this credit upon any debits and mark the credit
217 as 'void' by updating it's status to "VOID".
224 # Make sure it is a payment we are voiding
225 return unless $self->amount < 0;
227 my @account_offsets =
228 Koha
::Account
::Offsets
->search(
229 { credit_id
=> $self->id, amount
=> { '<' => 0 } } );
231 $self->_result->result_source->schema->txn_do(
233 foreach my $account_offset (@account_offsets) {
235 Koha
::Account
::Lines
->find( $account_offset->debit_id );
237 next unless $fee_paid;
239 my $amount_paid = $account_offset->amount * -1; # amount paid is stored as a negative amount
240 my $new_amount = $fee_paid->amountoutstanding + $amount_paid;
241 $fee_paid->amountoutstanding($new_amount);
244 Koha
::Account
::Offset
->new(
246 credit_id
=> $self->id,
247 debit_id
=> $fee_paid->id,
248 amount
=> $amount_paid,
249 type
=> 'Void Payment',
254 if ( C4
::Context
->preference("FinesLog") ) {
257 $self->borrowernumber,
260 action
=> 'void_payment',
261 borrowernumber
=> $self->borrowernumber,
262 amount
=> $self->amount,
263 amountoutstanding
=> $self->amountoutstanding,
264 description
=> $self->description,
265 credit_type_code
=> $self->credit_type_code,
266 payment_type
=> $self->payment_type,
268 itemnumber
=> $self->itemnumber,
269 manager_id
=> $self->manager_id,
271 [ map { $_->unblessed } @account_offsets ],
280 amountoutstanding
=> 0,
292 $debit_accountline->cancel();
294 Cancel a charge. It will mark the debit as 'cancelled' by updating its
295 status to 'CANCELLED'.
296 Charges that have been fully or partially paid cannot be cancelled.
298 Return self in case of success, undef otherwise
305 # Make sure it is a charge we are cancelling
306 return unless $self->is_debit;
308 # Make sure it is not already cancelled
309 return if $self->status && $self->status eq 'CANCELLED';
311 # Make sure it has not be paid yet
312 return if $self->amount != $self->amountoutstanding;
314 if ( C4
::Context
->preference("FinesLog") ) {
315 logaction
('FINES', 'CANCEL', $self->borrowernumber, Dumper
({
316 action
=> 'cancel_charge',
317 borrowernumber
=> $self->borrowernumber,
318 amount
=> $self->amount,
319 amountoutstanding
=> $self->amountoutstanding,
320 description
=> $self->description,
321 debit_type_code
=> $self->debit_type_code,
323 itemnumber
=> $self->itemnumber,
324 manager_id
=> $self->manager_id,
329 status
=> 'CANCELLED',
330 amountoutstanding
=> 0,
340 $charge_accountline->reduce({
341 reduction_type => $reduction_type
344 Used to 'reduce' a charge/debit by adding a credit to offset against the amount
347 May be used to apply a discount whilst retaining the original debit amounts or
348 to apply a full or partial refund for example when a lost item is found and
351 It will immediately be applied to the given debit unless the debit has already
352 been paid, in which case a 'zero' offset will be added to maintain a link to
353 the debit but the outstanding credit will be left so it may be applied to other
356 Reduction type may be one of:
361 Returns the reduction accountline (which will be a credit)
366 my ( $self, $params ) = @_;
368 # Make sure it is a charge we are reducing
369 unless ( $self->is_debit ) {
370 Koha
::Exceptions
::Account
::IsNotDebit
->throw(
371 error
=> 'Account line ' . $self->id . 'is not a debit' );
373 if ( $self->debit_type_code eq 'PAYOUT' ) {
374 Koha
::Exceptions
::Account
::IsNotDebit
->throw(
375 error
=> 'Account line ' . $self->id . 'is a payout' );
378 # Check for mandatory parameters
379 my @mandatory = ( 'interface', 'reduction_type', 'amount' );
380 for my $param (@mandatory) {
381 unless ( defined( $params->{$param} ) ) {
382 Koha
::Exceptions
::MissingParameter
->throw(
383 error
=> "The $param parameter is mandatory" );
387 # More mandatory parameters
388 if ( $params->{interface
} eq 'intranet' ) {
389 my @optional = ( 'staff_id', 'branch' );
390 for my $param (@optional) {
391 unless ( defined( $params->{$param} ) ) {
392 Koha
::Exceptions
::MissingParameter
->throw( error
=>
393 "The $param parameter is mandatory when interface is set to 'intranet'"
399 # Make sure the reduction isn't more than the original
400 my $original = $self->amount;
401 Koha
::Exceptions
::Account
::AmountNotPositive
->throw(
402 error
=> 'Reduce amount passed is not positive' )
403 unless ( $params->{amount
} > 0 );
404 Koha
::Exceptions
::ParameterTooHigh
->throw( error
=>
405 "Amount to reduce ($params->{amount}) is higher than original amount ($original)"
406 ) unless ( $original >= $params->{amount
} );
408 $self->credits( { credit_type_code
=> [ 'DISCOUNT', 'REFUND' ] } )->total;
409 Koha
::Exceptions
::ParameterTooHigh
->throw( error
=>
410 "Combined reduction ($params->{amount} + $reduced) is higher than original amount ("
413 unless ( $original >= ( $params->{amount
} + abs($reduced) ) );
415 my $status = { 'REFUND' => 'REFUNDED', 'DISCOUNT' => 'DISCOUNTED' };
418 $self->_result->result_source->schema->txn_do(
421 # A 'reduction' is a 'credit'
422 $reduction = Koha
::Account
::Line
->new(
425 amount => 0 - $params->{amount},
426 credit_type_code => $params->{reduction_type},
428 amountoutstanding => 0 - $params->{amount},
429 manager_id => $params->{staff_id},
430 borrowernumber => $self->borrowernumber,
431 interface => $params->{interface},
432 branchcode => $params->{branch},
436 my $reduction_offset = Koha::Account::Offset->new(
438 credit_id => $reduction->accountlines_id,
439 type => uc( $params->{reduction_type} ),
440 amount => $params->{amount}
444 # Link reduction to charge (and apply as required)
445 my $debit_outstanding = $self->amountoutstanding;
446 if ( $debit_outstanding >= $params->{amount} ) {
451 offset_type => uc( $params->{reduction_type} )
454 $reduction->status('APPLIED
')->store();
458 # Zero amount offset used to link original 'debit
' to reduction 'credit
'
459 my $link_reduction_offset = Koha::Account::Offset->new(
461 credit_id => $reduction->accountlines_id,
462 debit_id => $self->accountlines_id,
463 type => uc( $params->{reduction_type} ),
469 # Update status of original debit
470 $self->status( $status->{ $params->{reduction_type} } )->store;
474 $reduction->discard_changes;
480 my $debits = $account->outstanding_debits;
481 my $outstanding_amount = $credit->apply( { debits => $debits, [ offset_type => $offset_type ] } );
483 Applies the credit to a given debits array reference.
485 =head4 arguments hashref
489 =item debits - Koha::Account::Lines object set of debits
491 =item offset_type (optional) - a string indicating the offset type (valid values are those from
492 the 'account_offset_types
' table)
499 my ( $self, $params ) = @_;
501 my $debits = $params->{debits};
502 my $offset_type = $params->{offset_type} // 'Credit Applied
';
504 unless ( $self->is_credit ) {
505 Koha::Exceptions::Account::IsNotCredit->throw(
506 error => 'Account line
' . $self->id . ' is
not a credit
'
510 my $available_credit = $self->amountoutstanding * -1;
512 unless ( $available_credit > 0 ) {
513 Koha::Exceptions::Account::NoAvailableCredit->throw(
514 error => 'Outstanding credit is
' . $available_credit . ' and cannot be applied
'
518 my $schema = Koha::Database->new->schema;
520 $schema->txn_do( sub {
521 for my $debit ( @{$debits} ) {
523 unless ( $debit->is_debit ) {
524 Koha::Exceptions::Account::IsNotDebit->throw(
525 error => 'Account line
' . $debit->id . 'is
not a debit
'
528 my $amount_to_cancel;
529 my $owed = $debit->amountoutstanding;
531 if ( $available_credit >= $owed ) {
532 $amount_to_cancel = $owed;
534 else { # $available_credit < $debit->amountoutstanding
535 $amount_to_cancel = $available_credit;
538 # record the account offset
539 Koha::Account::Offset->new(
540 { credit_id => $self->id,
541 debit_id => $debit->id,
542 amount => $amount_to_cancel * -1,
543 type => $offset_type,
547 $available_credit -= $amount_to_cancel;
549 $self->amountoutstanding( $available_credit * -1 )->store;
550 $debit->amountoutstanding( $owed - $amount_to_cancel )->store;
552 # Attempt to renew the item associated with this debit if
554 if ($debit->renewable) {
555 $debit->renew_item($params->{interface});
558 # Same logic exists in Koha::Account::pay
560 C4::Context->preference('MarkLostItemsAsReturned
') =~
562 && $debit->debit_type_code
563 && $debit->debit_type_code eq 'LOST
'
564 && $debit->amountoutstanding == 0
565 && $debit->itemnumber
567 $self->credit_type_code eq 'LOST_FOUND
'
568 && $self->itemnumber == $debit->itemnumber
572 C4::Circulation::ReturnLostItem( $self->borrowernumber,
573 $debit->itemnumber );
578 return $available_credit;
583 $credit_accountline->payout(
585 payout_type => $payout_type,
586 register_id => $register_id,
587 staff_id => $staff_id,
588 interface => 'intranet
',
593 Used to 'pay out
' a credit to a user.
595 Payout type may be one of any existing payment types
597 Returns the payout debit line that is created via this transaction.
602 my ( $self, $params ) = @_;
604 # Make sure it is a credit we are paying out
605 unless ( $self->is_credit ) {
606 Koha::Exceptions::Account::IsNotCredit->throw(
607 error => 'Account line
' . $self->id . ' is
not a credit
' );
610 # Check for mandatory parameters
612 ( 'interface
', 'staff_id
', 'branch
', 'payout_type
', 'amount
' );
613 for my $param (@mandatory) {
614 unless ( defined( $params->{$param} ) ) {
615 Koha::Exceptions::MissingParameter->throw(
616 error => "The $param parameter is mandatory" );
620 # Make sure there is outstanding credit to pay out
621 my $outstanding = -1 * $self->amountoutstanding;
623 $params->{amount} ? $params->{amount} : $outstanding;
624 Koha::Exceptions::Account::AmountNotPositive->throw(
625 error => 'Payout amount passed is
not positive
' )
626 unless ( $amount > 0 );
627 Koha::Exceptions::ParameterTooHigh->throw(
628 error => "Amount to payout ($amount) is higher than amountoutstanding ($outstanding)" )
629 unless ($outstanding >= $amount );
631 # Make sure we record the cash register for cash transactions
632 Koha::Exceptions::Account::RegisterRequired->throw()
633 if ( C4::Context->preference("UseCashRegisters")
634 && defined( $params->{payout_type} )
635 && ( $params->{payout_type} eq 'CASH
' )
636 && !defined( $params->{cash_register} ) );
639 $self->_result->result_source->schema->txn_do(
642 # A 'payout
' is a 'debit
'
643 $payout = Koha::Account::Line->new(
647 debit_type_code
=> 'PAYOUT',
648 payment_type
=> $params->{payout_type
},
649 amountoutstanding
=> $amount,
650 manager_id
=> $params->{staff_id
},
651 borrowernumber
=> $self->borrowernumber,
652 interface
=> $params->{interface
},
653 branchcode
=> $params->{branch
},
654 register_id
=> $params->{cash_register
}
658 my $payout_offset = Koha
::Account
::Offset
->new(
660 debit_id
=> $payout->accountlines_id,
666 $self->apply( { debits
=> [$payout], offset_type
=> 'PAYOUT' } );
667 $self->status('PAID')->store;
671 $payout->discard_changes;
677 This method allows updating a debit or credit on a patron's account
679 $account_line->adjust(
682 type => $update_type,
683 interface => $interface
687 $update_type can be any of:
690 Authors Note: The intention here is that this method is only used
691 to adjust accountlines where the final amount is not yet known/fixed.
692 Incrementing fines are the only existing case at the time of writing,
693 all other forms of 'adjustment' should be recorded as distinct credits
694 or debits and applied, via an offset, to the corresponding debit or credit.
699 my ( $self, $params ) = @_;
701 my $amount = $params->{amount
};
702 my $update_type = $params->{type
};
703 my $interface = $params->{interface
};
705 unless ( exists($Koha::Account
::Line
::allowed_update
->{$update_type}) ) {
706 Koha
::Exceptions
::Account
::UnrecognisedType
->throw(
707 error
=> 'Update type not recognised'
711 my $debit_type_code = $self->debit_type_code;
712 my $account_status = $self->status;
716 $Koha::Account
::Line
::allowed_update
->{$update_type}
719 && ( $Koha::Account
::Line
::allowed_update
->{$update_type}
720 ->{$debit_type_code} eq $account_status )
724 Koha
::Exceptions
::Account
::UnrecognisedType
->throw(
725 error
=> 'Update type not allowed on this debit_type' );
728 my $schema = Koha
::Database
->new->schema;
733 my $amount_before = $self->amount;
734 my $amount_outstanding_before = $self->amountoutstanding;
735 my $difference = $amount - $amount_before;
736 my $new_outstanding = $amount_outstanding_before + $difference;
738 my $offset_type = $debit_type_code;
739 $offset_type .= ( $difference > 0 ) ?
"_INCREASE" : "_DECREASE";
741 # Catch cases that require patron refunds
742 if ( $new_outstanding < 0 ) {
744 Koha
::Patrons
->find( $self->borrowernumber )->account;
745 my $credit = $account->add_credit(
747 amount
=> $new_outstanding * -1,
748 type
=> 'OVERPAYMENT',
749 interface
=> $interface,
750 ( $update_type eq 'overdue_update' ?
( item_id
=> $self->itemnumber ) : ()),
753 $new_outstanding = 0;
756 # Update the account line
761 amountoutstanding => $new_outstanding,
765 # Record the account offset
766 my $account_offset = Koha::Account::Offset->new(
768 debit_id => $self->id,
769 type => $offset_type,
770 amount => $difference
774 if ( C4::Context->preference("FinesLog") ) {
776 "FINES", 'UPDATE
', #undef becomes UPDATE in UpdateFine
777 $self->borrowernumber,
779 { action => $update_type,
780 borrowernumber => $self->borrowernumber,
782 description => undef,
783 amountoutstanding => $new_outstanding,
784 debit_type_code => $self->debit_type_code,
786 itemnumber => $self->itemnumber,
790 ) if ( $update_type eq 'overdue_update
' );
800 my $bool = $line->is_credit;
807 return defined $self->credit_type_code;
812 my $bool = $line->is_debit;
819 return !$self->is_credit;
822 =head3 to_api_mapping
824 This method returns the mapping for representing a Koha::Account::Line object
831 accountlines_id => 'account_line_id
',
832 credit_type_code => 'credit_type
',
833 debit_type_code => 'debit_type
',
834 amountoutstanding => 'amount_outstanding
',
835 borrowernumber => 'patron_id
',
836 branchcode => 'library_id
',
837 issue_id => 'checkout_id
',
838 itemnumber => 'item_id
',
839 manager_id => 'user_id
',
840 note => 'internal_note
',
847 my $bool = $line->renewable;
855 $self->amountoutstanding == 0 &&
856 $self->debit_type_code &&
857 $self->debit_type_code eq 'OVERDUE
' &&
859 $self->status eq 'UNRETURNED
'
865 my $renew_result = $line->renew_item;
867 Conditionally attempt to renew an item and return the outcome. This is
868 as a consequence of the fine on an item being fully paid off
873 my ($self, $params) = @_;
877 # We want to reject the call to renew if any of these apply:
878 # - The RenewAccruingItemWhenPaid syspref is off
879 # - The line item doesn't have an item attached to it
880 # - The line item doesn't have a patron attached to it
882 # - The RenewAccruingItemInOpac syspref is off
884 # - There is an interface param passed and it's value is 'opac'
887 !C4
::Context
->preference('RenewAccruingItemWhenPaid') ||
891 !C4
::Context
->preference('RenewAccruingItemInOpac') &&
892 $params->{interface
} &&
893 $params->{interface
} eq 'opac'
899 my $itemnumber = $self->item->itemnumber;
900 my $borrowernumber = $self->patron->borrowernumber;
901 my ( $can_renew, $error ) = C4
::Circulation
::CanBookBeRenewed
(
906 my $due_date = C4
::Circulation
::AddRenewal
(
915 itemnumber
=> $itemnumber,
916 due_date
=> $due_date,
921 itemnumber
=> $itemnumber,
931 Specific store method to generate credit number before saving
938 my $AutoCreditNumber = C4
::Context
->preference('AutoCreditNumber');
939 my $credit_number_enabled = $self->is_credit && $self->credit_type->credit_number_enabled;
941 if ($AutoCreditNumber && $credit_number_enabled && !$self->in_storage) {
942 if (defined $self->credit_number) {
943 Koha
::Exceptions
::Account
->throw('AutoCreditNumber is enabled but credit_number is already defined');
946 my $rs = Koha
::Database
->new->schema->resultset($self->_type);
948 if ($AutoCreditNumber eq 'incremental') {
949 my $max = $rs->search({
950 credit_number
=> { -regexp
=> '^[0-9]+$' }
952 select => \'CAST
(credit_number AS UNSIGNED
)',
953 as => ['credit_number
'],
954 })->get_column('credit_number
')->max;
956 $self->credit_number($max + 1);
957 } elsif ($AutoCreditNumber eq 'annual
') {
958 my $now = dt_from_string;
959 my $prefix = sprintf('%d-', $now->year);
960 my $max = $rs->search({
962 credit_number => { -regexp => '[0-9]{4}$' },
963 credit_number => { -like => "$prefix%" },
965 })->get_column('credit_number
')->max;
966 $max //= $prefix . '0000';
967 my $incr = substr($max, length $prefix);
968 $self->credit_number(sprintf('%s%04d', $prefix, $incr + 1));
969 } elsif ($AutoCreditNumber eq 'branchyyyymmincr
') {
970 my $userenv = C4::Context->userenv;
972 my $branch = $userenv->{branch};
973 my $now = dt_from_string;
974 my $prefix = sprintf('%s%d%02d', $branch, $now->year, $now->month);
975 my $pattern = $prefix;
976 $pattern =~ s/([\?%_])/\\$1/g;
977 my $max = $rs->search({
979 credit_number => { -regexp => '[0-9]{4}$' },
980 credit_number => { -like => "$pattern%" },
982 })->get_column('credit_number
')->max;
983 $max //= $prefix . '0000';
984 my $incr = substr($max, length $prefix);
985 $self->credit_number(sprintf('%s%04d', $prefix, $incr + 1));
990 return $self->SUPER::store();
993 =head2 Internal methods
1002 return 'Accountline
';
1007 =head2 Name mappings
1009 =head3 $allowed_update
1013 our $allowed_update = { 'overdue_update
' => { 'OVERDUE
' => 'UNRETURNED
' } };
1017 Kyle M Hall <kyle@bywatersolutions.com >
1018 Tomás Cohen Arazi <tomascohen@theke.io>
1019 Martin Renvoize <martin.renvoize@ptfs-europe.com>