X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=Koha%2FAccount%2FLine.pm;h=a05ab65c282cd02f5e0e936e9081f071a319709b;hb=dec9f754f8bbebaf6d2a2e9ba1ce1b9935ba45da;hp=80582f3c17e409ff00caa951d5d1015d20bd4106;hpb=e3c5892f52d3d59d9aa03667d990110e3587ca6b;p=koha-ffzg.git diff --git a/Koha/Account/Line.pm b/Koha/Account/Line.pm index 80582f3c17..a05ab65c28 100644 --- a/Koha/Account/Line.pm +++ b/Koha/Account/Line.pm @@ -2,28 +2,31 @@ 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 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. +# 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, write to the Free Software Foundation, Inc., -# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# 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 Data::Dumper qw( Dumper ); -use C4::Log qw(logaction); +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; @@ -41,6 +44,19 @@ Koha::Account::Line - Koha accountline Object class =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 @@ -69,9 +85,134 @@ sub checkout { return $self->{_checkout}; } +=head3 library + +Returns a Koha::Library object representing where the accountline was recorded + +=cut + +sub library { + my ( $self ) = @_; + my $rs = $self->_result->library; + return unless $rs; + return Koha::Library->_new_from_dbic($rs); +} + +=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, $cond, $attr ) = @_; + my $rs = $self->_result->search_related( 'account_offsets_credits', $cond, $attr); + 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, $cond, $attr ) = @_; + my $rs = $self->_result->search_related( 'account_offsets_debits', $cond, $attr); + 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::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_m, $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 $cond_m = { map { "debit.".$_ => $cond->{$_} } keys %{$cond}}; + my $rs = + $self->_result->search_related('account_offsets_credits') + ->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 @@ -80,17 +221,81 @@ as 'void' by updating it's status to "VOID". =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 ); @@ -107,7 +312,7 @@ sub void { credit_id => $self->id, debit_id => $fee_paid->id, amount => $amount_paid, - type => 'Void Payment', + type => 'VOID', } )->store(); } @@ -123,7 +328,7 @@ sub void { amount => $self->amount, amountoutstanding => $self->amountoutstanding, description => $self->description, - accounttype => $self->accounttype, + credit_type_code => $self->credit_type_code, payment_type => $self->payment_type, note => $self->note, itemnumber => $self->itemnumber, @@ -134,26 +339,242 @@ sub void { ) ); } + } + ); - $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( { - status => 'VOID', - amountoutstanding => 0, - amount => 0, + 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}, } - ); - $self->store(); + )->store(); + + my $cancellation_offset = Koha::Account::Offset->new( + { + credit_id => $cancellation->accountlines_id, + type => 'CREATE', + amount => 0 - $self->amount + } + )->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 + + $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 => 'CREATE', + amount => 0 - $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] } ); + $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 => 'APPLY', + 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 ] } ); + my $credit = $credit->apply( { debits => $debits } ); -Applies the credit to a given debits set. +Applies the credit to a given debits array reference. =head4 arguments hashref @@ -161,9 +582,6 @@ Applies the credit to a given debits set. =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 @@ -172,7 +590,6 @@ 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( @@ -191,7 +608,7 @@ sub apply { my $schema = Koha::Database->new->schema; $schema->txn_do( sub { - while ( my $debit = $debits->next ) { + for my $debit ( @{$debits} ) { unless ( $debit->is_debit ) { Koha::Exceptions::Account::IsNotDebit->throw( @@ -213,7 +630,7 @@ sub apply { { credit_id => $self->id, debit_id => $debit->id, amount => $amount_to_cancel * -1, - type => $offset_type, + type => 'APPLY' } )->store(); @@ -222,19 +639,137 @@ sub apply { $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 ( $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 ( $debit->amountoutstanding == 0 + if ( + C4::Context->preference('MarkLostItemsAsReturned') =~ + m|onpayment| + && $debit->debit_type_code + && $debit->debit_type_code eq 'LOST' + && $debit->amountoutstanding == 0 && $debit->itemnumber - && $debit->accounttype - && $debit->accounttype eq 'LOST' ) + && !( + $self->credit_type_code eq 'LOST_FOUND' + && $self->itemnumber == $debit->itemnumber + ) + ) { - C4::Circulation::ReturnLostItem( $self->borrowernumber, $debit->itemnumber ); + C4::Circulation::ReturnLostItem( $self->borrowernumber, + $debit->itemnumber ); } + last if $available_credit == 0; } }); - return $available_credit; + return $self; +} + +=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 => 'CREATE', + amount => $amount + } + )->store(); + + $self->apply( { debits => [$payout] } ); + $self->status('PAID')->store; + } + ); + + $payout->discard_changes; + return $payout; } =head3 adjust @@ -273,21 +808,21 @@ sub adjust { ); } - my $account_type = $self->accounttype; - my $account_status = $self->status; + my $debit_type_code = $self->debit_type_code; + my $account_status = $self->status; unless ( ( exists( $Koha::Account::Line::allowed_update->{$update_type} - ->{$account_type} + ->{$debit_type_code} ) && ( $Koha::Account::Line::allowed_update->{$update_type} - ->{$account_type} eq $account_status ) + ->{$debit_type_code} eq $account_status ) ) ) { Koha::Exceptions::Account::UnrecognisedType->throw( - error => 'Update type not allowed on this accounttype' ); + error => 'Update type not allowed on this debit_type' ); } my $schema = Koha::Database->new->schema; @@ -300,7 +835,7 @@ sub adjust { my $difference = $amount - $amount_before; my $new_outstanding = $amount_outstanding_before + $difference; - my $offset_type = $account_type; + my $offset_type = $debit_type_code; $offset_type .= ( $difference > 0 ) ? "_INCREASE" : "_DECREASE"; # Catch cases that require patron refunds @@ -310,8 +845,7 @@ sub adjust { 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 ) : ()), } @@ -347,7 +881,7 @@ sub adjust { amount => $amount, description => undef, amountoutstanding => $new_outstanding, - accounttype => $self->accounttype, + debit_type_code => $self->debit_type_code, note => undef, itemnumber => $self->itemnumber, manager_id => undef, @@ -370,7 +904,7 @@ sub adjust { sub is_credit { my ($self) = @_; - return ( $self->amount < 0 ); + return defined $self->credit_type_code; } =head3 is_debit @@ -385,6 +919,177 @@ sub is_debit { 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_number => undef, + 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', + register_id => 'cash_register_id', + }; + +} + +=head3 is_renewable + + my $bool = $line->is_renewable; + +=cut + +sub is_renewable { + my ($self) = @_; + + return ( + $self->amountoutstanding == 0 && + $self->debit_type_code && + $self->debit_type_code eq 'OVERDUE' && + $self->status && + $self->status eq 'UNRETURNED' && + $self->item && + $self->patron + ) ? 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. +Caller must call is_renewable before. + +=cut + +sub renew_item { + my ($self, $params) = @_; + + my $outcome = {}; + + # We want to reject the call to renew if: + # - The RenewAccruingItemWhenPaid syspref is off + # OR + # - The RenewAccruingItemInOpac syspref is off + # - There is an interface param passed and it's value is 'opac' + + if ( + !C4::Context->preference('RenewAccruingItemWhenPaid') || + ( + !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 + }; + } + +} + +=head3 store + +Specific store method to generate credit number before saving + +=cut + +sub store { + my ($self) = @_; + + my $AutoCreditNumber = C4::Context->preference('AutoCreditNumber'); + 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') { + my $max = $rs->search({ + credit_number => { -regexp => '^[0-9]+$' } + }, { + select => \'CAST(credit_number AS UNSIGNED)', + as => ['credit_number'], + })->get_column('credit_number')->max; + $max //= 0; + $self->credit_number($max + 1); + } elsif ($AutoCreditNumber eq 'annual') { + my $now = dt_from_string; + my $prefix = sprintf('%d-', $now->year); + my $max = $rs->search({ + -and => [ + credit_number => { -regexp => '[0-9]{4}$' }, + credit_number => { -like => "$prefix%" }, + ], + })->get_column('credit_number')->max; + $max //= $prefix . '0000'; + my $incr = substr($max, length $prefix); + $self->credit_number(sprintf('%s%04d', $prefix, $incr + 1)); + } elsif ($AutoCreditNumber eq 'branchyyyymmincr') { + my $userenv = C4::Context->userenv; + if ($userenv) { + my $branch = $userenv->{branch}; + my $now = dt_from_string; + my $prefix = sprintf('%s%d%02d', $branch, $now->year, $now->month); + my $pattern = $prefix; + $pattern =~ s/([\?%_])/\\$1/g; + my $max = $rs->search({ + -and => [ + credit_number => { -regexp => '[0-9]{4}$' }, + credit_number => { -like => "$pattern%" }, + ], + })->get_column('credit_number')->max; + $max //= $prefix . '0000'; + my $incr = substr($max, length $prefix); + $self->credit_number(sprintf('%s%04d', $prefix, $incr + 1)); + } + } + } + + return $self->SUPER::store(); +} + =head2 Internal methods =cut