Bug 26922: Regression tests
[koha.git] / Koha / Account / Line.pm
blob2cc81993ef1f9ecdeff43919e315335102d49f31
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'.
297 Charges that have been fully or partially paid cannot be cancelled.
299 Returns the cancellation accountline.
301 =cut
303 sub cancel {
304 my ( $self, $params ) = @_;
306 # Make sure it is a charge we are reducing
307 unless ( $self->is_debit ) {
308 Koha::Exceptions::Account::IsNotDebit->throw(
309 error => 'Account line ' . $self->id . 'is not a debit' );
311 if ( $self->debit_type_code eq 'PAYOUT' ) {
312 Koha::Exceptions::Account::IsNotDebit->throw(
313 error => 'Account line ' . $self->id . 'is a payout' );
316 # Make sure it is not already cancelled
317 if ( $self->status && $self->status eq 'CANCELLED' ) {
318 Koha::Exceptions::Account->throw(
319 error => 'Account line ' . $self->id . 'is already cancelled' );
322 # Make sure it has not be paid yet
323 if ( $self->amount != $self->amountoutstanding ) {
324 Koha::Exceptions::Account->throw(
325 error => 'Account line ' . $self->id . 'is already offset' );
328 # Check for mandatory parameters
329 my @mandatory = ( 'staff_id', 'branch' );
330 for my $param (@mandatory) {
331 unless ( defined( $params->{$param} ) ) {
332 Koha::Exceptions::MissingParameter->throw(
333 error => "The $param parameter is mandatory" );
337 my $cancellation;
338 $self->_result->result_source->schema->txn_do(
339 sub {
341 # A 'cancellation' is a 'credit'
342 $cancellation = Koha::Account::Line->new(
344 date => \'NOW()',
345 amount => 0 - $self->amount,
346 credit_type_code => 'CANCELLATION',
347 status => 'ADDED',
348 amountoutstanding => 0 - $self->amount,
349 manager_id => $params->{staff_id},
350 borrowernumber => $self->borrowernumber,
351 interface => 'intranet',
352 branchcode => $params->{branch},
354 )->store();
356 my $cancellation_offset = Koha::Account::Offset->new(
358 credit_id => $cancellation->accountlines_id,
359 type => 'CANCELLATION',
360 amount => $self->amount
362 )->store();
364 # Link cancellation to charge
365 $cancellation->apply(
367 debits => [$self],
368 offset_type => 'CANCELLATION'
371 $cancellation->status('APPLIED')->store();
373 # Update status of original debit
374 $self->status('CANCELLED')->store;
378 $cancellation->discard_changes;
379 return $cancellation;
382 =head3 reduce
384 $charge_accountline->reduce({
385 reduction_type => $reduction_type
388 Used to 'reduce' a charge/debit by adding a credit to offset against the amount
389 outstanding.
391 May be used to apply a discount whilst retaining the original debit amounts or
392 to apply a full or partial refund for example when a lost item is found and
393 returned.
395 It will immediately be applied to the given debit unless the debit has already
396 been paid, in which case a 'zero' offset will be added to maintain a link to
397 the debit but the outstanding credit will be left so it may be applied to other
398 debts.
400 Reduction type may be one of:
402 * REFUND
403 * DISCOUNT
405 Returns the reduction accountline (which will be a credit)
407 =cut
409 sub reduce {
410 my ( $self, $params ) = @_;
412 # Make sure it is a charge we are reducing
413 unless ( $self->is_debit ) {
414 Koha::Exceptions::Account::IsNotDebit->throw(
415 error => 'Account line ' . $self->id . 'is not a debit' );
417 if ( $self->debit_type_code eq 'PAYOUT' ) {
418 Koha::Exceptions::Account::IsNotDebit->throw(
419 error => 'Account line ' . $self->id . 'is a payout' );
422 # Check for mandatory parameters
423 my @mandatory = ( 'interface', 'reduction_type', 'amount' );
424 for my $param (@mandatory) {
425 unless ( defined( $params->{$param} ) ) {
426 Koha::Exceptions::MissingParameter->throw(
427 error => "The $param parameter is mandatory" );
431 # More mandatory parameters
432 if ( $params->{interface} eq 'intranet' ) {
433 my @optional = ( 'staff_id', 'branch' );
434 for my $param (@optional) {
435 unless ( defined( $params->{$param} ) ) {
436 Koha::Exceptions::MissingParameter->throw( error =>
437 "The $param parameter is mandatory when interface is set to 'intranet'"
443 # Make sure the reduction isn't more than the original
444 my $original = $self->amount;
445 Koha::Exceptions::Account::AmountNotPositive->throw(
446 error => 'Reduce amount passed is not positive' )
447 unless ( $params->{amount} > 0 );
448 Koha::Exceptions::ParameterTooHigh->throw( error =>
449 "Amount to reduce ($params->{amount}) is higher than original amount ($original)"
450 ) unless ( $original >= $params->{amount} );
451 my $reduced =
452 $self->credits( { credit_type_code => [ 'DISCOUNT', 'REFUND' ] } )->total;
453 Koha::Exceptions::ParameterTooHigh->throw( error =>
454 "Combined reduction ($params->{amount} + $reduced) is higher than original amount ("
455 . abs($original)
456 . ")" )
457 unless ( $original >= ( $params->{amount} + abs($reduced) ) );
459 my $status = { 'REFUND' => 'REFUNDED', 'DISCOUNT' => 'DISCOUNTED' };
461 my $reduction;
462 $self->_result->result_source->schema->txn_do(
463 sub {
465 # A 'reduction' is a 'credit'
466 $reduction = Koha::Account::Line->new(
468 date => \'NOW()',
469 amount => 0 - $params->{amount},
470 credit_type_code => $params->{reduction_type},
471 status => 'ADDED',
472 amountoutstanding => 0 - $params->{amount},
473 manager_id => $params->{staff_id},
474 borrowernumber => $self->borrowernumber,
475 interface => $params->{interface},
476 branchcode => $params->{branch},
478 )->store();
480 my $reduction_offset = Koha::Account::Offset->new(
482 credit_id => $reduction->accountlines_id,
483 type => uc( $params->{reduction_type} ),
484 amount => $params->{amount}
486 )->store();
488 # Link reduction to charge (and apply as required)
489 my $debit_outstanding = $self->amountoutstanding;
490 if ( $debit_outstanding >= $params->{amount} ) {
492 $reduction->apply(
494 debits => [$self],
495 offset_type => uc( $params->{reduction_type} )
498 $reduction->status('APPLIED')->store();
500 else {
502 # Zero amount offset used to link original 'debit' to
503 # reduction 'credit'
504 my $link_reduction_offset = Koha::Account::Offset->new(
506 credit_id => $reduction->accountlines_id,
507 debit_id => $self->accountlines_id,
508 type => uc( $params->{reduction_type} ),
509 amount => 0
511 )->store();
514 # Update status of original debit
515 $self->status( $status->{ $params->{reduction_type} } )->store;
519 $reduction->discard_changes;
520 return $reduction;
523 =head3 apply
525 my $debits = $account->outstanding_debits;
526 my $outstanding_amount = $credit->apply( { debits => $debits, [ offset_type => $offset_type ] } );
528 Applies the credit to a given debits array reference.
530 =head4 arguments hashref
532 =over 4
534 =item debits - Koha::Account::Lines object set of debits
536 =item offset_type (optional) - a string indicating the offset type (valid values are those from
537 the 'account_offset_types' table)
539 =back
541 =cut
543 sub apply {
544 my ( $self, $params ) = @_;
546 my $debits = $params->{debits};
547 my $offset_type = $params->{offset_type} // 'Credit Applied';
549 unless ( $self->is_credit ) {
550 Koha::Exceptions::Account::IsNotCredit->throw(
551 error => 'Account line ' . $self->id . ' is not a credit'
555 my $available_credit = $self->amountoutstanding * -1;
557 unless ( $available_credit > 0 ) {
558 Koha::Exceptions::Account::NoAvailableCredit->throw(
559 error => 'Outstanding credit is ' . $available_credit . ' and cannot be applied'
563 my $schema = Koha::Database->new->schema;
565 $schema->txn_do( sub {
566 for my $debit ( @{$debits} ) {
568 unless ( $debit->is_debit ) {
569 Koha::Exceptions::Account::IsNotDebit->throw(
570 error => 'Account line ' . $debit->id . 'is not a debit'
573 my $amount_to_cancel;
574 my $owed = $debit->amountoutstanding;
576 if ( $available_credit >= $owed ) {
577 $amount_to_cancel = $owed;
579 else { # $available_credit < $debit->amountoutstanding
580 $amount_to_cancel = $available_credit;
583 # record the account offset
584 Koha::Account::Offset->new(
585 { credit_id => $self->id,
586 debit_id => $debit->id,
587 amount => $amount_to_cancel * -1,
588 type => $offset_type,
590 )->store();
592 $available_credit -= $amount_to_cancel;
594 $self->amountoutstanding( $available_credit * -1 )->store;
595 $debit->amountoutstanding( $owed - $amount_to_cancel )->store;
597 # Attempt to renew the item associated with this debit if
598 # appropriate
599 if ($debit->renewable) {
600 $debit->renew_item($params->{interface});
603 # Same logic exists in Koha::Account::pay
604 if (
605 C4::Context->preference('MarkLostItemsAsReturned') =~
606 m|onpayment|
607 && $debit->debit_type_code
608 && $debit->debit_type_code eq 'LOST'
609 && $debit->amountoutstanding == 0
610 && $debit->itemnumber
611 && !(
612 $self->credit_type_code eq 'LOST_FOUND'
613 && $self->itemnumber == $debit->itemnumber
617 C4::Circulation::ReturnLostItem( $self->borrowernumber,
618 $debit->itemnumber );
623 return $available_credit;
626 =head3 payout
628 $credit_accountline->payout(
630 payout_type => $payout_type,
631 register_id => $register_id,
632 staff_id => $staff_id,
633 interface => 'intranet',
634 amount => $amount
638 Used to 'pay out' a credit to a user.
640 Payout type may be one of any existing payment types
642 Returns the payout debit line that is created via this transaction.
644 =cut
646 sub payout {
647 my ( $self, $params ) = @_;
649 # Make sure it is a credit we are paying out
650 unless ( $self->is_credit ) {
651 Koha::Exceptions::Account::IsNotCredit->throw(
652 error => 'Account line ' . $self->id . ' is not a credit' );
655 # Check for mandatory parameters
656 my @mandatory =
657 ( 'interface', 'staff_id', 'branch', 'payout_type', 'amount' );
658 for my $param (@mandatory) {
659 unless ( defined( $params->{$param} ) ) {
660 Koha::Exceptions::MissingParameter->throw(
661 error => "The $param parameter is mandatory" );
665 # Make sure there is outstanding credit to pay out
666 my $outstanding = -1 * $self->amountoutstanding;
667 my $amount =
668 $params->{amount} ? $params->{amount} : $outstanding;
669 Koha::Exceptions::Account::AmountNotPositive->throw(
670 error => 'Payout amount passed is not positive' )
671 unless ( $amount > 0 );
672 Koha::Exceptions::ParameterTooHigh->throw(
673 error => "Amount to payout ($amount) is higher than amountoutstanding ($outstanding)" )
674 unless ($outstanding >= $amount );
676 # Make sure we record the cash register for cash transactions
677 Koha::Exceptions::Account::RegisterRequired->throw()
678 if ( C4::Context->preference("UseCashRegisters")
679 && defined( $params->{payout_type} )
680 && ( $params->{payout_type} eq 'CASH' )
681 && !defined( $params->{cash_register} ) );
683 my $payout;
684 $self->_result->result_source->schema->txn_do(
685 sub {
687 # A 'payout' is a 'debit'
688 $payout = Koha::Account::Line->new(
690 date => \'NOW()',
691 amount => $amount,
692 debit_type_code => 'PAYOUT',
693 payment_type => $params->{payout_type},
694 amountoutstanding => $amount,
695 manager_id => $params->{staff_id},
696 borrowernumber => $self->borrowernumber,
697 interface => $params->{interface},
698 branchcode => $params->{branch},
699 register_id => $params->{cash_register}
701 )->store();
703 my $payout_offset = Koha::Account::Offset->new(
705 debit_id => $payout->accountlines_id,
706 type => 'PAYOUT',
707 amount => $amount
709 )->store();
711 $self->apply( { debits => [$payout], offset_type => 'PAYOUT' } );
712 $self->status('PAID')->store;
716 $payout->discard_changes;
717 return $payout;
720 =head3 adjust
722 This method allows updating a debit or credit on a patron's account
724 $account_line->adjust(
726 amount => $amount,
727 type => $update_type,
728 interface => $interface
732 $update_type can be any of:
733 - overdue_update
735 Authors Note: The intention here is that this method is only used
736 to adjust accountlines where the final amount is not yet known/fixed.
737 Incrementing fines are the only existing case at the time of writing,
738 all other forms of 'adjustment' should be recorded as distinct credits
739 or debits and applied, via an offset, to the corresponding debit or credit.
741 =cut
743 sub adjust {
744 my ( $self, $params ) = @_;
746 my $amount = $params->{amount};
747 my $update_type = $params->{type};
748 my $interface = $params->{interface};
750 unless ( exists($Koha::Account::Line::allowed_update->{$update_type}) ) {
751 Koha::Exceptions::Account::UnrecognisedType->throw(
752 error => 'Update type not recognised'
756 my $debit_type_code = $self->debit_type_code;
757 my $account_status = $self->status;
758 unless (
760 exists(
761 $Koha::Account::Line::allowed_update->{$update_type}
762 ->{$debit_type_code}
764 && ( $Koha::Account::Line::allowed_update->{$update_type}
765 ->{$debit_type_code} eq $account_status )
769 Koha::Exceptions::Account::UnrecognisedType->throw(
770 error => 'Update type not allowed on this debit_type' );
773 my $schema = Koha::Database->new->schema;
775 $schema->txn_do(
776 sub {
778 my $amount_before = $self->amount;
779 my $amount_outstanding_before = $self->amountoutstanding;
780 my $difference = $amount - $amount_before;
781 my $new_outstanding = $amount_outstanding_before + $difference;
783 my $offset_type = $debit_type_code;
784 $offset_type .= ( $difference > 0 ) ? "_INCREASE" : "_DECREASE";
786 # Catch cases that require patron refunds
787 if ( $new_outstanding < 0 ) {
788 my $account =
789 Koha::Patrons->find( $self->borrowernumber )->account;
790 my $credit = $account->add_credit(
792 amount => $new_outstanding * -1,
793 type => 'OVERPAYMENT',
794 interface => $interface,
795 ( $update_type eq 'overdue_update' ? ( item_id => $self->itemnumber ) : ()),
798 $new_outstanding = 0;
801 # Update the account line
802 $self->set(
804 date => \'NOW()',
805 amount => $amount,
806 amountoutstanding => $new_outstanding,
808 )->store();
810 # Record the account offset
811 my $account_offset = Koha::Account::Offset->new(
813 debit_id => $self->id,
814 type => $offset_type,
815 amount => $difference
817 )->store();
819 if ( C4::Context->preference("FinesLog") ) {
820 logaction(
821 "FINES", 'UPDATE', #undef becomes UPDATE in UpdateFine
822 $self->borrowernumber,
823 Dumper(
824 { action => $update_type,
825 borrowernumber => $self->borrowernumber,
826 amount => $amount,
827 description => undef,
828 amountoutstanding => $new_outstanding,
829 debit_type_code => $self->debit_type_code,
830 note => undef,
831 itemnumber => $self->itemnumber,
832 manager_id => undef,
835 ) if ( $update_type eq 'overdue_update' );
840 return $self;
843 =head3 is_credit
845 my $bool = $line->is_credit;
847 =cut
849 sub is_credit {
850 my ($self) = @_;
852 return defined $self->credit_type_code;
855 =head3 is_debit
857 my $bool = $line->is_debit;
859 =cut
861 sub is_debit {
862 my ($self) = @_;
864 return !$self->is_credit;
867 =head3 to_api_mapping
869 This method returns the mapping for representing a Koha::Account::Line object
870 on the API.
872 =cut
874 sub to_api_mapping {
875 return {
876 accountlines_id => 'account_line_id',
877 credit_type_code => 'credit_type',
878 debit_type_code => 'debit_type',
879 amountoutstanding => 'amount_outstanding',
880 borrowernumber => 'patron_id',
881 branchcode => 'library_id',
882 issue_id => 'checkout_id',
883 itemnumber => 'item_id',
884 manager_id => 'user_id',
885 note => 'internal_note',
890 =head3 renewable
892 my $bool = $line->renewable;
894 =cut
896 sub renewable {
897 my ($self) = @_;
899 return (
900 $self->amountoutstanding == 0 &&
901 $self->debit_type_code &&
902 $self->debit_type_code eq 'OVERDUE' &&
903 $self->status &&
904 $self->status eq 'UNRETURNED'
905 ) ? 1 : 0;
908 =head3 renew_item
910 my $renew_result = $line->renew_item;
912 Conditionally attempt to renew an item and return the outcome. This is
913 as a consequence of the fine on an item being fully paid off
915 =cut
917 sub renew_item {
918 my ($self, $params) = @_;
920 my $outcome = {};
922 # We want to reject the call to renew if any of these apply:
923 # - The RenewAccruingItemWhenPaid syspref is off
924 # - The line item doesn't have an item attached to it
925 # - The line item doesn't have a patron attached to it
927 # - The RenewAccruingItemInOpac syspref is off
928 # AND
929 # - There is an interface param passed and it's value is 'opac'
931 if (
932 !C4::Context->preference('RenewAccruingItemWhenPaid') ||
933 !$self->item ||
934 !$self->patron ||
936 !C4::Context->preference('RenewAccruingItemInOpac') &&
937 $params->{interface} &&
938 $params->{interface} eq 'opac'
941 return;
944 my $itemnumber = $self->item->itemnumber;
945 my $borrowernumber = $self->patron->borrowernumber;
946 my ( $can_renew, $error ) = C4::Circulation::CanBookBeRenewed(
947 $borrowernumber,
948 $itemnumber
950 if ( $can_renew ) {
951 my $due_date = C4::Circulation::AddRenewal(
952 $borrowernumber,
953 $itemnumber,
954 $self->{branchcode},
955 undef,
956 undef,
959 return {
960 itemnumber => $itemnumber,
961 due_date => $due_date,
962 success => 1
964 } else {
965 return {
966 itemnumber => $itemnumber,
967 error => $error,
968 success => 0
974 =head3 store
976 Specific store method to generate credit number before saving
978 =cut
980 sub store {
981 my ($self) = @_;
983 my $AutoCreditNumber = C4::Context->preference('AutoCreditNumber');
984 my $credit_number_enabled = $self->is_credit && $self->credit_type->credit_number_enabled;
986 if ($AutoCreditNumber && $credit_number_enabled && !$self->in_storage) {
987 if (defined $self->credit_number) {
988 Koha::Exceptions::Account->throw('AutoCreditNumber is enabled but credit_number is already defined');
991 my $rs = Koha::Database->new->schema->resultset($self->_type);
993 if ($AutoCreditNumber eq 'incremental') {
994 my $max = $rs->search({
995 credit_number => { -regexp => '^[0-9]+$' }
996 }, {
997 select => \'CAST(credit_number AS UNSIGNED)',
998 as => ['credit_number'],
999 })->get_column('credit_number')->max;
1000 $max //= 0;
1001 $self->credit_number($max + 1);
1002 } elsif ($AutoCreditNumber eq 'annual') {
1003 my $now = dt_from_string;
1004 my $prefix = sprintf('%d-', $now->year);
1005 my $max = $rs->search({
1006 -and => [
1007 credit_number => { -regexp => '[0-9]{4}$' },
1008 credit_number => { -like => "$prefix%" },
1010 })->get_column('credit_number')->max;
1011 $max //= $prefix . '0000';
1012 my $incr = substr($max, length $prefix);
1013 $self->credit_number(sprintf('%s%04d', $prefix, $incr + 1));
1014 } elsif ($AutoCreditNumber eq 'branchyyyymmincr') {
1015 my $userenv = C4::Context->userenv;
1016 if ($userenv) {
1017 my $branch = $userenv->{branch};
1018 my $now = dt_from_string;
1019 my $prefix = sprintf('%s%d%02d', $branch, $now->year, $now->month);
1020 my $pattern = $prefix;
1021 $pattern =~ s/([\?%_])/\\$1/g;
1022 my $max = $rs->search({
1023 -and => [
1024 credit_number => { -regexp => '[0-9]{4}$' },
1025 credit_number => { -like => "$pattern%" },
1027 })->get_column('credit_number')->max;
1028 $max //= $prefix . '0000';
1029 my $incr = substr($max, length $prefix);
1030 $self->credit_number(sprintf('%s%04d', $prefix, $incr + 1));
1035 return $self->SUPER::store();
1038 =head2 Internal methods
1040 =cut
1042 =head3 _type
1044 =cut
1046 sub _type {
1047 return 'Accountline';
1052 =head2 Name mappings
1054 =head3 $allowed_update
1056 =cut
1058 our $allowed_update = { 'overdue_update' => { 'OVERDUE' => 'UNRETURNED' } };
1060 =head1 AUTHORS
1062 Kyle M Hall <kyle@bywatersolutions.com >
1063 Tomás Cohen Arazi <tomascohen@theke.io>
1064 Martin Renvoize <martin.renvoize@ptfs-europe.com>
1066 =cut