use Modern::Perl;
-use Carp;
-use Data::Dumper;
+use Data::Dumper qw( Dumper );
-use C4::Log qw(logaction);
-use C4::Overdues qw(GetFine);
+use C4::Log qw( logaction );
+use C4::Overdues qw( UpdateFine );
use Koha::Account::CreditType;
use Koha::Account::DebitType;
use Koha::Account::Offsets;
use Koha::Database;
+use Koha::DateUtils qw( dt_from_string );
use Koha::Exceptions::Account;
use Koha::Items;
=cut
sub credit_offsets {
- my ( $self ) = @_;
- my $rs = $self->_result->account_offsets_credits;
+ my ( $self, $cond, $attr ) = @_;
+ my $rs = $self->_result->search_related( 'account_offsets_credits', $cond, $attr);
return unless $rs;
return Koha::Account::Offsets->_new_from_dbic($rs);
}
=cut
sub debit_offsets {
- my ( $self ) = @_;
- my $rs = $self->_result->account_offsets_debits;
+ my ( $self, $cond, $attr ) = @_;
+ my $rs = $self->_result->search_related( 'account_offsets_debits', $cond, $attr);
return unless $rs;
return Koha::Account::Offsets->_new_from_dbic($rs);
}
my ( $self, $cond, $attr ) = @_;
unless ( $self->is_debit ) {
- Koha::Exceptions::Account::IsNotCredit->throw(
+ Koha::Exceptions::Account::IsNotDebit->throw(
error => 'Account line ' . $self->id . ' is not a debit'
);
}
+ my $cond_m = { map { "credit.".$_ => $cond->{$_} } keys %{$cond}};
my $rs =
$self->_result->search_related('account_offsets_debits')
- ->search_related( 'credit', $cond, $attr );
+ ->search_related( 'credit', $cond_m, $attr );
return unless $rs;
return Koha::Account::Lines->_new_from_dbic($rs);
}
);
}
+ my $cond_m = { map { "debit.".$_ => $cond->{$_} } keys %{$cond}};
my $rs =
$self->_result->search_related('account_offsets_credits')
- ->search_related( 'debit', $cond, $attr );
+ ->search_related( 'debit', $cond_m, $attr );
return unless $rs;
return Koha::Account::Lines->_new_from_dbic($rs);
}
=head3 void
- $payment_accountline->void();
+ $payment_accountline->void({
+ interface => $interface,
+ [ staff_id => $staff_id, branch => $branchcode ]
+ });
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
=cut
sub void {
- my ($self) = @_;
+ my ($self, $params) = @_;
- # Make sure it is a payment we are voiding
- return unless $self->amount < 0;
+ # Make sure it is a credit we are voiding
+ unless ( $self->is_credit ) {
+ Koha::Exceptions::Account::IsNotCredit->throw(
+ error => 'Account line ' . $self->id . 'is not a credit' );
+ }
+ # Make sure it is not already voided
+ if ( $self->status && $self->status eq 'VOID' ) {
+ Koha::Exceptions::Account->throw(
+ error => 'Account line ' . $self->id . 'is already void' );
+ }
+
+ # Check for mandatory parameters
+ my @mandatory = ( 'interface' );
+ 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'"
+ );
+ }
+ }
+ }
+
+ # Find any applied offsets for the credit so we may reverse them
my @account_offsets =
Koha::Account::Offsets->search(
{ credit_id => $self->id, amount => { '<' => 0 } } );
+ my $void;
$self->_result->result_source->schema->txn_do(
sub {
+
+ # A 'void' is a 'debit'
+ $void = Koha::Account::Line->new(
+ {
+ borrowernumber => $self->borrowernumber,
+ date => \'NOW()',
+ debit_type_code => 'VOID',
+ amount => $self->amount * -1,
+ amountoutstanding => $self->amount * -1,
+ manager_id => $params->{staff_id},
+ interface => $params->{interface},
+ branchcode => $params->{branch},
+ }
+ )->store();
+
+ # Record the creation offset
+ Koha::Account::Offset->new(
+ {
+ debit_id => $void->id,
+ type => 'CREATE',
+ amount => $self->amount * -1
+ }
+ )->store();
+
+ # Link void to payment
+ $self->set({
+ amountoutstanding => $self->amount,
+ status => 'VOID'
+ })->store();
+ $self->apply( { debits => [$void] } );
+
+ # Reverse any applied payments
foreach my $account_offset (@account_offsets) {
my $fee_paid =
Koha::Account::Lines->find( $account_offset->debit_id );
credit_id => $self->id,
debit_id => $fee_paid->id,
amount => $amount_paid,
- type => 'Void Payment',
+ type => 'VOID',
}
)->store();
}
)
);
}
+ }
+ );
- $self->set(
+ $void->discard_changes;
+ return $void;
+}
+
+=head3 cancel
+
+ $debit_accountline->cancel();
+
+Cancel a charge. It will mark the debit as 'cancelled' by updating its
+status to 'CANCELLED'.
+
+Charges that have been fully or partially paid cannot be cancelled.
+
+Returns the cancellation accountline.
+
+=cut
+
+sub cancel {
+ 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' );
+ }
+
+ # Make sure it is not already cancelled
+ if ( $self->status && $self->status eq 'CANCELLED' ) {
+ Koha::Exceptions::Account->throw(
+ error => 'Account line ' . $self->id . 'is already cancelled' );
+ }
+
+ # Make sure it has not be paid yet
+ if ( $self->amount != $self->amountoutstanding ) {
+ Koha::Exceptions::Account->throw(
+ error => 'Account line ' . $self->id . 'is already offset' );
+ }
+
+ # Check for mandatory parameters
+ my @mandatory = ( 'staff_id', 'branch' );
+ for my $param (@mandatory) {
+ unless ( defined( $params->{$param} ) ) {
+ Koha::Exceptions::MissingParameter->throw(
+ error => "The $param parameter is mandatory" );
+ }
+ }
+
+ my $cancellation;
+ $self->_result->result_source->schema->txn_do(
+ sub {
+
+ # A 'cancellation' is a 'credit'
+ $cancellation = Koha::Account::Line->new(
+ {
+ date => \'NOW()',
+ amount => 0 - $self->amount,
+ credit_type_code => 'CANCELLATION',
+ status => 'ADDED',
+ amountoutstanding => 0 - $self->amount,
+ manager_id => $params->{staff_id},
+ borrowernumber => $self->borrowernumber,
+ interface => 'intranet',
+ branchcode => $params->{branch},
+ }
+ )->store();
+
+ my $cancellation_offset = Koha::Account::Offset->new(
{
- status => 'VOID',
- amountoutstanding => 0,
- amount => 0,
+ credit_id => $cancellation->accountlines_id,
+ type => 'CREATE',
+ amount => 0 - $self->amount
}
- );
- $self->store();
+ )->store();
+
+ # Link cancellation to charge
+ $cancellation->apply( { debits => [$self] } );
+ $cancellation->status('APPLIED')->store();
+
+ # Update status of original debit
+ $self->status('CANCELLED')->store;
}
);
+ $cancellation->discard_changes;
+ return $cancellation;
}
=head3 reduce
my $reduction_offset = Koha::Account::Offset->new(
{
credit_id => $reduction->accountlines_id,
- type => uc( $params->{reduction_type} ),
- amount => $params->{amount}
+ type => 'CREATE',
+ amount => 0 - $params->{amount}
}
)->store();
my $debit_outstanding = $self->amountoutstanding;
if ( $debit_outstanding >= $params->{amount} ) {
- $reduction->apply(
- {
- debits => [$self],
- offset_type => uc( $params->{reduction_type} )
- }
- );
+ $reduction->apply( { debits => [$self] } );
$reduction->status('APPLIED')->store();
}
else {
- # Zero amount offset used to link original 'debit' to reduction 'credit'
+ # 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} ),
+ type => 'APPLY',
amount => 0
}
)->store();
=head3 apply
my $debits = $account->outstanding_debits;
- my $outstanding_amount = $credit->apply( { debits => $debits, [ offset_type => $offset_type ] } );
+ my $credit = $credit->apply( { debits => $debits } );
Applies the credit to a given debits array reference.
=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
my ( $self, $params ) = @_;
my $debits = $params->{debits};
- my $offset_type = $params->{offset_type} // 'Credit Applied';
unless ( $self->is_credit ) {
Koha::Exceptions::Account::IsNotCredit->throw(
{ credit_id => $self->id,
debit_id => $debit->id,
amount => $amount_to_cancel * -1,
- type => $offset_type,
+ type => 'APPLY'
}
)->store();
# Attempt to renew the item associated with this debit if
# appropriate
- if ($debit->renewable) {
- $debit->renew_item($params->{interface});
+ if ( $self->credit_type_code ne 'FORGIVEN' && $debit->is_renewable ) {
+ my $outcome = $debit->renew_item( { interface => $params->{interface} } );
+ $self->add_message(
+ {
+ type => 'info',
+ message => 'renewal',
+ payload => $outcome
+ }
+ ) if $outcome;
}
+ $debit->discard_changes; # Refresh values from DB to clear floating point remainders
# Same logic exists in Koha::Account::pay
if (
C4::Circulation::ReturnLostItem( $self->borrowernumber,
$debit->itemnumber );
}
+
+ last if $available_credit == 0;
}
});
- return $available_credit;
+ return $self;
}
=head3 payout
my $payout_offset = Koha::Account::Offset->new(
{
debit_id => $payout->accountlines_id,
- type => 'PAYOUT',
+ type => 'CREATE',
amount => $amount
}
)->store();
- $self->apply( { debits => [$payout], offset_type => 'PAYOUT' } );
+ $self->apply( { debits => [$payout] } );
$self->status('PAID')->store;
}
);
my $credit = $account->add_credit(
{
amount => $new_outstanding * -1,
- description => 'Overpayment refund',
- type => 'CREDIT',
+ type => 'OVERPAYMENT',
interface => $interface,
( $update_type eq 'overdue_update' ? ( item_id => $self->itemnumber ) : ()),
}
sub is_credit {
my ($self) = @_;
- return ( $self->amount < 0 );
+ return defined $self->credit_type_code;
}
=head3 is_debit
sub to_api_mapping {
return {
accountlines_id => 'account_line_id',
+ credit_number => undef,
credit_type_code => 'credit_type',
debit_type_code => 'debit_type',
amountoutstanding => 'amount_outstanding',
itemnumber => 'item_id',
manager_id => 'user_id',
note => 'internal_note',
+ register_id => 'cash_register_id',
};
}
-=head3 renewable
+=head3 is_renewable
- my $bool = $line->renewable;
+ my $bool = $line->is_renewable;
=cut
-sub renewable {
+sub is_renewable {
my ($self) = @_;
return (
$self->debit_type_code &&
$self->debit_type_code eq 'OVERDUE' &&
$self->status &&
- $self->status eq 'UNRETURNED'
+ $self->status eq 'UNRETURNED' &&
+ $self->item &&
+ $self->patron
) ? 1 : 0;
}
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
+as a consequence of the fine on an item being fully paid off.
+Caller must call is_renewable before.
=cut
my $outcome = {};
- # We want to reject the call to renew if any of these apply:
+ # We want to reject the call to renew if:
# - 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
- #
+ # OR
# - 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} &&
my ($self) = @_;
my $AutoCreditNumber = C4::Context->preference('AutoCreditNumber');
- if ($AutoCreditNumber && !$self->in_storage && $self->is_credit && !$self->credit_number) {
+ my $credit_number_enabled = $self->is_credit && $self->credit_type->credit_number_enabled;
+
+ if ($AutoCreditNumber && $credit_number_enabled && !$self->in_storage) {
+ if (defined $self->credit_number) {
+ Koha::Exceptions::Account->throw('AutoCreditNumber is enabled but credit_number is already defined');
+ }
+
my $rs = Koha::Database->new->schema->resultset($self->_type);
if ($AutoCreditNumber eq 'incremental') {
$max //= 0;
$self->credit_number($max + 1);
} elsif ($AutoCreditNumber eq 'annual') {
- my $now = DateTime->now;
+ my $now = dt_from_string;
my $prefix = sprintf('%d-', $now->year);
my $max = $rs->search({
-and => [
my $userenv = C4::Context->userenv;
if ($userenv) {
my $branch = $userenv->{branch};
- my $now = DateTime->now;
+ my $now = dt_from_string;
my $prefix = sprintf('%s%d%02d', $branch, $now->year, $now->month);
my $pattern = $prefix;
$pattern =~ s/([\?%_])/\\$1/g;
projects / koha-ffzg.git / blobdiff