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
;
30 use Koha
::Exceptions
::Account
;
33 use base
qw(Koha::Object);
39 Koha::Account::Line - Koha accountline Object class
49 Return the patron linked to this account line
55 my $rs = $self->_result->borrowernumber;
57 return Koha
::Patron
->_new_from_dbic( $rs );
62 Return the item linked to this account line if exists
68 my $rs = $self->_result->itemnumber;
70 return Koha
::Item
->_new_from_dbic( $rs );
75 Return the checkout linked to this account line if exists
81 return unless $self->issue_id ;
83 $self->{_checkout
} ||= Koha
::Checkouts
->find( $self->issue_id );
84 $self->{_checkout
} ||= Koha
::Old
::Checkouts
->find( $self->issue_id );
85 return $self->{_checkout
};
90 Returns a Koha::Library object representing where the accountline was recorded
96 my $rs = $self->_result->library;
98 return Koha
::Library
->_new_from_dbic($rs);
103 Return the credit_type linked to this account line
109 my $rs = $self->_result->credit_type_code;
111 return Koha
::Account
::CreditType
->_new_from_dbic( $rs );
116 Return the debit_type linked to this account line
122 my $rs = $self->_result->debit_type_code;
124 return Koha
::Account
::DebitType
->_new_from_dbic( $rs );
127 =head3 credit_offsets
129 Return the credit_offsets linked to this account line if some exist
135 my $rs = $self->_result->account_offsets_credits;
137 return Koha
::Account
::Offsets
->_new_from_dbic($rs);
142 Return the debit_offsets linked to this account line if some exist
148 my $rs = $self->_result->account_offsets_debits;
150 return Koha
::Account
::Offsets
->_new_from_dbic($rs);
156 my $credits = $accountline->credits;
157 my $credits = $accountline->credits( $cond, $attr );
159 Return the credits linked to this account line if some exist.
160 Search conditions and attributes may be passed if you wish to filter
161 the resultant resultant resultset.
166 my ( $self, $cond, $attr ) = @_;
168 unless ( $self->is_debit ) {
169 Koha
::Exceptions
::Account
::IsNotCredit
->throw(
170 error
=> 'Account line ' . $self->id . ' is not a debit'
175 $self->_result->search_related('account_offsets_debits')
176 ->search_related( 'credit', $cond, $attr );
178 return Koha
::Account
::Lines
->_new_from_dbic($rs);
183 my $debits = $accountline->debits;
184 my $debits = $accountline->debits( $cond, $attr );
186 Return the debits linked to this account line if some exist.
187 Search conditions and attributes may be passed if you wish to filter
188 the resultant resultant resultset.
193 my ( $self, $cond, $attr ) = @_;
195 unless ( $self->is_credit ) {
196 Koha
::Exceptions
::Account
::IsNotCredit
->throw(
197 error
=> 'Account line ' . $self->id . ' is not a credit'
202 $self->_result->search_related('account_offsets_credits')
203 ->search_related( 'debit', $cond, $attr );
205 return Koha
::Account
::Lines
->_new_from_dbic($rs);
210 $payment_accountline->void();
212 Used to 'void' (or reverse) a payment/credit. It will roll back any offsets
213 created by the application of this credit upon any debits and mark the credit
214 as 'void' by updating it's status to "VOID".
221 # Make sure it is a payment we are voiding
222 return unless $self->amount < 0;
224 my @account_offsets =
225 Koha
::Account
::Offsets
->search(
226 { credit_id
=> $self->id, amount
=> { '<' => 0 } } );
228 $self->_result->result_source->schema->txn_do(
230 foreach my $account_offset (@account_offsets) {
232 Koha
::Account
::Lines
->find( $account_offset->debit_id );
234 next unless $fee_paid;
236 my $amount_paid = $account_offset->amount * -1; # amount paid is stored as a negative amount
237 my $new_amount = $fee_paid->amountoutstanding + $amount_paid;
238 $fee_paid->amountoutstanding($new_amount);
241 Koha
::Account
::Offset
->new(
243 credit_id
=> $self->id,
244 debit_id
=> $fee_paid->id,
245 amount
=> $amount_paid,
246 type
=> 'Void Payment',
251 if ( C4
::Context
->preference("FinesLog") ) {
254 $self->borrowernumber,
257 action
=> 'void_payment',
258 borrowernumber
=> $self->borrowernumber,
259 amount
=> $self->amount,
260 amountoutstanding
=> $self->amountoutstanding,
261 description
=> $self->description,
262 credit_type_code
=> $self->credit_type_code,
263 payment_type
=> $self->payment_type,
265 itemnumber
=> $self->itemnumber,
266 manager_id
=> $self->manager_id,
268 [ map { $_->unblessed } @account_offsets ],
277 amountoutstanding
=> 0,
289 $charge_accountline->reduce({
290 reduction_type => $reduction_type
293 Used to 'reduce' a charge/debit by adding a credit to offset against the amount
296 May be used to apply a discount whilst retaining the original debit amounts or
297 to apply a full or partial refund for example when a lost item is found and
300 It will immediately be applied to the given debit unless the debit has already
301 been paid, in which case a 'zero' offset will be added to maintain a link to
302 the debit but the outstanding credit will be left so it may be applied to other
305 Reduction type may be one of:
310 Returns the reduction accountline (which will be a credit)
315 my ( $self, $params ) = @_;
317 # Make sure it is a charge we are reducing
318 unless ( $self->is_debit ) {
319 Koha
::Exceptions
::Account
::IsNotDebit
->throw(
320 error
=> 'Account line ' . $self->id . 'is not a debit' );
322 if ( $self->debit_type_code eq 'PAYOUT' ) {
323 Koha
::Exceptions
::Account
::IsNotDebit
->throw(
324 error
=> 'Account line ' . $self->id . 'is a payout' );
327 # Check for mandatory parameters
328 my @mandatory = ( 'interface', 'reduction_type', 'amount' );
329 for my $param (@mandatory) {
330 unless ( defined( $params->{$param} ) ) {
331 Koha
::Exceptions
::MissingParameter
->throw(
332 error
=> "The $param parameter is mandatory" );
336 # More mandatory parameters
337 if ( $params->{interface
} eq 'intranet' ) {
338 my @optional = ( 'staff_id', 'branch' );
339 for my $param (@optional) {
340 unless ( defined( $params->{$param} ) ) {
341 Koha
::Exceptions
::MissingParameter
->throw( error
=>
342 "The $param parameter is mandatory when interface is set to 'intranet'"
348 # Make sure the reduction isn't more than the original
349 my $original = $self->amount;
350 Koha
::Exceptions
::Account
::AmountNotPositive
->throw(
351 error
=> 'Reduce amount passed is not positive' )
352 unless ( $params->{amount
} > 0 );
353 Koha
::Exceptions
::ParameterTooHigh
->throw( error
=>
354 "Amount to reduce ($params->{amount}) is higher than original amount ($original)"
355 ) unless ( $original >= $params->{amount
} );
357 $self->credits( { credit_type_code
=> [ 'DISCOUNT', 'REFUND' ] } )->total;
358 Koha
::Exceptions
::ParameterTooHigh
->throw( error
=>
359 "Combined reduction ($params->{amount} + $reduced) is higher than original amount ("
362 unless ( $original >= ( $params->{amount
} + abs($reduced) ) );
364 my $status = { 'REFUND' => 'REFUNDED', 'DISCOUNT' => 'DISCOUNTED' };
367 $self->_result->result_source->schema->txn_do(
370 # A 'reduction' is a 'credit'
371 $reduction = Koha
::Account
::Line
->new(
374 amount => 0 - $params->{amount},
375 credit_type_code => $params->{reduction_type},
377 amountoutstanding => 0 - $params->{amount},
378 manager_id => $params->{staff_id},
379 borrowernumber => $self->borrowernumber,
380 interface => $params->{interface},
381 branchcode => $params->{branch},
385 my $reduction_offset = Koha::Account::Offset->new(
387 credit_id => $reduction->accountlines_id,
388 type => uc( $params->{reduction_type} ),
389 amount => $params->{amount}
393 # Link reduction to charge (and apply as required)
394 my $debit_outstanding = $self->amountoutstanding;
395 if ( $debit_outstanding >= $params->{amount} ) {
400 offset_type => uc( $params->{reduction_type} )
403 $reduction->status('APPLIED
')->store();
407 # Zero amount offset used to link original 'debit
' to reduction 'credit
'
408 my $link_reduction_offset = Koha::Account::Offset->new(
410 credit_id => $reduction->accountlines_id,
411 debit_id => $self->accountlines_id,
412 type => uc( $params->{reduction_type} ),
418 # Update status of original debit
419 $self->status( $status->{ $params->{reduction_type} } )->store;
423 $reduction->discard_changes;
429 my $debits = $account->outstanding_debits;
430 my $outstanding_amount = $credit->apply( { debits => $debits, [ offset_type => $offset_type ] } );
432 Applies the credit to a given debits array reference.
434 =head4 arguments hashref
438 =item debits - Koha::Account::Lines object set of debits
440 =item offset_type (optional) - a string indicating the offset type (valid values are those from
441 the 'account_offset_types
' table)
448 my ( $self, $params ) = @_;
450 my $debits = $params->{debits};
451 my $offset_type = $params->{offset_type} // 'Credit Applied
';
453 unless ( $self->is_credit ) {
454 Koha::Exceptions::Account::IsNotCredit->throw(
455 error => 'Account line
' . $self->id . ' is
not a credit
'
459 my $available_credit = $self->amountoutstanding * -1;
461 unless ( $available_credit > 0 ) {
462 Koha::Exceptions::Account::NoAvailableCredit->throw(
463 error => 'Outstanding credit is
' . $available_credit . ' and cannot be applied
'
467 my $schema = Koha::Database->new->schema;
469 $schema->txn_do( sub {
470 for my $debit ( @{$debits} ) {
472 unless ( $debit->is_debit ) {
473 Koha::Exceptions::Account::IsNotDebit->throw(
474 error => 'Account line
' . $debit->id . 'is
not a debit
'
477 my $amount_to_cancel;
478 my $owed = $debit->amountoutstanding;
480 if ( $available_credit >= $owed ) {
481 $amount_to_cancel = $owed;
483 else { # $available_credit < $debit->amountoutstanding
484 $amount_to_cancel = $available_credit;
487 # record the account offset
488 Koha::Account::Offset->new(
489 { credit_id => $self->id,
490 debit_id => $debit->id,
491 amount => $amount_to_cancel * -1,
492 type => $offset_type,
496 $available_credit -= $amount_to_cancel;
498 $self->amountoutstanding( $available_credit * -1 )->store;
499 $debit->amountoutstanding( $owed - $amount_to_cancel )->store;
501 # Attempt to renew the item associated with this debit if
503 if ($debit->renewable) {
504 $debit->renew_item($params->{interface});
507 # Same logic exists in Koha::Account::pay
509 C4::Context->preference('MarkLostItemsAsReturned
') =~
511 && $debit->debit_type_code
512 && $debit->debit_type_code eq 'LOST
'
513 && $debit->amountoutstanding == 0
514 && $debit->itemnumber
516 $self->credit_type_code eq 'LOST_FOUND
'
517 && $self->itemnumber == $debit->itemnumber
521 C4::Circulation::ReturnLostItem( $self->borrowernumber,
522 $debit->itemnumber );
527 return $available_credit;
532 $credit_accountline->payout(
534 payout_type => $payout_type,
535 register_id => $register_id,
536 staff_id => $staff_id,
537 interface => 'intranet
',
542 Used to 'pay out
' a credit to a user.
544 Payout type may be one of any existing payment types
546 Returns the payout debit line that is created via this transaction.
551 my ( $self, $params ) = @_;
553 # Make sure it is a credit we are paying out
554 unless ( $self->is_credit ) {
555 Koha::Exceptions::Account::IsNotCredit->throw(
556 error => 'Account line
' . $self->id . ' is
not a credit
' );
559 # Check for mandatory parameters
561 ( 'interface
', 'staff_id
', 'branch
', 'payout_type
', 'amount
' );
562 for my $param (@mandatory) {
563 unless ( defined( $params->{$param} ) ) {
564 Koha::Exceptions::MissingParameter->throw(
565 error => "The $param parameter is mandatory" );
569 # Make sure there is outstanding credit to pay out
570 my $outstanding = -1 * $self->amountoutstanding;
572 $params->{amount} ? $params->{amount} : $outstanding;
573 Koha::Exceptions::Account::AmountNotPositive->throw(
574 error => 'Payout amount passed is
not positive
' )
575 unless ( $amount > 0 );
576 Koha::Exceptions::ParameterTooHigh->throw(
577 error => "Amount to payout ($amount) is higher than amountoutstanding ($outstanding)" )
578 unless ($outstanding >= $amount );
580 # Make sure we record the cash register for cash transactions
581 Koha::Exceptions::Account::RegisterRequired->throw()
582 if ( C4::Context->preference("UseCashRegisters")
583 && defined( $params->{payout_type} )
584 && ( $params->{payout_type} eq 'CASH
' )
585 && !defined( $params->{cash_register} ) );
588 $self->_result->result_source->schema->txn_do(
591 # A 'payout
' is a 'debit
'
592 $payout = Koha::Account::Line->new(
596 debit_type_code
=> 'PAYOUT',
597 payment_type
=> $params->{payout_type
},
598 amountoutstanding
=> $amount,
599 manager_id
=> $params->{staff_id
},
600 borrowernumber
=> $self->borrowernumber,
601 interface
=> $params->{interface
},
602 branchcode
=> $params->{branch
},
603 register_id
=> $params->{cash_register
}
607 my $payout_offset = Koha
::Account
::Offset
->new(
609 debit_id
=> $payout->accountlines_id,
615 $self->apply( { debits
=> [$payout], offset_type
=> 'PAYOUT' } );
616 $self->status('PAID')->store;
620 $payout->discard_changes;
626 This method allows updating a debit or credit on a patron's account
628 $account_line->adjust(
631 type => $update_type,
632 interface => $interface
636 $update_type can be any of:
639 Authors Note: The intention here is that this method is only used
640 to adjust accountlines where the final amount is not yet known/fixed.
641 Incrementing fines are the only existing case at the time of writing,
642 all other forms of 'adjustment' should be recorded as distinct credits
643 or debits and applied, via an offset, to the corresponding debit or credit.
648 my ( $self, $params ) = @_;
650 my $amount = $params->{amount
};
651 my $update_type = $params->{type
};
652 my $interface = $params->{interface
};
654 unless ( exists($Koha::Account
::Line
::allowed_update
->{$update_type}) ) {
655 Koha
::Exceptions
::Account
::UnrecognisedType
->throw(
656 error
=> 'Update type not recognised'
660 my $debit_type_code = $self->debit_type_code;
661 my $account_status = $self->status;
665 $Koha::Account
::Line
::allowed_update
->{$update_type}
668 && ( $Koha::Account
::Line
::allowed_update
->{$update_type}
669 ->{$debit_type_code} eq $account_status )
673 Koha
::Exceptions
::Account
::UnrecognisedType
->throw(
674 error
=> 'Update type not allowed on this debit_type' );
677 my $schema = Koha
::Database
->new->schema;
682 my $amount_before = $self->amount;
683 my $amount_outstanding_before = $self->amountoutstanding;
684 my $difference = $amount - $amount_before;
685 my $new_outstanding = $amount_outstanding_before + $difference;
687 my $offset_type = $debit_type_code;
688 $offset_type .= ( $difference > 0 ) ?
"_INCREASE" : "_DECREASE";
690 # Catch cases that require patron refunds
691 if ( $new_outstanding < 0 ) {
693 Koha
::Patrons
->find( $self->borrowernumber )->account;
694 my $credit = $account->add_credit(
696 amount
=> $new_outstanding * -1,
697 description
=> 'Overpayment refund',
699 interface
=> $interface,
700 ( $update_type eq 'overdue_update' ?
( item_id
=> $self->itemnumber ) : ()),
703 $new_outstanding = 0;
706 # Update the account line
711 amountoutstanding => $new_outstanding,
715 # Record the account offset
716 my $account_offset = Koha::Account::Offset->new(
718 debit_id => $self->id,
719 type => $offset_type,
720 amount => $difference
724 if ( C4::Context->preference("FinesLog") ) {
726 "FINES", 'UPDATE
', #undef becomes UPDATE in UpdateFine
727 $self->borrowernumber,
729 { action => $update_type,
730 borrowernumber => $self->borrowernumber,
732 description => undef,
733 amountoutstanding => $new_outstanding,
734 debit_type_code => $self->debit_type_code,
736 itemnumber => $self->itemnumber,
740 ) if ( $update_type eq 'overdue_update
' );
750 my $bool = $line->is_credit;
757 return ( $self->amount < 0 );
762 my $bool = $line->is_debit;
769 return !$self->is_credit;
772 =head3 to_api_mapping
774 This method returns the mapping for representing a Koha::Account::Line object
781 accountlines_id => 'account_line_id
',
782 credit_type_code => 'credit_type
',
783 debit_type_code => 'debit_type
',
784 amountoutstanding => 'amount_outstanding
',
785 borrowernumber => 'patron_id
',
786 branchcode => 'library_id
',
787 issue_id => 'checkout_id
',
788 itemnumber => 'item_id
',
789 manager_id => 'user_id
',
790 note => 'internal_note
',
797 my $bool = $line->renewable;
805 $self->amountoutstanding == 0 &&
806 $self->debit_type_code &&
807 $self->debit_type_code eq 'OVERDUE
' &&
809 $self->status eq 'UNRETURNED
'
815 my $renew_result = $line->renew_item;
817 Conditionally attempt to renew an item and return the outcome. This is
818 as a consequence of the fine on an item being fully paid off
823 my ($self, $params) = @_;
827 # We want to reject the call to renew if any of these apply:
828 # - The RenewAccruingItemWhenPaid syspref is off
829 # - The line item doesn't have an item attached to it
830 # - The line item doesn't have a patron attached to it
832 # - The RenewAccruingItemInOpac syspref is off
834 # - There is an interface param passed and it's value is 'opac'
837 !C4
::Context
->preference('RenewAccruingItemWhenPaid') ||
841 !C4
::Context
->preference('RenewAccruingItemInOpac') &&
842 $params->{interface
} &&
843 $params->{interface
} eq 'opac'
849 my $itemnumber = $self->item->itemnumber;
850 my $borrowernumber = $self->patron->borrowernumber;
851 my ( $can_renew, $error ) = C4
::Circulation
::CanBookBeRenewed
(
856 my $due_date = C4
::Circulation
::AddRenewal
(
865 itemnumber
=> $itemnumber,
866 due_date
=> $due_date,
871 itemnumber
=> $itemnumber,
881 Specific store method to generate credit number before saving
888 my $AutoCreditNumber = C4
::Context
->preference('AutoCreditNumber');
889 my $credit_number_enabled = $self->is_credit && $self->credit_type->credit_number_enabled;
891 if ($AutoCreditNumber && $credit_number_enabled && !$self->in_storage) {
892 if (defined $self->credit_number) {
893 Koha
::Exceptions
::Account
->throw('AutoCreditNumber is enabled but credit_number is already defined');
896 my $rs = Koha
::Database
->new->schema->resultset($self->_type);
898 if ($AutoCreditNumber eq 'incremental') {
899 my $max = $rs->search({
900 credit_number
=> { -regexp
=> '^[0-9]+$' }
902 select => \'CAST
(credit_number AS UNSIGNED
)',
903 as => ['credit_number
'],
904 })->get_column('credit_number
')->max;
906 $self->credit_number($max + 1);
907 } elsif ($AutoCreditNumber eq 'annual
') {
908 my $now = DateTime->now;
909 my $prefix = sprintf('%d-', $now->year);
910 my $max = $rs->search({
912 credit_number => { -regexp => '[0-9]{4}$' },
913 credit_number => { -like => "$prefix%" },
915 })->get_column('credit_number
')->max;
916 $max //= $prefix . '0000';
917 my $incr = substr($max, length $prefix);
918 $self->credit_number(sprintf('%s%04d', $prefix, $incr + 1));
919 } elsif ($AutoCreditNumber eq 'branchyyyymmincr
') {
920 my $userenv = C4::Context->userenv;
922 my $branch = $userenv->{branch};
923 my $now = DateTime->now;
924 my $prefix = sprintf('%s%d%02d', $branch, $now->year, $now->month);
925 my $pattern = $prefix;
926 $pattern =~ s/([\?%_])/\\$1/g;
927 my $max = $rs->search({
929 credit_number => { -regexp => '[0-9]{4}$' },
930 credit_number => { -like => "$pattern%" },
932 })->get_column('credit_number
')->max;
933 $max //= $prefix . '0000';
934 my $incr = substr($max, length $prefix);
935 $self->credit_number(sprintf('%s%04d', $prefix, $incr + 1));
940 return $self->SUPER::store();
943 =head2 Internal methods
952 return 'Accountline
';
959 =head3 $allowed_update
963 our $allowed_update = { 'overdue_update
' => { 'OVERDUE
' => 'UNRETURNED
' } };
967 Kyle M Hall <kyle@bywatersolutions.com >
968 Tomás Cohen Arazi <tomascohen@theke.io>
969 Martin Renvoize <martin.renvoize@ptfs-europe.com>