Koha/Account/Line.pm

   1 package Koha::Account::Line;
   2
   3 # This file is part of Koha.
   4 #
   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.
   9 #
  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.
  14 #
  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>.
  17
  18 use Modern::Perl;
  19
  20 use Carp;
  21 use Data::Dumper;
  22
  23 use C4::Log qw(logaction);
  24 use C4::Overdues qw(GetFine);
  25
  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;
  33
  34 use base qw(Koha::Object);
  35
  36 =encoding utf8
  37
  38 =head1 NAME
  39
  40 Koha::Account::Line - Koha accountline Object class
  41
  42 =head1 API
  43
  44 =head2 Class methods
  45
  46 =cut
  47
  48 =head3 patron
  49
  50 Return the patron linked to this account line
  51
  52 =cut
  53
  54 sub patron {
  55     my ( $self ) = @_;
  56     my $rs = $self->_result->borrowernumber;
  57     return unless $rs;
  58     return Koha::Patron->_new_from_dbic( $rs );
  59 }
  60
  61 =head3 item
  62
  63 Return the item linked to this account line if exists
  64
  65 =cut
  66
  67 sub item {
  68     my ( $self ) = @_;
  69     my $rs = $self->_result->itemnumber;
  70     return unless $rs;
  71     return Koha::Item->_new_from_dbic( $rs );
  72 }
  73
  74 =head3 checkout
  75
  76 Return the checkout linked to this account line if exists
  77
  78 =cut
  79
  80 sub checkout {
  81     my ( $self ) = @_;
  82     return unless $self->issue_id ;
  83
  84     $self->{_checkout} ||= Koha::Checkouts->find( $self->issue_id );
  85     $self->{_checkout} ||= Koha::Old::Checkouts->find( $self->issue_id );
  86     return $self->{_checkout};
  87 }
  88
  89 =head3 library
  90
  91 Returns a Koha::Library object representing where the accountline was recorded
  92
  93 =cut
  94
  95 sub library {
  96     my ( $self ) = @_;
  97     my $rs = $self->_result->library;
  98     return unless $rs;
  99     return Koha::Library->_new_from_dbic($rs);
 100 }
 101
 102 =head3 credit_type
 103
 104 Return the credit_type linked to this account line
 105
 106 =cut
 107
 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 );
 113 }
 114
 115 =head3 debit_type
 116
 117 Return the debit_type linked to this account line
 118
 119 =cut
 120
 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 );
 126 }
 127
 128 =head3 credit_offsets
 129
 130 Return the credit_offsets linked to this account line if some exist
 131
 132 =cut
 133
 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);
 139 }
 140
 141 =head3 debit_offsets
 142
 143 Return the debit_offsets linked to this account line if some exist
 144
 145 =cut
 146
 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);
 152 }
 153
 154
 155 =head3 credits
 156
 157   my $credits = $accountline->credits;
 158   my $credits = $accountline->credits( $cond, $attr );
 159
 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.
 163
 164 =cut
 165
 166 sub credits {
 167     my ( $self, $cond, $attr ) = @_;
 168
 169     unless ( $self->is_debit ) {
 170         Koha::Exceptions::Account::IsNotDebit->throw(
 171             error => 'Account line ' . $self->id . ' is not a debit'
 172         );
 173     }
 174
 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);
 181 }
 182
 183 =head3 debits
 184
 185   my $debits = $accountline->debits;
 186   my $debits = $accountline->debits( $cond, $attr );
 187
 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.
 191
 192 =cut
 193
 194 sub debits {
 195     my ( $self, $cond, $attr ) = @_;
 196
 197     unless ( $self->is_credit ) {
 198         Koha::Exceptions::Account::IsNotCredit->throw(
 199             error => 'Account line ' . $self->id . ' is not a credit'
 200         );
 201     }
 202
 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);
 209 }
 210
 211 =head3 void
 212
 213   $payment_accountline->void();
 214
 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".
 218
 219 =cut
 220
 221 sub void {
 222     my ($self) = @_;
 223
 224     # Make sure it is a payment we are voiding
 225     return unless $self->amount < 0;
 226
 227     my @account_offsets =
 228       Koha::Account::Offsets->search(
 229         { credit_id => $self->id, amount => { '<' => 0 }  } );
 230
 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 );
 236
 237                 next unless $fee_paid;
 238
 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();
 243
 244                 Koha::Account::Offset->new(
 245                     {
 246                         credit_id => $self->id,
 247                         debit_id  => $fee_paid->id,
 248                         amount    => $amount_paid,
 249                         type      => 'Void Payment',
 250                     }
 251                 )->store();
 252             }
 253
 254             if ( C4::Context->preference("FinesLog") ) {
 255                 logaction(
 256                     "FINES", 'VOID',
 257                     $self->borrowernumber,
 258                     Dumper(
 259                         {
 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 ],
 272                         }
 273                     )
 274                 );
 275             }
 276
 277             $self->set(
 278                 {
 279                     status            => 'VOID',
 280                     amountoutstanding => 0,
 281                     amount            => 0,
 282                 }
 283             );
 284             $self->store();
 285         }
 286     );
 287
 288 }
 289
 290 =head3 cancel
 291
 292   $debit_accountline->cancel();
 293
 294 Cancel a charge. It will mark the debit as 'cancelled' by updating its
 295 status to 'CANCELLED'.
 296
 297 Charges that have been fully or partially paid cannot be cancelled.
 298
 299 Returns the cancellation accountline.
 300
 301 =cut
 302
 303 sub cancel {
 304     my ( $self, $params ) = @_;
 305
 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' );
 310     }
 311     if ( $self->debit_type_code eq 'PAYOUT' ) {
 312         Koha::Exceptions::Account::IsNotDebit->throw(
 313             error => 'Account line ' . $self->id . 'is a payout' );
 314     }
 315
 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' );
 320     }
 321
 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' );
 326     }
 327
 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" );
 334         }
 335     }
 336
 337     my $cancellation;
 338     $self->_result->result_source->schema->txn_do(
 339         sub {
 340
 341             # A 'cancellation' is a 'credit'
 342             $cancellation = Koha::Account::Line->new(
 343                 {
 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},
 353                 }
 354             )->store();
 355
 356             my $cancellation_offset = Koha::Account::Offset->new(
 357                 {
 358                     credit_id => $cancellation->accountlines_id,
 359                     type      => 'CANCELLATION',
 360                     amount    => $self->amount
 361                 }
 362             )->store();
 363
 364             # Link cancellation to charge
 365             $cancellation->apply(
 366                 {
 367                     debits      => [$self],
 368                     offset_type => 'CANCELLATION'
 369                 }
 370             );
 371             $cancellation->status('APPLIED')->store();
 372
 373             # Update status of original debit
 374             $self->status('CANCELLED')->store;
 375         }
 376     );
 377
 378     $cancellation->discard_changes;
 379     return $cancellation;
 380 }
 381
 382 =head3 reduce
 383
 384   $charge_accountline->reduce({
 385       reduction_type => $reduction_type
 386   });
 387
 388 Used to 'reduce' a charge/debit by adding a credit to offset against the amount
 389 outstanding.
 390
 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.
 394
 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.
 399
 400 Reduction type may be one of:
 401
 402 * REFUND
 403 * DISCOUNT
 404
 405 Returns the reduction accountline (which will be a credit)
 406
 407 =cut
 408
 409 sub reduce {
 410     my ( $self, $params ) = @_;
 411
 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' );
 416     }
 417     if ( $self->debit_type_code eq 'PAYOUT' ) {
 418         Koha::Exceptions::Account::IsNotDebit->throw(
 419             error => 'Account line ' . $self->id . 'is a payout' );
 420     }
 421
 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" );
 428         }
 429     }
 430
 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'"
 438                 );
 439             }
 440         }
 441     }
 442
 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) ) );
 458
 459     my $status = { 'REFUND' => 'REFUNDED', 'DISCOUNT' => 'DISCOUNTED' };
 460
 461     my $reduction;
 462     $self->_result->result_source->schema->txn_do(
 463         sub {
 464
 465             # A 'reduction' is a 'credit'
 466             $reduction = Koha::Account::Line->new(
 467                 {
 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},
 477                 }
 478             )->store();
 479
 480             my $reduction_offset = Koha::Account::Offset->new(
 481                 {
 482                     credit_id => $reduction->accountlines_id,
 483                     type      => uc( $params->{reduction_type} ),
 484                     amount    => $params->{amount}
 485                 }
 486             )->store();
 487
 488             # Link reduction to charge (and apply as required)
 489             my $debit_outstanding = $self->amountoutstanding;
 490             if ( $debit_outstanding >= $params->{amount} ) {
 491
 492                 $reduction->apply(
 493                     {
 494                         debits      => [$self],
 495                         offset_type => uc( $params->{reduction_type} )
 496                     }
 497                 );
 498                 $reduction->status('APPLIED')->store();
 499             }
 500             else {
 501
 502                 # Zero amount offset used to link original 'debit' to
 503                 # reduction 'credit'
 504                 my $link_reduction_offset = Koha::Account::Offset->new(
 505                     {
 506                         credit_id => $reduction->accountlines_id,
 507                         debit_id  => $self->accountlines_id,
 508                         type      => uc( $params->{reduction_type} ),
 509                         amount    => 0
 510                     }
 511                 )->store();
 512             }
 513
 514             # Update status of original debit
 515             $self->status( $status->{ $params->{reduction_type} } )->store;
 516         }
 517     );
 518
 519     $reduction->discard_changes;
 520     return $reduction;
 521 }
 522
 523 =head3 apply
 524
 525     my $debits = $account->outstanding_debits;
 526     my $outstanding_amount = $credit->apply( { debits => $debits, [ offset_type => $offset_type ] } );
 527
 528 Applies the credit to a given debits array reference.
 529
 530 =head4 arguments hashref
 531
 532 =over 4
 533
 534 =item debits - Koha::Account::Lines object set of debits
 535
 536 =item offset_type (optional) - a string indicating the offset type (valid values are those from
 537 the 'account_offset_types' table)
 538
 539 =back
 540
 541 =cut
 542
 543 sub apply {
 544     my ( $self, $params ) = @_;
 545
 546     my $debits      = $params->{debits};
 547     my $offset_type = $params->{offset_type} // 'Credit Applied';
 548
 549     unless ( $self->is_credit ) {
 550         Koha::Exceptions::Account::IsNotCredit->throw(
 551             error => 'Account line ' . $self->id . ' is not a credit'
 552         );
 553     }
 554
 555     my $available_credit = $self->amountoutstanding * -1;
 556
 557     unless ( $available_credit > 0 ) {
 558         Koha::Exceptions::Account::NoAvailableCredit->throw(
 559             error => 'Outstanding credit is ' . $available_credit . ' and cannot be applied'
 560         );
 561     }
 562
 563     my $schema = Koha::Database->new->schema;
 564
 565     $schema->txn_do( sub {
 566         for my $debit ( @{$debits} ) {
 567
 568             unless ( $debit->is_debit ) {
 569                 Koha::Exceptions::Account::IsNotDebit->throw(
 570                     error => 'Account line ' . $debit->id . 'is not a debit'
 571                 );
 572             }
 573             my $amount_to_cancel;
 574             my $owed = $debit->amountoutstanding;
 575
 576             if ( $available_credit >= $owed ) {
 577                 $amount_to_cancel = $owed;
 578             }
 579             else {    # $available_credit < $debit->amountoutstanding
 580                 $amount_to_cancel = $available_credit;
 581             }
 582
 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,
 589                 }
 590             )->store();
 591
 592             $available_credit -= $amount_to_cancel;
 593
 594             $self->amountoutstanding( $available_credit * -1 )->store;
 595             $debit->amountoutstanding( $owed - $amount_to_cancel )->store;
 596
 597             # Attempt to renew the item associated with this debit if
 598             # appropriate
 599             if ($debit->renewable) {
 600                 $debit->renew_item($params->{interface});
 601             }
 602
 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
 614                 )
 615               )
 616             {
 617                 C4::Circulation::ReturnLostItem( $self->borrowernumber,
 618                     $debit->itemnumber );
 619             }
 620         }
 621     });
 622
 623     return $available_credit;
 624 }
 625
 626 =head3 payout
 627
 628   $credit_accountline->payout(
 629     {
 630         payout_type => $payout_type,
 631         register_id => $register_id,
 632         staff_id    => $staff_id,
 633         interface   => 'intranet',
 634         amount      => $amount
 635     }
 636   );
 637
 638 Used to 'pay out' a credit to a user.
 639
 640 Payout type may be one of any existing payment types
 641
 642 Returns the payout debit line that is created via this transaction.
 643
 644 =cut
 645
 646 sub payout {
 647     my ( $self, $params ) = @_;
 648
 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' );
 653     }
 654
 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" );
 662         }
 663     }
 664
 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 );
 675
 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} ) );
 682
 683     my $payout;
 684     $self->_result->result_source->schema->txn_do(
 685         sub {
 686
 687             # A 'payout' is a 'debit'
 688             $payout = Koha::Account::Line->new(
 689                 {
 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}
 700                 }
 701             )->store();
 702
 703             my $payout_offset = Koha::Account::Offset->new(
 704                 {
 705                     debit_id => $payout->accountlines_id,
 706                     type     => 'PAYOUT',
 707                     amount   => $amount
 708                 }
 709             )->store();
 710
 711             $self->apply( { debits => [$payout], offset_type => 'PAYOUT' } );
 712             $self->status('PAID')->store;
 713         }
 714     );
 715
 716     $payout->discard_changes;
 717     return $payout;
 718 }
 719
 720 =head3 adjust
 721
 722 This method allows updating a debit or credit on a patron's account
 723
 724     $account_line->adjust(
 725         {
 726             amount    => $amount,
 727             type      => $update_type,
 728             interface => $interface
 729         }
 730     );
 731
 732 $update_type can be any of:
 733   - overdue_update
 734
 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.
 740
 741 =cut
 742
 743 sub adjust {
 744     my ( $self, $params ) = @_;
 745
 746     my $amount       = $params->{amount};
 747     my $update_type  = $params->{type};
 748     my $interface    = $params->{interface};
 749
 750     unless ( exists($Koha::Account::Line::allowed_update->{$update_type}) ) {
 751         Koha::Exceptions::Account::UnrecognisedType->throw(
 752             error => 'Update type not recognised'
 753         );
 754     }
 755
 756     my $debit_type_code = $self->debit_type_code;
 757     my $account_status  = $self->status;
 758     unless (
 759         (
 760             exists(
 761                 $Koha::Account::Line::allowed_update->{$update_type}
 762                   ->{$debit_type_code}
 763             )
 764             && ( $Koha::Account::Line::allowed_update->{$update_type}
 765                 ->{$debit_type_code} eq $account_status )
 766         )
 767       )
 768     {
 769         Koha::Exceptions::Account::UnrecognisedType->throw(
 770             error => 'Update type not allowed on this debit_type' );
 771     }
 772
 773     my $schema = Koha::Database->new->schema;
 774
 775     $schema->txn_do(
 776         sub {
 777
 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;
 782
 783             my $offset_type = $debit_type_code;
 784             $offset_type .= ( $difference > 0 ) ? "_INCREASE" : "_DECREASE";
 785
 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(
 791                     {
 792                         amount      => $new_outstanding * -1,
 793                         type        => 'OVERPAYMENT',
 794                         interface   => $interface,
 795                         ( $update_type eq 'overdue_update' ? ( item_id => $self->itemnumber ) : ()),
 796                     }
 797                 );
 798                 $new_outstanding = 0;
 799             }
 800
 801             # Update the account line
 802             $self->set(
 803                 {
 804                     date              => \'NOW()',
 805                     amount            => $amount,
 806                     amountoutstanding => $new_outstanding,
 807                 }
 808             )->store();
 809
 810             # Record the account offset
 811             my $account_offset = Koha::Account::Offset->new(
 812                 {
 813                     debit_id => $self->id,
 814                     type     => $offset_type,
 815                     amount   => $difference
 816                 }
 817             )->store();
 818
 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,
 833                         }
 834                     )
 835                 ) if ( $update_type eq 'overdue_update' );
 836             }
 837         }
 838     );
 839
 840     return $self;
 841 }
 842
 843 =head3 is_credit
 844
 845     my $bool = $line->is_credit;
 846
 847 =cut
 848
 849 sub is_credit {
 850     my ($self) = @_;
 851
 852     return defined $self->credit_type_code;
 853 }
 854
 855 =head3 is_debit
 856
 857     my $bool = $line->is_debit;
 858
 859 =cut
 860
 861 sub is_debit {
 862     my ($self) = @_;
 863
 864     return !$self->is_credit;
 865 }
 866
 867 =head3 to_api_mapping
 868
 869 This method returns the mapping for representing a Koha::Account::Line object
 870 on the API.
 871
 872 =cut
 873
 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',
 886     };
 887
 888 }
 889
 890 =head3 renewable
 891
 892     my $bool = $line->renewable;
 893
 894 =cut
 895
 896 sub renewable {
 897     my ($self) = @_;
 898
 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;
 906 }
 907
 908 =head3 renew_item
 909
 910     my $renew_result = $line->renew_item;
 911
 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
 914
 915 =cut
 916
 917 sub renew_item {
 918     my ($self, $params) = @_;
 919
 920     my $outcome = {};
 921
 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
 926     #
 927     # - The RenewAccruingItemInOpac syspref is off
 928     # AND
 929     # - There is an interface param passed and it's value is 'opac'
 930
 931     if (
 932         !C4::Context->preference('RenewAccruingItemWhenPaid') ||
 933         !$self->item ||
 934         !$self->patron ||
 935         (
 936             !C4::Context->preference('RenewAccruingItemInOpac') &&
 937             $params->{interface} &&
 938             $params->{interface} eq 'opac'
 939         )
 940     ) {
 941         return;
 942     }
 943
 944     my $itemnumber = $self->item->itemnumber;
 945     my $borrowernumber = $self->patron->borrowernumber;
 946     my ( $can_renew, $error ) = C4::Circulation::CanBookBeRenewed(
 947         $borrowernumber,
 948         $itemnumber
 949     );
 950     if ( $can_renew ) {
 951         my $due_date = C4::Circulation::AddRenewal(
 952             $borrowernumber,
 953             $itemnumber,
 954             $self->{branchcode},
 955             undef,
 956             undef,
 957             1
 958         );
 959         return {
 960             itemnumber => $itemnumber,
 961             due_date   => $due_date,
 962             success    => 1
 963         };
 964     } else {
 965         return {
 966             itemnumber => $itemnumber,
 967             error      => $error,
 968             success    => 0
 969         };
 970     }
 971
 972 }
 973
 974 =head3 store
 975
 976 Specific store method to generate credit number before saving
 977
 978 =cut
 979
 980 sub store {
 981     my ($self) = @_;
 982
 983     my $AutoCreditNumber = C4::Context->preference('AutoCreditNumber');
 984     my $credit_number_enabled = $self->is_credit && $self->credit_type->credit_number_enabled;
 985
 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');
 989         }
 990
 991         my $rs = Koha::Database->new->schema->resultset($self->_type);
 992
 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%" },
1009                 ],
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%" },
1026                     ],
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));
1031             }
1032         }
1033     }
1034
1035     return $self->SUPER::store();
1036 }
1037
1038 =head2 Internal methods
1039
1040 =cut
1041
1042 =head3 _type
1043
1044 =cut
1045
1046 sub _type {
1047     return 'Accountline';
1048 }
1049
1050 1;
1051
1052 =head2 Name mappings
1053
1054 =head3 $allowed_update
1055
1056 =cut
1057
1058 our $allowed_update = { 'overdue_update' => { 'OVERDUE' => 'UNRETURNED' } };
1059
1060 =head1 AUTHORS
1061
1062 Kyle M Hall <kyle@bywatersolutions.com >
1063 Tomás Cohen Arazi <tomascohen@theke.io>
1064 Martin Renvoize <martin.renvoize@ptfs-europe.com>
1065
1066 =cut