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
::IsNotCredit
->throw(
171 error
=> 'Account line ' . $self->id . ' is not a debit'
176 $self->_result->search_related('account_offsets_debits')
177 ->search_related( 'credit', $cond, $attr );
179 return Koha
::Account
::Lines
->_new_from_dbic($rs);
184 my $debits = $accountline->debits;
185 my $debits = $accountline->debits( $cond, $attr );
187 Return the debits linked to this account line if some exist.
188 Search conditions and attributes may be passed if you wish to filter
189 the resultant resultant resultset.
194 my ( $self, $cond, $attr ) = @_;
196 unless ( $self->is_credit ) {
197 Koha
::Exceptions
::Account
::IsNotCredit
->throw(
198 error
=> 'Account line ' . $self->id . ' is not a credit'
203 $self->_result->search_related('account_offsets_credits')
204 ->search_related( 'debit', $cond, $attr );
206 return Koha
::Account
::Lines
->_new_from_dbic($rs);
211 $payment_accountline->void();
213 Used to 'void' (or reverse) a payment/credit. It will roll back any offsets
214 created by the application of this credit upon any debits and mark the credit
215 as 'void' by updating it's status to "VOID".
222 # Make sure it is a payment we are voiding
223 return unless $self->amount < 0;
225 my @account_offsets =
226 Koha
::Account
::Offsets
->search(
227 { credit_id
=> $self->id, amount
=> { '<' => 0 } } );
229 $self->_result->result_source->schema->txn_do(
231 foreach my $account_offset (@account_offsets) {
233 Koha
::Account
::Lines
->find( $account_offset->debit_id );
235 next unless $fee_paid;
237 my $amount_paid = $account_offset->amount * -1; # amount paid is stored as a negative amount
238 my $new_amount = $fee_paid->amountoutstanding + $amount_paid;
239 $fee_paid->amountoutstanding($new_amount);
242 Koha
::Account
::Offset
->new(
244 credit_id
=> $self->id,
245 debit_id
=> $fee_paid->id,
246 amount
=> $amount_paid,
247 type
=> 'Void Payment',
252 if ( C4
::Context
->preference("FinesLog") ) {
255 $self->borrowernumber,
258 action
=> 'void_payment',
259 borrowernumber
=> $self->borrowernumber,
260 amount
=> $self->amount,
261 amountoutstanding
=> $self->amountoutstanding,
262 description
=> $self->description,
263 credit_type_code
=> $self->credit_type_code,
264 payment_type
=> $self->payment_type,
266 itemnumber
=> $self->itemnumber,
267 manager_id
=> $self->manager_id,
269 [ map { $_->unblessed } @account_offsets ],
278 amountoutstanding
=> 0,
290 $charge_accountline->reduce({
291 reduction_type => $reduction_type
294 Used to 'reduce' a charge/debit by adding a credit to offset against the amount
297 May be used to apply a discount whilst retaining the original debit amounts or
298 to apply a full or partial refund for example when a lost item is found and
301 It will immediately be applied to the given debit unless the debit has already
302 been paid, in which case a 'zero' offset will be added to maintain a link to
303 the debit but the outstanding credit will be left so it may be applied to other
306 Reduction type may be one of:
311 Returns the reduction accountline (which will be a credit)
316 my ( $self, $params ) = @_;
318 # Make sure it is a charge we are reducing
319 unless ( $self->is_debit ) {
320 Koha
::Exceptions
::Account
::IsNotDebit
->throw(
321 error
=> 'Account line ' . $self->id . 'is not a debit' );
323 if ( $self->debit_type_code eq 'PAYOUT' ) {
324 Koha
::Exceptions
::Account
::IsNotDebit
->throw(
325 error
=> 'Account line ' . $self->id . 'is a payout' );
328 # Check for mandatory parameters
329 my @mandatory = ( 'interface', 'reduction_type', 'amount' );
330 for my $param (@mandatory) {
331 unless ( defined( $params->{$param} ) ) {
332 Koha
::Exceptions
::MissingParameter
->throw(
333 error
=> "The $param parameter is mandatory" );
337 # More mandatory parameters
338 if ( $params->{interface
} eq 'intranet' ) {
339 my @optional = ( 'staff_id', 'branch' );
340 for my $param (@optional) {
341 unless ( defined( $params->{$param} ) ) {
342 Koha
::Exceptions
::MissingParameter
->throw( error
=>
343 "The $param parameter is mandatory when interface is set to 'intranet'"
349 # Make sure the reduction isn't more than the original
350 my $original = $self->amount;
351 Koha
::Exceptions
::Account
::AmountNotPositive
->throw(
352 error
=> 'Reduce amount passed is not positive' )
353 unless ( $params->{amount
} > 0 );
354 Koha
::Exceptions
::ParameterTooHigh
->throw( error
=>
355 "Amount to reduce ($params->{amount}) is higher than original amount ($original)"
356 ) unless ( $original >= $params->{amount
} );
358 $self->credits( { credit_type_code
=> [ 'DISCOUNT', 'REFUND' ] } )->total;
359 Koha
::Exceptions
::ParameterTooHigh
->throw( error
=>
360 "Combined reduction ($params->{amount} + $reduced) is higher than original amount ("
363 unless ( $original >= ( $params->{amount
} + abs($reduced) ) );
365 my $status = { 'REFUND' => 'REFUNDED', 'DISCOUNT' => 'DISCOUNTED' };
368 $self->_result->result_source->schema->txn_do(
371 # A 'reduction' is a 'credit'
372 $reduction = Koha
::Account
::Line
->new(
375 amount => 0 - $params->{amount},
376 credit_type_code => $params->{reduction_type},
378 amountoutstanding => 0 - $params->{amount},
379 manager_id => $params->{staff_id},
380 borrowernumber => $self->borrowernumber,
381 interface => $params->{interface},
382 branchcode => $params->{branch},
386 my $reduction_offset = Koha::Account::Offset->new(
388 credit_id => $reduction->accountlines_id,
389 type => uc( $params->{reduction_type} ),
390 amount => $params->{amount}
394 # Link reduction to charge (and apply as required)
395 my $debit_outstanding = $self->amountoutstanding;
396 if ( $debit_outstanding >= $params->{amount} ) {
401 offset_type => uc( $params->{reduction_type} )
404 $reduction->status('APPLIED
')->store();
408 # Zero amount offset used to link original 'debit
' to reduction 'credit
'
409 my $link_reduction_offset = Koha::Account::Offset->new(
411 credit_id => $reduction->accountlines_id,
412 debit_id => $self->accountlines_id,
413 type => uc( $params->{reduction_type} ),
419 # Update status of original debit
420 $self->status( $status->{ $params->{reduction_type} } )->store;
424 $reduction->discard_changes;
430 my $debits = $account->outstanding_debits;
431 my $outstanding_amount = $credit->apply( { debits => $debits, [ offset_type => $offset_type ] } );
433 Applies the credit to a given debits array reference.
435 =head4 arguments hashref
439 =item debits - Koha::Account::Lines object set of debits
441 =item offset_type (optional) - a string indicating the offset type (valid values are those from
442 the 'account_offset_types
' table)
449 my ( $self, $params ) = @_;
451 my $debits = $params->{debits};
452 my $offset_type = $params->{offset_type} // 'Credit Applied
';
454 unless ( $self->is_credit ) {
455 Koha::Exceptions::Account::IsNotCredit->throw(
456 error => 'Account line
' . $self->id . ' is
not a credit
'
460 my $available_credit = $self->amountoutstanding * -1;
462 unless ( $available_credit > 0 ) {
463 Koha::Exceptions::Account::NoAvailableCredit->throw(
464 error => 'Outstanding credit is
' . $available_credit . ' and cannot be applied
'
468 my $schema = Koha::Database->new->schema;
470 $schema->txn_do( sub {
471 for my $debit ( @{$debits} ) {
473 unless ( $debit->is_debit ) {
474 Koha::Exceptions::Account::IsNotDebit->throw(
475 error => 'Account line
' . $debit->id . 'is
not a debit
'
478 my $amount_to_cancel;
479 my $owed = $debit->amountoutstanding;
481 if ( $available_credit >= $owed ) {
482 $amount_to_cancel = $owed;
484 else { # $available_credit < $debit->amountoutstanding
485 $amount_to_cancel = $available_credit;
488 # record the account offset
489 Koha::Account::Offset->new(
490 { credit_id => $self->id,
491 debit_id => $debit->id,
492 amount => $amount_to_cancel * -1,
493 type => $offset_type,
497 $available_credit -= $amount_to_cancel;
499 $self->amountoutstanding( $available_credit * -1 )->store;
500 $debit->amountoutstanding( $owed - $amount_to_cancel )->store;
502 # Attempt to renew the item associated with this debit if
504 if ($debit->renewable) {
505 $debit->renew_item($params->{interface});
508 # Same logic exists in Koha::Account::pay
510 C4::Context->preference('MarkLostItemsAsReturned
') =~
512 && $debit->debit_type_code
513 && $debit->debit_type_code eq 'LOST
'
514 && $debit->amountoutstanding == 0
515 && $debit->itemnumber
517 $self->credit_type_code eq 'LOST_FOUND
'
518 && $self->itemnumber == $debit->itemnumber
522 C4::Circulation::ReturnLostItem( $self->borrowernumber,
523 $debit->itemnumber );
528 return $available_credit;
533 $credit_accountline->payout(
535 payout_type => $payout_type,
536 register_id => $register_id,
537 staff_id => $staff_id,
538 interface => 'intranet
',
543 Used to 'pay out
' a credit to a user.
545 Payout type may be one of any existing payment types
547 Returns the payout debit line that is created via this transaction.
552 my ( $self, $params ) = @_;
554 # Make sure it is a credit we are paying out
555 unless ( $self->is_credit ) {
556 Koha::Exceptions::Account::IsNotCredit->throw(
557 error => 'Account line
' . $self->id . ' is
not a credit
' );
560 # Check for mandatory parameters
562 ( 'interface
', 'staff_id
', 'branch
', 'payout_type
', 'amount
' );
563 for my $param (@mandatory) {
564 unless ( defined( $params->{$param} ) ) {
565 Koha::Exceptions::MissingParameter->throw(
566 error => "The $param parameter is mandatory" );
570 # Make sure there is outstanding credit to pay out
571 my $outstanding = -1 * $self->amountoutstanding;
573 $params->{amount} ? $params->{amount} : $outstanding;
574 Koha::Exceptions::Account::AmountNotPositive->throw(
575 error => 'Payout amount passed is
not positive
' )
576 unless ( $amount > 0 );
577 Koha::Exceptions::ParameterTooHigh->throw(
578 error => "Amount to payout ($amount) is higher than amountoutstanding ($outstanding)" )
579 unless ($outstanding >= $amount );
581 # Make sure we record the cash register for cash transactions
582 Koha::Exceptions::Account::RegisterRequired->throw()
583 if ( C4::Context->preference("UseCashRegisters")
584 && defined( $params->{payout_type} )
585 && ( $params->{payout_type} eq 'CASH
' )
586 && !defined( $params->{cash_register} ) );
589 $self->_result->result_source->schema->txn_do(
592 # A 'payout
' is a 'debit
'
593 $payout = Koha::Account::Line->new(
597 debit_type_code
=> 'PAYOUT',
598 payment_type
=> $params->{payout_type
},
599 amountoutstanding
=> $amount,
600 manager_id
=> $params->{staff_id
},
601 borrowernumber
=> $self->borrowernumber,
602 interface
=> $params->{interface
},
603 branchcode
=> $params->{branch
},
604 register_id
=> $params->{cash_register
}
608 my $payout_offset = Koha
::Account
::Offset
->new(
610 debit_id
=> $payout->accountlines_id,
616 $self->apply( { debits
=> [$payout], offset_type
=> 'PAYOUT' } );
617 $self->status('PAID')->store;
621 $payout->discard_changes;
627 This method allows updating a debit or credit on a patron's account
629 $account_line->adjust(
632 type => $update_type,
633 interface => $interface
637 $update_type can be any of:
640 Authors Note: The intention here is that this method is only used
641 to adjust accountlines where the final amount is not yet known/fixed.
642 Incrementing fines are the only existing case at the time of writing,
643 all other forms of 'adjustment' should be recorded as distinct credits
644 or debits and applied, via an offset, to the corresponding debit or credit.
649 my ( $self, $params ) = @_;
651 my $amount = $params->{amount
};
652 my $update_type = $params->{type
};
653 my $interface = $params->{interface
};
655 unless ( exists($Koha::Account
::Line
::allowed_update
->{$update_type}) ) {
656 Koha
::Exceptions
::Account
::UnrecognisedType
->throw(
657 error
=> 'Update type not recognised'
661 my $debit_type_code = $self->debit_type_code;
662 my $account_status = $self->status;
666 $Koha::Account
::Line
::allowed_update
->{$update_type}
669 && ( $Koha::Account
::Line
::allowed_update
->{$update_type}
670 ->{$debit_type_code} eq $account_status )
674 Koha
::Exceptions
::Account
::UnrecognisedType
->throw(
675 error
=> 'Update type not allowed on this debit_type' );
678 my $schema = Koha
::Database
->new->schema;
683 my $amount_before = $self->amount;
684 my $amount_outstanding_before = $self->amountoutstanding;
685 my $difference = $amount - $amount_before;
686 my $new_outstanding = $amount_outstanding_before + $difference;
688 my $offset_type = $debit_type_code;
689 $offset_type .= ( $difference > 0 ) ?
"_INCREASE" : "_DECREASE";
691 # Catch cases that require patron refunds
692 if ( $new_outstanding < 0 ) {
694 Koha
::Patrons
->find( $self->borrowernumber )->account;
695 my $credit = $account->add_credit(
697 amount
=> $new_outstanding * -1,
698 description
=> 'Overpayment refund',
700 interface
=> $interface,
701 ( $update_type eq 'overdue_update' ?
( item_id
=> $self->itemnumber ) : ()),
704 $new_outstanding = 0;
707 # Update the account line
712 amountoutstanding => $new_outstanding,
716 # Record the account offset
717 my $account_offset = Koha::Account::Offset->new(
719 debit_id => $self->id,
720 type => $offset_type,
721 amount => $difference
725 if ( C4::Context->preference("FinesLog") ) {
727 "FINES", 'UPDATE
', #undef becomes UPDATE in UpdateFine
728 $self->borrowernumber,
730 { action => $update_type,
731 borrowernumber => $self->borrowernumber,
733 description => undef,
734 amountoutstanding => $new_outstanding,
735 debit_type_code => $self->debit_type_code,
737 itemnumber => $self->itemnumber,
741 ) if ( $update_type eq 'overdue_update
' );
751 my $bool = $line->is_credit;
758 return ( $self->amount < 0 );
763 my $bool = $line->is_debit;
770 return !$self->is_credit;
773 =head3 to_api_mapping
775 This method returns the mapping for representing a Koha::Account::Line object
782 accountlines_id => 'account_line_id
',
783 credit_type_code => 'credit_type
',
784 debit_type_code => 'debit_type
',
785 amountoutstanding => 'amount_outstanding
',
786 borrowernumber => 'patron_id
',
787 branchcode => 'library_id
',
788 issue_id => 'checkout_id
',
789 itemnumber => 'item_id
',
790 manager_id => 'user_id
',
791 note => 'internal_note
',
798 my $bool = $line->renewable;
806 $self->amountoutstanding == 0 &&
807 $self->debit_type_code &&
808 $self->debit_type_code eq 'OVERDUE
' &&
810 $self->status eq 'UNRETURNED
'
816 my $renew_result = $line->renew_item;
818 Conditionally attempt to renew an item and return the outcome. This is
819 as a consequence of the fine on an item being fully paid off
824 my ($self, $params) = @_;
828 # We want to reject the call to renew if any of these apply:
829 # - The RenewAccruingItemWhenPaid syspref is off
830 # - The line item doesn't have an item attached to it
831 # - The line item doesn't have a patron attached to it
833 # - The RenewAccruingItemInOpac syspref is off
835 # - There is an interface param passed and it's value is 'opac'
838 !C4
::Context
->preference('RenewAccruingItemWhenPaid') ||
842 !C4
::Context
->preference('RenewAccruingItemInOpac') &&
843 $params->{interface
} &&
844 $params->{interface
} eq 'opac'
850 my $itemnumber = $self->item->itemnumber;
851 my $borrowernumber = $self->patron->borrowernumber;
852 my ( $can_renew, $error ) = C4
::Circulation
::CanBookBeRenewed
(
857 my $due_date = C4
::Circulation
::AddRenewal
(
866 itemnumber
=> $itemnumber,
867 due_date
=> $due_date,
872 itemnumber
=> $itemnumber,
882 Specific store method to generate credit number before saving
889 my $AutoCreditNumber = C4
::Context
->preference('AutoCreditNumber');
890 my $credit_number_enabled = $self->is_credit && $self->credit_type->credit_number_enabled;
892 if ($AutoCreditNumber && $credit_number_enabled && !$self->in_storage) {
893 if (defined $self->credit_number) {
894 Koha
::Exceptions
::Account
->throw('AutoCreditNumber is enabled but credit_number is already defined');
897 my $rs = Koha
::Database
->new->schema->resultset($self->_type);
899 if ($AutoCreditNumber eq 'incremental') {
900 my $max = $rs->search({
901 credit_number
=> { -regexp
=> '^[0-9]+$' }
903 select => \'CAST
(credit_number AS UNSIGNED
)',
904 as => ['credit_number
'],
905 })->get_column('credit_number
')->max;
907 $self->credit_number($max + 1);
908 } elsif ($AutoCreditNumber eq 'annual
') {
909 my $now = dt_from_string;
910 my $prefix = sprintf('%d-', $now->year);
911 my $max = $rs->search({
913 credit_number => { -regexp => '[0-9]{4}$' },
914 credit_number => { -like => "$prefix%" },
916 })->get_column('credit_number
')->max;
917 $max //= $prefix . '0000';
918 my $incr = substr($max, length $prefix);
919 $self->credit_number(sprintf('%s%04d', $prefix, $incr + 1));
920 } elsif ($AutoCreditNumber eq 'branchyyyymmincr
') {
921 my $userenv = C4::Context->userenv;
923 my $branch = $userenv->{branch};
924 my $now = dt_from_string;
925 my $prefix = sprintf('%s%d%02d', $branch, $now->year, $now->month);
926 my $pattern = $prefix;
927 $pattern =~ s/([\?%_])/\\$1/g;
928 my $max = $rs->search({
930 credit_number => { -regexp => '[0-9]{4}$' },
931 credit_number => { -like => "$pattern%" },
933 })->get_column('credit_number
')->max;
934 $max //= $prefix . '0000';
935 my $incr = substr($max, length $prefix);
936 $self->credit_number(sprintf('%s%04d', $prefix, $incr + 1));
941 return $self->SUPER::store();
944 =head2 Internal methods
953 return 'Accountline
';
960 =head3 $allowed_update
964 our $allowed_update = { 'overdue_update
' => { 'OVERDUE
' => 'UNRETURNED
' } };
968 Kyle M Hall <kyle@bywatersolutions.com >
969 Tomás Cohen Arazi <tomascohen@theke.io>
970 Martin Renvoize <martin.renvoize@ptfs-europe.com>