Bug 19036: (QA follow-up) Use Koha::DateUtils
[koha.git] / Koha / Account / Line.pm
blob98d7ef3c15044596275bcfd50486165aa77fb275
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::IsNotCredit->throw(
171 error => 'Account line ' . $self->id . ' is not a debit'
175 my $rs =
176 $self->_result->search_related('account_offsets_debits')
177 ->search_related( 'credit', $cond, $attr );
178 return unless $rs;
179 return Koha::Account::Lines->_new_from_dbic($rs);
182 =head3 debits
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.
191 =cut
193 sub debits {
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'
202 my $rs =
203 $self->_result->search_related('account_offsets_credits')
204 ->search_related( 'debit', $cond, $attr );
205 return unless $rs;
206 return Koha::Account::Lines->_new_from_dbic($rs);
209 =head3 void
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".
217 =cut
219 sub void {
220 my ($self) = @_;
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(
230 sub {
231 foreach my $account_offset (@account_offsets) {
232 my $fee_paid =
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);
240 $fee_paid->store();
242 Koha::Account::Offset->new(
244 credit_id => $self->id,
245 debit_id => $fee_paid->id,
246 amount => $amount_paid,
247 type => 'Void Payment',
249 )->store();
252 if ( C4::Context->preference("FinesLog") ) {
253 logaction(
254 "FINES", 'VOID',
255 $self->borrowernumber,
256 Dumper(
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,
265 note => $self->note,
266 itemnumber => $self->itemnumber,
267 manager_id => $self->manager_id,
268 offsets =>
269 [ map { $_->unblessed } @account_offsets ],
275 $self->set(
277 status => 'VOID',
278 amountoutstanding => 0,
279 amount => 0,
282 $self->store();
288 =head3 reduce
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
295 outstanding.
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
299 returned.
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
304 debts.
306 Reduction type may be one of:
308 * REFUND
309 * DISCOUNT
311 Returns the reduction accountline (which will be a credit)
313 =cut
315 sub reduce {
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} );
357 my $reduced =
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 ("
361 . abs($original)
362 . ")" )
363 unless ( $original >= ( $params->{amount} + abs($reduced) ) );
365 my $status = { 'REFUND' => 'REFUNDED', 'DISCOUNT' => 'DISCOUNTED' };
367 my $reduction;
368 $self->_result->result_source->schema->txn_do(
369 sub {
371 # A 'reduction' is a 'credit'
372 $reduction = Koha::Account::Line->new(
374 date => \'NOW()',
375 amount => 0 - $params->{amount},
376 credit_type_code => $params->{reduction_type},
377 status => 'ADDED',
378 amountoutstanding => 0 - $params->{amount},
379 manager_id => $params->{staff_id},
380 borrowernumber => $self->borrowernumber,
381 interface => $params->{interface},
382 branchcode => $params->{branch},
384 )->store();
386 my $reduction_offset = Koha::Account::Offset->new(
388 credit_id => $reduction->accountlines_id,
389 type => uc( $params->{reduction_type} ),
390 amount => $params->{amount}
392 )->store();
394 # Link reduction to charge (and apply as required)
395 my $debit_outstanding = $self->amountoutstanding;
396 if ( $debit_outstanding >= $params->{amount} ) {
398 $reduction->apply(
400 debits => [$self],
401 offset_type => uc( $params->{reduction_type} )
404 $reduction->status('APPLIED')->store();
406 else {
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} ),
414 amount => 0
416 )->store();
419 # Update status of original debit
420 $self->status( $status->{ $params->{reduction_type} } )->store;
424 $reduction->discard_changes;
425 return $reduction;
428 =head3 apply
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
437 =over 4
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)
444 =back
446 =cut
448 sub apply {
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,
495 )->store();
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
503 # appropriate
504 if ($debit->renewable) {
505 $debit->renew_item($params->{interface});
508 # Same logic exists in Koha::Account::pay
509 if (
510 C4::Context->preference('MarkLostItemsAsReturned') =~
511 m|onpayment|
512 && $debit->debit_type_code
513 && $debit->debit_type_code eq 'LOST'
514 && $debit->amountoutstanding == 0
515 && $debit->itemnumber
516 && !(
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;
531 =head3 payout
533 $credit_accountline->payout(
535 payout_type => $payout_type,
536 register_id => $register_id,
537 staff_id => $staff_id,
538 interface => 'intranet',
539 amount => $amount
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.
549 =cut
551 sub payout {
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
561 my @mandatory =
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;
572 my $amount =
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} ) );
588 my $payout;
589 $self->_result->result_source->schema->txn_do(
590 sub {
592 # A 'payout' is a 'debit'
593 $payout = Koha::Account::Line->new(
595 date => \'NOW()',
596 amount => $amount,
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}
606 )->store();
608 my $payout_offset = Koha::Account::Offset->new(
610 debit_id => $payout->accountlines_id,
611 type => 'PAYOUT',
612 amount => $amount
614 )->store();
616 $self->apply( { debits => [$payout], offset_type => 'PAYOUT' } );
617 $self->status('PAID')->store;
621 $payout->discard_changes;
622 return $payout;
625 =head3 adjust
627 This method allows updating a debit or credit on a patron's account
629 $account_line->adjust(
631 amount => $amount,
632 type => $update_type,
633 interface => $interface
637 $update_type can be any of:
638 - overdue_update
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.
646 =cut
648 sub adjust {
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;
663 unless (
665 exists(
666 $Koha::Account::Line::allowed_update->{$update_type}
667 ->{$debit_type_code}
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;
680 $schema->txn_do(
681 sub {
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 ) {
693 my $account =
694 Koha::Patrons->find( $self->borrowernumber )->account;
695 my $credit = $account->add_credit(
697 amount => $new_outstanding * -1,
698 description => 'Overpayment refund',
699 type => 'CREDIT',
700 interface => $interface,
701 ( $update_type eq 'overdue_update' ? ( item_id => $self->itemnumber ) : ()),
704 $new_outstanding = 0;
707 # Update the account line
708 $self->set(
710 date => \'NOW()',
711 amount => $amount,
712 amountoutstanding => $new_outstanding,
714 )->store();
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
723 )->store();
725 if ( C4::Context->preference("FinesLog") ) {
726 logaction(
727 "FINES", 'UPDATE', #undef becomes UPDATE in UpdateFine
728 $self->borrowernumber,
729 Dumper(
730 { action => $update_type,
731 borrowernumber => $self->borrowernumber,
732 amount => $amount,
733 description => undef,
734 amountoutstanding => $new_outstanding,
735 debit_type_code => $self->debit_type_code,
736 note => undef,
737 itemnumber => $self->itemnumber,
738 manager_id => undef,
741 ) if ( $update_type eq 'overdue_update' );
746 return $self;
749 =head3 is_credit
751 my $bool = $line->is_credit;
753 =cut
755 sub is_credit {
756 my ($self) = @_;
758 return ( $self->amount < 0 );
761 =head3 is_debit
763 my $bool = $line->is_debit;
765 =cut
767 sub is_debit {
768 my ($self) = @_;
770 return !$self->is_credit;
773 =head3 to_api_mapping
775 This method returns the mapping for representing a Koha::Account::Line object
776 on the API.
778 =cut
780 sub to_api_mapping {
781 return {
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',
796 =head3 renewable
798 my $bool = $line->renewable;
800 =cut
802 sub renewable {
803 my ($self) = @_;
805 return (
806 $self->amountoutstanding == 0 &&
807 $self->debit_type_code &&
808 $self->debit_type_code eq 'OVERDUE' &&
809 $self->status &&
810 $self->status eq 'UNRETURNED'
811 ) ? 1 : 0;
814 =head3 renew_item
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
821 =cut
823 sub renew_item {
824 my ($self, $params) = @_;
826 my $outcome = {};
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
834 # AND
835 # - There is an interface param passed and it's value is 'opac'
837 if (
838 !C4::Context->preference('RenewAccruingItemWhenPaid') ||
839 !$self->item ||
840 !$self->patron ||
842 !C4::Context->preference('RenewAccruingItemInOpac') &&
843 $params->{interface} &&
844 $params->{interface} eq 'opac'
847 return;
850 my $itemnumber = $self->item->itemnumber;
851 my $borrowernumber = $self->patron->borrowernumber;
852 my ( $can_renew, $error ) = C4::Circulation::CanBookBeRenewed(
853 $borrowernumber,
854 $itemnumber
856 if ( $can_renew ) {
857 my $due_date = C4::Circulation::AddRenewal(
858 $borrowernumber,
859 $itemnumber,
860 $self->{branchcode},
861 undef,
862 undef,
865 return {
866 itemnumber => $itemnumber,
867 due_date => $due_date,
868 success => 1
870 } else {
871 return {
872 itemnumber => $itemnumber,
873 error => $error,
874 success => 0
880 =head3 store
882 Specific store method to generate credit number before saving
884 =cut
886 sub store {
887 my ($self) = @_;
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]+$' }
902 }, {
903 select => \'CAST(credit_number AS UNSIGNED)',
904 as => ['credit_number'],
905 })->get_column('credit_number')->max;
906 $max //= 0;
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({
912 -and => [
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;
922 if ($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({
929 -and => [
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
946 =cut
948 =head3 _type
950 =cut
952 sub _type {
953 return 'Accountline';
958 =head2 Name mappings
960 =head3 $allowed_update
962 =cut
964 our $allowed_update = { 'overdue_update' => { 'OVERDUE' => 'UNRETURNED' } };
966 =head1 AUTHORS
968 Kyle M Hall <kyle@bywatersolutions.com >
969 Tomás Cohen Arazi <tomascohen@theke.io>
970 Martin Renvoize <martin.renvoize@ptfs-europe.com>
972 =cut