package Koha::Account::Line; # This file is part of Koha. # # Koha is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # # Koha is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with Koha; if not, see . use Modern::Perl; use Carp; use Data::Dumper; use C4::Log qw(logaction); use C4::Overdues qw(GetFine); use Koha::Account::CreditType; use Koha::Account::DebitType; use Koha::Account::Offsets; use Koha::Database; use Koha::Exceptions::Account; use Koha::Items; use base qw(Koha::Object); =encoding utf8 =head1 NAME Koha::Account::Line - Koha accountline Object class =head1 API =head2 Class methods =cut =head3 patron Return the patron linked to this account line =cut sub patron { my ( $self ) = @_; my $rs = $self->_result->borrowernumber; return unless $rs; return Koha::Patron->_new_from_dbic( $rs ); } =head3 item Return the item linked to this account line if exists =cut sub item { my ( $self ) = @_; my $rs = $self->_result->itemnumber; return unless $rs; return Koha::Item->_new_from_dbic( $rs ); } =head3 checkout Return the checkout linked to this account line if exists =cut sub checkout { my ( $self ) = @_; return unless $self->issue_id ; $self->{_checkout} ||= Koha::Checkouts->find( $self->issue_id ); $self->{_checkout} ||= Koha::Old::Checkouts->find( $self->issue_id ); return $self->{_checkout}; } =head3 credit_type Return the credit_type linked to this account line =cut sub credit_type { my ( $self ) = @_; my $rs = $self->_result->credit_type_code; return unless $rs; return Koha::Account::CreditType->_new_from_dbic( $rs ); } =head3 debit_type Return the debit_type linked to this account line =cut sub debit_type { my ( $self ) = @_; my $rs = $self->_result->debit_type_code; return unless $rs; return Koha::Account::DebitType->_new_from_dbic( $rs ); } =head3 credit_offsets Return the credit_offsets linked to this account line if some exist =cut sub credit_offsets { my ( $self ) = @_; my $rs = $self->_result->account_offsets_credits; return unless $rs; return Koha::Account::Offsets->_new_from_dbic($rs); } =head3 debit_offsets Return the debit_offsets linked to this account line if some exist =cut sub debit_offsets { my ( $self ) = @_; my $rs = $self->_result->account_offsets_debits; return unless $rs; return Koha::Account::Offsets->_new_from_dbic($rs); } =head3 credits my $credits = $accountline->credits; my $credits = $accountline->credits( $cond, $attr ); Return the credits linked to this account line if some exist. Search conditions and attributes may be passed if you wish to filter the resultant resultant resultset. =cut sub credits { my ( $self, $cond, $attr ) = @_; unless ( $self->is_debit ) { Koha::Exceptions::Account::IsNotCredit->throw( error => 'Account line ' . $self->id . ' is not a debit' ); } my $rs = $self->_result->search_related('account_offsets_debits') ->search_related( 'credit', $cond, $attr ); return unless $rs; return Koha::Account::Lines->_new_from_dbic($rs); } =head3 debits my $debits = $accountline->debits; my $debits = $accountline->debits( $cond, $attr ); Return the debits linked to this account line if some exist. Search conditions and attributes may be passed if you wish to filter the resultant resultant resultset. =cut sub debits { my ( $self, $cond, $attr ) = @_; unless ( $self->is_credit ) { Koha::Exceptions::Account::IsNotCredit->throw( error => 'Account line ' . $self->id . ' is not a credit' ); } my $rs = $self->_result->search_related('account_offsets_credits') ->search_related( 'debit', $cond, $attr ); return unless $rs; return Koha::Account::Lines->_new_from_dbic($rs); } =head3 void $payment_accountline->void(); Used to 'void' (or reverse) a payment/credit. It will roll back any offsets created by the application of this credit upon any debits and mark the credit as 'void' by updating it's status to "VOID". =cut sub void { my ($self) = @_; # Make sure it is a payment we are voiding return unless $self->amount < 0; my @account_offsets = Koha::Account::Offsets->search( { credit_id => $self->id, amount => { '<' => 0 } } ); $self->_result->result_source->schema->txn_do( sub { foreach my $account_offset (@account_offsets) { my $fee_paid = Koha::Account::Lines->find( $account_offset->debit_id ); next unless $fee_paid; my $amount_paid = $account_offset->amount * -1; # amount paid is stored as a negative amount my $new_amount = $fee_paid->amountoutstanding + $amount_paid; $fee_paid->amountoutstanding($new_amount); $fee_paid->store(); Koha::Account::Offset->new( { credit_id => $self->id, debit_id => $fee_paid->id, amount => $amount_paid, type => 'Void Payment', } )->store(); } if ( C4::Context->preference("FinesLog") ) { logaction( "FINES", 'VOID', $self->borrowernumber, Dumper( { action => 'void_payment', borrowernumber => $self->borrowernumber, amount => $self->amount, amountoutstanding => $self->amountoutstanding, description => $self->description, credit_type_code => $self->credit_type_code, payment_type => $self->payment_type, note => $self->note, itemnumber => $self->itemnumber, manager_id => $self->manager_id, offsets => [ map { $_->unblessed } @account_offsets ], } ) ); } $self->set( { status => 'VOID', amountoutstanding => 0, amount => 0, } ); $self->store(); } ); } =head3 reduce $charge_accountline->reduce({ reduction_type => $reduction_type }); Used to 'reduce' a charge/debit by adding a credit to offset against the amount outstanding. May be used to apply a discount whilst retaining the original debit amounts or to apply a full or partial refund for example when a lost item is found and returned. It will immediately be applied to the given debit unless the debit has already been paid, in which case a 'zero' offset will be added to maintain a link to the debit but the outstanding credit will be left so it may be applied to other debts. Reduction type may be one of: * REFUND * DISCOUNT Returns the reduction accountline (which will be a credit) =cut sub reduce { my ( $self, $params ) = @_; # Make sure it is a charge we are reducing unless ( $self->is_debit ) { Koha::Exceptions::Account::IsNotDebit->throw( error => 'Account line ' . $self->id . 'is not a debit' ); } if ( $self->debit_type_code eq 'PAYOUT' ) { Koha::Exceptions::Account::IsNotDebit->throw( error => 'Account line ' . $self->id . 'is a payout' ); } # Check for mandatory parameters my @mandatory = ( 'interface', 'reduction_type', 'amount' ); for my $param (@mandatory) { unless ( defined( $params->{$param} ) ) { Koha::Exceptions::MissingParameter->throw( error => "The $param parameter is mandatory" ); } } # More mandatory parameters if ( $params->{interface} eq 'intranet' ) { my @optional = ( 'staff_id', 'branch' ); for my $param (@optional) { unless ( defined( $params->{$param} ) ) { Koha::Exceptions::MissingParameter->throw( error => "The $param parameter is mandatory when interface is set to 'intranet'" ); } } } # Make sure the reduction isn't more than the original my $original = $self->amount; Koha::Exceptions::Account::AmountNotPositive->throw( error => 'Reduce amount passed is not positive' ) unless ( $params->{amount} > 0 ); Koha::Exceptions::ParameterTooHigh->throw( error => "Amount to reduce ($params->{amount}) is higher than original amount ($original)" ) unless ( $original >= $params->{amount} ); my $reduced = $self->credits( { credit_type_code => [ 'DISCOUNT', 'REFUND' ] } )->total; Koha::Exceptions::ParameterTooHigh->throw( error => "Combined reduction ($params->{amount} + $reduced) is higher than original amount (" . abs($original) . ")" ) unless ( $original >= ( $params->{amount} + abs($reduced) ) ); my $status = { 'REFUND' => 'REFUNDED', 'DISCOUNT' => 'DISCOUNTED' }; my $reduction; $self->_result->result_source->schema->txn_do( sub { # A 'reduction' is a 'credit' $reduction = Koha::Account::Line->new( { date => \'NOW()', amount => 0 - $params->{amount}, credit_type_code => $params->{reduction_type}, status => 'ADDED', amountoutstanding => 0 - $params->{amount}, manager_id => $params->{staff_id}, borrowernumber => $self->borrowernumber, interface => $params->{interface}, branchcode => $params->{branch}, } )->store(); my $reduction_offset = Koha::Account::Offset->new( { credit_id => $reduction->accountlines_id, type => uc( $params->{reduction_type} ), amount => $params->{amount} } )->store(); # Link reduction to charge (and apply as required) my $debit_outstanding = $self->amountoutstanding; if ( $debit_outstanding >= $params->{amount} ) { $reduction->apply( { debits => [$self], offset_type => uc( $params->{reduction_type} ) } ); $reduction->status('APPLIED')->store(); } else { # Zero amount offset used to link original 'debit' to reduction 'credit' my $link_reduction_offset = Koha::Account::Offset->new( { credit_id => $reduction->accountlines_id, debit_id => $self->accountlines_id, type => uc( $params->{reduction_type} ), amount => 0 } )->store(); } # Update status of original debit $self->status( $status->{ $params->{reduction_type} } )->store; } ); $reduction->discard_changes; return $reduction; } =head3 apply my $debits = $account->outstanding_debits; my $outstanding_amount = $credit->apply( { debits => $debits, [ offset_type => $offset_type ] } ); Applies the credit to a given debits array reference. =head4 arguments hashref =over 4 =item debits - Koha::Account::Lines object set of debits =item offset_type (optional) - a string indicating the offset type (valid values are those from the 'account_offset_types' table) =back =cut sub apply { my ( $self, $params ) = @_; my $debits = $params->{debits}; my $offset_type = $params->{offset_type} // 'Credit Applied'; unless ( $self->is_credit ) { Koha::Exceptions::Account::IsNotCredit->throw( error => 'Account line ' . $self->id . ' is not a credit' ); } my $available_credit = $self->amountoutstanding * -1; unless ( $available_credit > 0 ) { Koha::Exceptions::Account::NoAvailableCredit->throw( error => 'Outstanding credit is ' . $available_credit . ' and cannot be applied' ); } my $schema = Koha::Database->new->schema; $schema->txn_do( sub { for my $debit ( @{$debits} ) { unless ( $debit->is_debit ) { Koha::Exceptions::Account::IsNotDebit->throw( error => 'Account line ' . $debit->id . 'is not a debit' ); } my $amount_to_cancel; my $owed = $debit->amountoutstanding; if ( $available_credit >= $owed ) { $amount_to_cancel = $owed; } else { # $available_credit < $debit->amountoutstanding $amount_to_cancel = $available_credit; } # record the account offset Koha::Account::Offset->new( { credit_id => $self->id, debit_id => $debit->id, amount => $amount_to_cancel * -1, type => $offset_type, } )->store(); $available_credit -= $amount_to_cancel; $self->amountoutstanding( $available_credit * -1 )->store; $debit->amountoutstanding( $owed - $amount_to_cancel )->store; # Attempt to renew the item associated with this debit if # appropriate if ($debit->renewable) { $debit->renew_item($params->{interface}); } # Same logic exists in Koha::Account::pay if ( C4::Context->preference('MarkLostItemsAsReturned') =~ m|onpayment| && $debit->debit_type_code && $debit->debit_type_code eq 'LOST' && $debit->amountoutstanding == 0 && $debit->itemnumber && !( $self->credit_type_code eq 'LOST_FOUND' && $self->itemnumber == $debit->itemnumber ) ) { C4::Circulation::ReturnLostItem( $self->borrowernumber, $debit->itemnumber ); } } }); return $available_credit; } =head3 payout $credit_accountline->payout( { payout_type => $payout_type, register_id => $register_id, staff_id => $staff_id, interface => 'intranet', amount => $amount } ); Used to 'pay out' a credit to a user. Payout type may be one of any existing payment types Returns the payout debit line that is created via this transaction. =cut sub payout { my ( $self, $params ) = @_; # Make sure it is a credit we are paying out unless ( $self->is_credit ) { Koha::Exceptions::Account::IsNotCredit->throw( error => 'Account line ' . $self->id . ' is not a credit' ); } # Check for mandatory parameters my @mandatory = ( 'interface', 'staff_id', 'branch', 'payout_type', 'amount' ); for my $param (@mandatory) { unless ( defined( $params->{$param} ) ) { Koha::Exceptions::MissingParameter->throw( error => "The $param parameter is mandatory" ); } } # Make sure there is outstanding credit to pay out my $outstanding = -1 * $self->amountoutstanding; my $amount = $params->{amount} ? $params->{amount} : $outstanding; Koha::Exceptions::Account::AmountNotPositive->throw( error => 'Payout amount passed is not positive' ) unless ( $amount > 0 ); Koha::Exceptions::ParameterTooHigh->throw( error => "Amount to payout ($amount) is higher than amountoutstanding ($outstanding)" ) unless ($outstanding >= $amount ); # Make sure we record the cash register for cash transactions Koha::Exceptions::Account::RegisterRequired->throw() if ( C4::Context->preference("UseCashRegisters") && defined( $params->{payout_type} ) && ( $params->{payout_type} eq 'CASH' ) && !defined( $params->{cash_register} ) ); my $payout; $self->_result->result_source->schema->txn_do( sub { # A 'payout' is a 'debit' $payout = Koha::Account::Line->new( { date => \'NOW()', amount => $amount, debit_type_code => 'PAYOUT', payment_type => $params->{payout_type}, amountoutstanding => $amount, manager_id => $params->{staff_id}, borrowernumber => $self->borrowernumber, interface => $params->{interface}, branchcode => $params->{branch}, register_id => $params->{cash_register} } )->store(); my $payout_offset = Koha::Account::Offset->new( { debit_id => $payout->accountlines_id, type => 'PAYOUT', amount => $amount } )->store(); $self->apply( { debits => [$payout], offset_type => 'PAYOUT' } ); $self->status('PAID')->store; } ); $payout->discard_changes; return $payout; } =head3 adjust This method allows updating a debit or credit on a patron's account $account_line->adjust( { amount => $amount, type => $update_type, interface => $interface } ); $update_type can be any of: - overdue_update Authors Note: The intention here is that this method is only used to adjust accountlines where the final amount is not yet known/fixed. Incrementing fines are the only existing case at the time of writing, all other forms of 'adjustment' should be recorded as distinct credits or debits and applied, via an offset, to the corresponding debit or credit. =cut sub adjust { my ( $self, $params ) = @_; my $amount = $params->{amount}; my $update_type = $params->{type}; my $interface = $params->{interface}; unless ( exists($Koha::Account::Line::allowed_update->{$update_type}) ) { Koha::Exceptions::Account::UnrecognisedType->throw( error => 'Update type not recognised' ); } my $debit_type_code = $self->debit_type_code; my $account_status = $self->status; unless ( ( exists( $Koha::Account::Line::allowed_update->{$update_type} ->{$debit_type_code} ) && ( $Koha::Account::Line::allowed_update->{$update_type} ->{$debit_type_code} eq $account_status ) ) ) { Koha::Exceptions::Account::UnrecognisedType->throw( error => 'Update type not allowed on this debit_type' ); } my $schema = Koha::Database->new->schema; $schema->txn_do( sub { my $amount_before = $self->amount; my $amount_outstanding_before = $self->amountoutstanding; my $difference = $amount - $amount_before; my $new_outstanding = $amount_outstanding_before + $difference; my $offset_type = $debit_type_code; $offset_type .= ( $difference > 0 ) ? "_INCREASE" : "_DECREASE"; # Catch cases that require patron refunds if ( $new_outstanding < 0 ) { my $account = Koha::Patrons->find( $self->borrowernumber )->account; my $credit = $account->add_credit( { amount => $new_outstanding * -1, description => 'Overpayment refund', type => 'CREDIT', interface => $interface, ( $update_type eq 'overdue_update' ? ( item_id => $self->itemnumber ) : ()), } ); $new_outstanding = 0; } # Update the account line $self->set( { date => \'NOW()', amount => $amount, amountoutstanding => $new_outstanding, } )->store(); # Record the account offset my $account_offset = Koha::Account::Offset->new( { debit_id => $self->id, type => $offset_type, amount => $difference } )->store(); if ( C4::Context->preference("FinesLog") ) { logaction( "FINES", 'UPDATE', #undef becomes UPDATE in UpdateFine $self->borrowernumber, Dumper( { action => $update_type, borrowernumber => $self->borrowernumber, amount => $amount, description => undef, amountoutstanding => $new_outstanding, debit_type_code => $self->debit_type_code, note => undef, itemnumber => $self->itemnumber, manager_id => undef, } ) ) if ( $update_type eq 'overdue_update' ); } } ); return $self; } =head3 is_credit my $bool = $line->is_credit; =cut sub is_credit { my ($self) = @_; return ( $self->amount < 0 ); } =head3 is_debit my $bool = $line->is_debit; =cut sub is_debit { my ($self) = @_; return !$self->is_credit; } =head3 to_api_mapping This method returns the mapping for representing a Koha::Account::Line object on the API. =cut sub to_api_mapping { return { accountlines_id => 'account_line_id', credit_type_code => 'credit_type', debit_type_code => 'debit_type', amountoutstanding => 'amount_outstanding', borrowernumber => 'patron_id', branchcode => 'library_id', issue_id => 'checkout_id', itemnumber => 'item_id', manager_id => 'user_id', note => 'internal_note', }; } =head3 renewable my $bool = $line->renewable; =cut sub renewable { my ($self) = @_; return ( $self->amountoutstanding == 0 && $self->debit_type_code && $self->debit_type_code eq 'OVERDUE' && $self->status && $self->status eq 'UNRETURNED' ) ? 1 : 0; } =head3 renew_item my $renew_result = $line->renew_item; Conditionally attempt to renew an item and return the outcome. This is as a consequence of the fine on an item being fully paid off =cut sub renew_item { my ($self, $params) = @_; my $outcome = {}; # We want to reject the call to renew if any of these apply: # - The RenewAccruingItemWhenPaid syspref is off # - The line item doesn't have an item attached to it # - The line item doesn't have a patron attached to it # # - The RenewAccruingItemInOpac syspref is off # AND # - There is an interface param passed and it's value is 'opac' if ( !C4::Context->preference('RenewAccruingItemWhenPaid') || !$self->item || !$self->patron || ( !C4::Context->preference('RenewAccruingItemInOpac') && $params->{interface} && $params->{interface} eq 'opac' ) ) { return; } my $itemnumber = $self->item->itemnumber; my $borrowernumber = $self->patron->borrowernumber; my ( $can_renew, $error ) = C4::Circulation::CanBookBeRenewed( $borrowernumber, $itemnumber ); if ( $can_renew ) { my $due_date = C4::Circulation::AddRenewal( $borrowernumber, $itemnumber, $self->{branchcode}, undef, undef, 1 ); return { itemnumber => $itemnumber, due_date => $due_date, success => 1 }; } else { return { itemnumber => $itemnumber, error => $error, success => 0 }; } } =head2 Internal methods =cut =head3 _type =cut sub _type { return 'Accountline'; } 1; =head2 Name mappings =head3 $allowed_update =cut our $allowed_update = { 'overdue_update' => { 'OVERDUE' => 'UNRETURNED' } }; =head1 AUTHORS Kyle M Hall Tomás Cohen Arazi Martin Renvoize =cut