Bug 24603: Allow to cancel charges in patron accounting
[koha.git] / Koha / Account / Line.pm
blob9f6723f6e5dad18f2e9f475558b299e37595d53a
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>.
18 use Modern::Perl;
20 use Carp;
21 use Data::Dumper;
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;
29 use Koha::Database;
30 use Koha::DateUtils;
31 use Koha::Exceptions::Account;
32 use Koha::Items;
34 use base qw(Koha::Object);
36 =encoding utf8
38 =head1 NAME
40 Koha::Account::Line - Koha accountline Object class
42 =head1 API
44 =head2 Class methods
46 =cut
48 =head3 patron
50 Return the patron linked to this account line
52 =cut
54 sub patron {
55 my ( $self ) = @_;
56 my $rs = $self->_result->borrowernumber;
57 return unless $rs;
58 return Koha::Patron->_new_from_dbic( $rs );
61 =head3 item
63 Return the item linked to this account line if exists
65 =cut
67 sub item {
68 my ( $self ) = @_;
69 my $rs = $self->_result->itemnumber;
70 return unless $rs;
71 return Koha::Item->_new_from_dbic( $rs );
74 =head3 checkout
76 Return the checkout linked to this account line if exists
78 =cut
80 sub checkout {
81 my ( $self ) = @_;
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};
89 =head3 library
91 Returns a Koha::Library object representing where the accountline was recorded
93 =cut
95 sub library {
96 my ( $self ) = @_;
97 my $rs = $self->_result->library;
98 return unless $rs;
99 return Koha::Library->_new_from_dbic($rs);
102 =head3 credit_type
104 Return the credit_type linked to this account line
106 =cut
108 sub credit_type {
109 my ( $self ) = @_;
110 my $rs = $self->_result->credit_type_code;
111 return unless $rs;
112 return Koha::Account::CreditType->_new_from_dbic( $rs );
115 =head3 debit_type
117 Return the debit_type linked to this account line
119 =cut
121 sub debit_type {
122 my ( $self ) = @_;
123 my $rs = $self->_result->debit_type_code;
124 return unless $rs;
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
132 =cut
134 sub credit_offsets {
135 my ( $self ) = @_;
136 my $rs = $self->_result->account_offsets_credits;
137 return unless $rs;
138 return Koha::Account::Offsets->_new_from_dbic($rs);
141 =head3 debit_offsets
143 Return the debit_offsets linked to this account line if some exist
145 =cut
147 sub debit_offsets {
148 my ( $self ) = @_;
149 my $rs = $self->_result->account_offsets_debits;
150 return unless $rs;
151 return Koha::Account::Offsets->_new_from_dbic($rs);
155 =head3 credits
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.
164 =cut
166 sub credits {
167 my ( $self, $cond, $attr ) = @_;
169 unless ( $self->is_debit ) {
170 Koha::Exceptions::Account::IsNotDebit->throw(
171 error => 'Account line ' . $self->id . ' is not a debit'
175 my $cond_m = { map { "credit.".$_ => $cond->{$_} } keys %{$cond}};
176 my $rs =
177 $self->_result->search_related('account_offsets_debits')
178 ->search_related( 'credit', $cond_m, $attr );
179 return unless $rs;
180 return Koha::Account::Lines->_new_from_dbic($rs);
183 =head3 debits
185 my $debits = $accountline->debits;
186 my $debits = $accountline->debits( $cond, $attr );
188 Return the debits linked to this account line if some exist.
189 Search conditions and attributes may be passed if you wish to filter
190 the resultant resultant resultset.
192 =cut
194 sub debits {
195 my ( $self, $cond, $attr ) = @_;
197 unless ( $self->is_credit ) {
198 Koha::Exceptions::Account::IsNotCredit->throw(
199 error => 'Account line ' . $self->id . ' is not a credit'
203 my $cond_m = { map { "debit.".$_ => $cond->{$_} } keys %{$cond}};
204 my $rs =
205 $self->_result->search_related('account_offsets_credits')
206 ->search_related( 'debit', $cond_m, $attr );
207 return unless $rs;
208 return Koha::Account::Lines->_new_from_dbic($rs);
211 =head3 void
213 $payment_accountline->void();
215 Used to 'void' (or reverse) a payment/credit. It will roll back any offsets
216 created by the application of this credit upon any debits and mark the credit
217 as 'void' by updating it's status to "VOID".
219 =cut
221 sub void {
222 my ($self) = @_;
224 # Make sure it is a payment we are voiding
225 return unless $self->amount < 0;
227 my @account_offsets =
228 Koha::Account::Offsets->search(
229 { credit_id => $self->id, amount => { '<' => 0 } } );
231 $self->_result->result_source->schema->txn_do(
232 sub {
233 foreach my $account_offset (@account_offsets) {
234 my $fee_paid =
235 Koha::Account::Lines->find( $account_offset->debit_id );
237 next unless $fee_paid;
239 my $amount_paid = $account_offset->amount * -1; # amount paid is stored as a negative amount
240 my $new_amount = $fee_paid->amountoutstanding + $amount_paid;
241 $fee_paid->amountoutstanding($new_amount);
242 $fee_paid->store();
244 Koha::Account::Offset->new(
246 credit_id => $self->id,
247 debit_id => $fee_paid->id,
248 amount => $amount_paid,
249 type => 'Void Payment',
251 )->store();
254 if ( C4::Context->preference("FinesLog") ) {
255 logaction(
256 "FINES", 'VOID',
257 $self->borrowernumber,
258 Dumper(
260 action => 'void_payment',
261 borrowernumber => $self->borrowernumber,
262 amount => $self->amount,
263 amountoutstanding => $self->amountoutstanding,
264 description => $self->description,
265 credit_type_code => $self->credit_type_code,
266 payment_type => $self->payment_type,
267 note => $self->note,
268 itemnumber => $self->itemnumber,
269 manager_id => $self->manager_id,
270 offsets =>
271 [ map { $_->unblessed } @account_offsets ],
277 $self->set(
279 status => 'VOID',
280 amountoutstanding => 0,
281 amount => 0,
284 $self->store();
290 =head3 cancel
292 $debit_accountline->cancel();
294 Cancel a charge. It will mark the debit as 'cancelled' by updating its
295 status to 'CANCELLED'.
296 Charges that have been fully or partially paid cannot be cancelled.
298 Return self in case of success, undef otherwise
300 =cut
302 sub cancel {
303 my ($self) = @_;
305 # Make sure it is a charge we are cancelling
306 return unless $self->is_debit;
308 # Make sure it is not already cancelled
309 return if $self->status && $self->status eq 'CANCELLED';
311 # Make sure it has not be paid yet
312 return if $self->amount != $self->amountoutstanding;
314 if ( C4::Context->preference("FinesLog") ) {
315 logaction('FINES', 'CANCEL', $self->borrowernumber, Dumper({
316 action => 'cancel_charge',
317 borrowernumber => $self->borrowernumber,
318 amount => $self->amount,
319 amountoutstanding => $self->amountoutstanding,
320 description => $self->description,
321 debit_type_code => $self->debit_type_code,
322 note => $self->note,
323 itemnumber => $self->itemnumber,
324 manager_id => $self->manager_id,
325 }));
328 $self->set({
329 status => 'CANCELLED',
330 amountoutstanding => 0,
331 amount => 0,
333 $self->store();
335 return $self;
338 =head3 reduce
340 $charge_accountline->reduce({
341 reduction_type => $reduction_type
344 Used to 'reduce' a charge/debit by adding a credit to offset against the amount
345 outstanding.
347 May be used to apply a discount whilst retaining the original debit amounts or
348 to apply a full or partial refund for example when a lost item is found and
349 returned.
351 It will immediately be applied to the given debit unless the debit has already
352 been paid, in which case a 'zero' offset will be added to maintain a link to
353 the debit but the outstanding credit will be left so it may be applied to other
354 debts.
356 Reduction type may be one of:
358 * REFUND
359 * DISCOUNT
361 Returns the reduction accountline (which will be a credit)
363 =cut
365 sub reduce {
366 my ( $self, $params ) = @_;
368 # Make sure it is a charge we are reducing
369 unless ( $self->is_debit ) {
370 Koha::Exceptions::Account::IsNotDebit->throw(
371 error => 'Account line ' . $self->id . 'is not a debit' );
373 if ( $self->debit_type_code eq 'PAYOUT' ) {
374 Koha::Exceptions::Account::IsNotDebit->throw(
375 error => 'Account line ' . $self->id . 'is a payout' );
378 # Check for mandatory parameters
379 my @mandatory = ( 'interface', 'reduction_type', 'amount' );
380 for my $param (@mandatory) {
381 unless ( defined( $params->{$param} ) ) {
382 Koha::Exceptions::MissingParameter->throw(
383 error => "The $param parameter is mandatory" );
387 # More mandatory parameters
388 if ( $params->{interface} eq 'intranet' ) {
389 my @optional = ( 'staff_id', 'branch' );
390 for my $param (@optional) {
391 unless ( defined( $params->{$param} ) ) {
392 Koha::Exceptions::MissingParameter->throw( error =>
393 "The $param parameter is mandatory when interface is set to 'intranet'"
399 # Make sure the reduction isn't more than the original
400 my $original = $self->amount;
401 Koha::Exceptions::Account::AmountNotPositive->throw(
402 error => 'Reduce amount passed is not positive' )
403 unless ( $params->{amount} > 0 );
404 Koha::Exceptions::ParameterTooHigh->throw( error =>
405 "Amount to reduce ($params->{amount}) is higher than original amount ($original)"
406 ) unless ( $original >= $params->{amount} );
407 my $reduced =
408 $self->credits( { credit_type_code => [ 'DISCOUNT', 'REFUND' ] } )->total;
409 Koha::Exceptions::ParameterTooHigh->throw( error =>
410 "Combined reduction ($params->{amount} + $reduced) is higher than original amount ("
411 . abs($original)
412 . ")" )
413 unless ( $original >= ( $params->{amount} + abs($reduced) ) );
415 my $status = { 'REFUND' => 'REFUNDED', 'DISCOUNT' => 'DISCOUNTED' };
417 my $reduction;
418 $self->_result->result_source->schema->txn_do(
419 sub {
421 # A 'reduction' is a 'credit'
422 $reduction = Koha::Account::Line->new(
424 date => \'NOW()',
425 amount => 0 - $params->{amount},
426 credit_type_code => $params->{reduction_type},
427 status => 'ADDED',
428 amountoutstanding => 0 - $params->{amount},
429 manager_id => $params->{staff_id},
430 borrowernumber => $self->borrowernumber,
431 interface => $params->{interface},
432 branchcode => $params->{branch},
434 )->store();
436 my $reduction_offset = Koha::Account::Offset->new(
438 credit_id => $reduction->accountlines_id,
439 type => uc( $params->{reduction_type} ),
440 amount => $params->{amount}
442 )->store();
444 # Link reduction to charge (and apply as required)
445 my $debit_outstanding = $self->amountoutstanding;
446 if ( $debit_outstanding >= $params->{amount} ) {
448 $reduction->apply(
450 debits => [$self],
451 offset_type => uc( $params->{reduction_type} )
454 $reduction->status('APPLIED')->store();
456 else {
458 # Zero amount offset used to link original 'debit' to reduction 'credit'
459 my $link_reduction_offset = Koha::Account::Offset->new(
461 credit_id => $reduction->accountlines_id,
462 debit_id => $self->accountlines_id,
463 type => uc( $params->{reduction_type} ),
464 amount => 0
466 )->store();
469 # Update status of original debit
470 $self->status( $status->{ $params->{reduction_type} } )->store;
474 $reduction->discard_changes;
475 return $reduction;
478 =head3 apply
480 my $debits = $account->outstanding_debits;
481 my $outstanding_amount = $credit->apply( { debits => $debits, [ offset_type => $offset_type ] } );
483 Applies the credit to a given debits array reference.
485 =head4 arguments hashref
487 =over 4
489 =item debits - Koha::Account::Lines object set of debits
491 =item offset_type (optional) - a string indicating the offset type (valid values are those from
492 the 'account_offset_types' table)
494 =back
496 =cut
498 sub apply {
499 my ( $self, $params ) = @_;
501 my $debits = $params->{debits};
502 my $offset_type = $params->{offset_type} // 'Credit Applied';
504 unless ( $self->is_credit ) {
505 Koha::Exceptions::Account::IsNotCredit->throw(
506 error => 'Account line ' . $self->id . ' is not a credit'
510 my $available_credit = $self->amountoutstanding * -1;
512 unless ( $available_credit > 0 ) {
513 Koha::Exceptions::Account::NoAvailableCredit->throw(
514 error => 'Outstanding credit is ' . $available_credit . ' and cannot be applied'
518 my $schema = Koha::Database->new->schema;
520 $schema->txn_do( sub {
521 for my $debit ( @{$debits} ) {
523 unless ( $debit->is_debit ) {
524 Koha::Exceptions::Account::IsNotDebit->throw(
525 error => 'Account line ' . $debit->id . 'is not a debit'
528 my $amount_to_cancel;
529 my $owed = $debit->amountoutstanding;
531 if ( $available_credit >= $owed ) {
532 $amount_to_cancel = $owed;
534 else { # $available_credit < $debit->amountoutstanding
535 $amount_to_cancel = $available_credit;
538 # record the account offset
539 Koha::Account::Offset->new(
540 { credit_id => $self->id,
541 debit_id => $debit->id,
542 amount => $amount_to_cancel * -1,
543 type => $offset_type,
545 )->store();
547 $available_credit -= $amount_to_cancel;
549 $self->amountoutstanding( $available_credit * -1 )->store;
550 $debit->amountoutstanding( $owed - $amount_to_cancel )->store;
552 # Attempt to renew the item associated with this debit if
553 # appropriate
554 if ($debit->renewable) {
555 $debit->renew_item($params->{interface});
558 # Same logic exists in Koha::Account::pay
559 if (
560 C4::Context->preference('MarkLostItemsAsReturned') =~
561 m|onpayment|
562 && $debit->debit_type_code
563 && $debit->debit_type_code eq 'LOST'
564 && $debit->amountoutstanding == 0
565 && $debit->itemnumber
566 && !(
567 $self->credit_type_code eq 'LOST_FOUND'
568 && $self->itemnumber == $debit->itemnumber
572 C4::Circulation::ReturnLostItem( $self->borrowernumber,
573 $debit->itemnumber );
578 return $available_credit;
581 =head3 payout
583 $credit_accountline->payout(
585 payout_type => $payout_type,
586 register_id => $register_id,
587 staff_id => $staff_id,
588 interface => 'intranet',
589 amount => $amount
593 Used to 'pay out' a credit to a user.
595 Payout type may be one of any existing payment types
597 Returns the payout debit line that is created via this transaction.
599 =cut
601 sub payout {
602 my ( $self, $params ) = @_;
604 # Make sure it is a credit we are paying out
605 unless ( $self->is_credit ) {
606 Koha::Exceptions::Account::IsNotCredit->throw(
607 error => 'Account line ' . $self->id . ' is not a credit' );
610 # Check for mandatory parameters
611 my @mandatory =
612 ( 'interface', 'staff_id', 'branch', 'payout_type', 'amount' );
613 for my $param (@mandatory) {
614 unless ( defined( $params->{$param} ) ) {
615 Koha::Exceptions::MissingParameter->throw(
616 error => "The $param parameter is mandatory" );
620 # Make sure there is outstanding credit to pay out
621 my $outstanding = -1 * $self->amountoutstanding;
622 my $amount =
623 $params->{amount} ? $params->{amount} : $outstanding;
624 Koha::Exceptions::Account::AmountNotPositive->throw(
625 error => 'Payout amount passed is not positive' )
626 unless ( $amount > 0 );
627 Koha::Exceptions::ParameterTooHigh->throw(
628 error => "Amount to payout ($amount) is higher than amountoutstanding ($outstanding)" )
629 unless ($outstanding >= $amount );
631 # Make sure we record the cash register for cash transactions
632 Koha::Exceptions::Account::RegisterRequired->throw()
633 if ( C4::Context->preference("UseCashRegisters")
634 && defined( $params->{payout_type} )
635 && ( $params->{payout_type} eq 'CASH' )
636 && !defined( $params->{cash_register} ) );
638 my $payout;
639 $self->_result->result_source->schema->txn_do(
640 sub {
642 # A 'payout' is a 'debit'
643 $payout = Koha::Account::Line->new(
645 date => \'NOW()',
646 amount => $amount,
647 debit_type_code => 'PAYOUT',
648 payment_type => $params->{payout_type},
649 amountoutstanding => $amount,
650 manager_id => $params->{staff_id},
651 borrowernumber => $self->borrowernumber,
652 interface => $params->{interface},
653 branchcode => $params->{branch},
654 register_id => $params->{cash_register}
656 )->store();
658 my $payout_offset = Koha::Account::Offset->new(
660 debit_id => $payout->accountlines_id,
661 type => 'PAYOUT',
662 amount => $amount
664 )->store();
666 $self->apply( { debits => [$payout], offset_type => 'PAYOUT' } );
667 $self->status('PAID')->store;
671 $payout->discard_changes;
672 return $payout;
675 =head3 adjust
677 This method allows updating a debit or credit on a patron's account
679 $account_line->adjust(
681 amount => $amount,
682 type => $update_type,
683 interface => $interface
687 $update_type can be any of:
688 - overdue_update
690 Authors Note: The intention here is that this method is only used
691 to adjust accountlines where the final amount is not yet known/fixed.
692 Incrementing fines are the only existing case at the time of writing,
693 all other forms of 'adjustment' should be recorded as distinct credits
694 or debits and applied, via an offset, to the corresponding debit or credit.
696 =cut
698 sub adjust {
699 my ( $self, $params ) = @_;
701 my $amount = $params->{amount};
702 my $update_type = $params->{type};
703 my $interface = $params->{interface};
705 unless ( exists($Koha::Account::Line::allowed_update->{$update_type}) ) {
706 Koha::Exceptions::Account::UnrecognisedType->throw(
707 error => 'Update type not recognised'
711 my $debit_type_code = $self->debit_type_code;
712 my $account_status = $self->status;
713 unless (
715 exists(
716 $Koha::Account::Line::allowed_update->{$update_type}
717 ->{$debit_type_code}
719 && ( $Koha::Account::Line::allowed_update->{$update_type}
720 ->{$debit_type_code} eq $account_status )
724 Koha::Exceptions::Account::UnrecognisedType->throw(
725 error => 'Update type not allowed on this debit_type' );
728 my $schema = Koha::Database->new->schema;
730 $schema->txn_do(
731 sub {
733 my $amount_before = $self->amount;
734 my $amount_outstanding_before = $self->amountoutstanding;
735 my $difference = $amount - $amount_before;
736 my $new_outstanding = $amount_outstanding_before + $difference;
738 my $offset_type = $debit_type_code;
739 $offset_type .= ( $difference > 0 ) ? "_INCREASE" : "_DECREASE";
741 # Catch cases that require patron refunds
742 if ( $new_outstanding < 0 ) {
743 my $account =
744 Koha::Patrons->find( $self->borrowernumber )->account;
745 my $credit = $account->add_credit(
747 amount => $new_outstanding * -1,
748 type => 'OVERPAYMENT',
749 interface => $interface,
750 ( $update_type eq 'overdue_update' ? ( item_id => $self->itemnumber ) : ()),
753 $new_outstanding = 0;
756 # Update the account line
757 $self->set(
759 date => \'NOW()',
760 amount => $amount,
761 amountoutstanding => $new_outstanding,
763 )->store();
765 # Record the account offset
766 my $account_offset = Koha::Account::Offset->new(
768 debit_id => $self->id,
769 type => $offset_type,
770 amount => $difference
772 )->store();
774 if ( C4::Context->preference("FinesLog") ) {
775 logaction(
776 "FINES", 'UPDATE', #undef becomes UPDATE in UpdateFine
777 $self->borrowernumber,
778 Dumper(
779 { action => $update_type,
780 borrowernumber => $self->borrowernumber,
781 amount => $amount,
782 description => undef,
783 amountoutstanding => $new_outstanding,
784 debit_type_code => $self->debit_type_code,
785 note => undef,
786 itemnumber => $self->itemnumber,
787 manager_id => undef,
790 ) if ( $update_type eq 'overdue_update' );
795 return $self;
798 =head3 is_credit
800 my $bool = $line->is_credit;
802 =cut
804 sub is_credit {
805 my ($self) = @_;
807 return defined $self->credit_type_code;
810 =head3 is_debit
812 my $bool = $line->is_debit;
814 =cut
816 sub is_debit {
817 my ($self) = @_;
819 return !$self->is_credit;
822 =head3 to_api_mapping
824 This method returns the mapping for representing a Koha::Account::Line object
825 on the API.
827 =cut
829 sub to_api_mapping {
830 return {
831 accountlines_id => 'account_line_id',
832 credit_type_code => 'credit_type',
833 debit_type_code => 'debit_type',
834 amountoutstanding => 'amount_outstanding',
835 borrowernumber => 'patron_id',
836 branchcode => 'library_id',
837 issue_id => 'checkout_id',
838 itemnumber => 'item_id',
839 manager_id => 'user_id',
840 note => 'internal_note',
845 =head3 renewable
847 my $bool = $line->renewable;
849 =cut
851 sub renewable {
852 my ($self) = @_;
854 return (
855 $self->amountoutstanding == 0 &&
856 $self->debit_type_code &&
857 $self->debit_type_code eq 'OVERDUE' &&
858 $self->status &&
859 $self->status eq 'UNRETURNED'
860 ) ? 1 : 0;
863 =head3 renew_item
865 my $renew_result = $line->renew_item;
867 Conditionally attempt to renew an item and return the outcome. This is
868 as a consequence of the fine on an item being fully paid off
870 =cut
872 sub renew_item {
873 my ($self, $params) = @_;
875 my $outcome = {};
877 # We want to reject the call to renew if any of these apply:
878 # - The RenewAccruingItemWhenPaid syspref is off
879 # - The line item doesn't have an item attached to it
880 # - The line item doesn't have a patron attached to it
882 # - The RenewAccruingItemInOpac syspref is off
883 # AND
884 # - There is an interface param passed and it's value is 'opac'
886 if (
887 !C4::Context->preference('RenewAccruingItemWhenPaid') ||
888 !$self->item ||
889 !$self->patron ||
891 !C4::Context->preference('RenewAccruingItemInOpac') &&
892 $params->{interface} &&
893 $params->{interface} eq 'opac'
896 return;
899 my $itemnumber = $self->item->itemnumber;
900 my $borrowernumber = $self->patron->borrowernumber;
901 my ( $can_renew, $error ) = C4::Circulation::CanBookBeRenewed(
902 $borrowernumber,
903 $itemnumber
905 if ( $can_renew ) {
906 my $due_date = C4::Circulation::AddRenewal(
907 $borrowernumber,
908 $itemnumber,
909 $self->{branchcode},
910 undef,
911 undef,
914 return {
915 itemnumber => $itemnumber,
916 due_date => $due_date,
917 success => 1
919 } else {
920 return {
921 itemnumber => $itemnumber,
922 error => $error,
923 success => 0
929 =head3 store
931 Specific store method to generate credit number before saving
933 =cut
935 sub store {
936 my ($self) = @_;
938 my $AutoCreditNumber = C4::Context->preference('AutoCreditNumber');
939 my $credit_number_enabled = $self->is_credit && $self->credit_type->credit_number_enabled;
941 if ($AutoCreditNumber && $credit_number_enabled && !$self->in_storage) {
942 if (defined $self->credit_number) {
943 Koha::Exceptions::Account->throw('AutoCreditNumber is enabled but credit_number is already defined');
946 my $rs = Koha::Database->new->schema->resultset($self->_type);
948 if ($AutoCreditNumber eq 'incremental') {
949 my $max = $rs->search({
950 credit_number => { -regexp => '^[0-9]+$' }
951 }, {
952 select => \'CAST(credit_number AS UNSIGNED)',
953 as => ['credit_number'],
954 })->get_column('credit_number')->max;
955 $max //= 0;
956 $self->credit_number($max + 1);
957 } elsif ($AutoCreditNumber eq 'annual') {
958 my $now = dt_from_string;
959 my $prefix = sprintf('%d-', $now->year);
960 my $max = $rs->search({
961 -and => [
962 credit_number => { -regexp => '[0-9]{4}$' },
963 credit_number => { -like => "$prefix%" },
965 })->get_column('credit_number')->max;
966 $max //= $prefix . '0000';
967 my $incr = substr($max, length $prefix);
968 $self->credit_number(sprintf('%s%04d', $prefix, $incr + 1));
969 } elsif ($AutoCreditNumber eq 'branchyyyymmincr') {
970 my $userenv = C4::Context->userenv;
971 if ($userenv) {
972 my $branch = $userenv->{branch};
973 my $now = dt_from_string;
974 my $prefix = sprintf('%s%d%02d', $branch, $now->year, $now->month);
975 my $pattern = $prefix;
976 $pattern =~ s/([\?%_])/\\$1/g;
977 my $max = $rs->search({
978 -and => [
979 credit_number => { -regexp => '[0-9]{4}$' },
980 credit_number => { -like => "$pattern%" },
982 })->get_column('credit_number')->max;
983 $max //= $prefix . '0000';
984 my $incr = substr($max, length $prefix);
985 $self->credit_number(sprintf('%s%04d', $prefix, $incr + 1));
990 return $self->SUPER::store();
993 =head2 Internal methods
995 =cut
997 =head3 _type
999 =cut
1001 sub _type {
1002 return 'Accountline';
1007 =head2 Name mappings
1009 =head3 $allowed_update
1011 =cut
1013 our $allowed_update = { 'overdue_update' => { 'OVERDUE' => 'UNRETURNED' } };
1015 =head1 AUTHORS
1017 Kyle M Hall <kyle@bywatersolutions.com >
1018 Tomás Cohen Arazi <tomascohen@theke.io>
1019 Martin Renvoize <martin.renvoize@ptfs-europe.com>
1021 =cut