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 Data::Dumper qw( Dumper );
  21
  22 use C4::Log qw( logaction );
  23
  24 use Koha::Account::CreditType;
  25 use Koha::Account::DebitType;
  26 use Koha::Account::Offsets;
  27 use Koha::Database;
  28 use Koha::DateUtils qw( dt_from_string );
  29 use Koha::Exceptions::Account;
  30 use Koha::Items;
  31
  32 use base qw(Koha::Object Koha::Object::Mixin::AdditionalFields);
  33
  34 =encoding utf8
  35
  36 =head1 NAME
  37
  38 Koha::Account::Line - Koha accountline Object class
  39
  40 =head1 API
  41
  42 =head2 Class methods
  43
  44 =cut
  45
  46 =head3 patron
  47
  48 Return the patron linked to this account line
  49
  50 =cut
  51
  52 sub patron {
  53     my ( $self ) = @_;
  54     my $rs = $self->_result->borrowernumber;
  55     return unless $rs;
  56     return Koha::Patron->_new_from_dbic( $rs );
  57 }
  58
  59 =head3 manager
  60
  61 Return the manager linked to this account line
  62
  63 =cut
  64
  65 sub manager {
  66     my ( $self ) = @_;
  67     my $rs = $self->_result->manager;
  68     return unless $rs;
  69     return Koha::Patron->_new_from_dbic( $rs );
  70 }
  71
  72 =head3 item
  73
  74 Return the item linked to this account line if exists
  75
  76 =cut
  77
  78 sub item {
  79     my ( $self ) = @_;
  80     my $rs = $self->_result->itemnumber;
  81     return unless $rs;
  82     return Koha::Item->_new_from_dbic( $rs );
  83 }
  84
  85 =head3 checkout
  86
  87 Return the checkout linked to this account line if exists
  88
  89 =cut
  90
  91 sub checkout {
  92     my ($self) = @_;
  93     return unless $self->issue_id;
  94
  95     return Koha::Checkouts->find( $self->issue_id )
  96       || Koha::Old::Checkouts->find( $self->issue_id );
  97 }
  98
  99 =head3 library
 100
 101 Returns a Koha::Library object representing where the accountline was recorded
 102
 103 =cut
 104
 105 sub library {
 106     my ( $self ) = @_;
 107     my $rs = $self->_result->library;
 108     return unless $rs;
 109     return Koha::Library->_new_from_dbic($rs);
 110 }
 111
 112 =head3 credit_type
 113
 114 Return the credit_type linked to this account line
 115
 116 =cut
 117
 118 sub credit_type {
 119     my ( $self ) = @_;
 120     my $rs = $self->_result->credit_type_code;
 121     return unless $rs;
 122     return Koha::Account::CreditType->_new_from_dbic( $rs );
 123 }
 124
 125 =head3 debit_type
 126
 127 Return the debit_type linked to this account line
 128
 129 =cut
 130
 131 sub debit_type {
 132     my ( $self ) = @_;
 133     my $rs = $self->_result->debit_type_code;
 134     return unless $rs;
 135     return Koha::Account::DebitType->_new_from_dbic( $rs );
 136 }
 137
 138 =head3 credit_offsets
 139
 140 Return the credit_offsets linked to this account line if some exist
 141
 142 =cut
 143
 144 sub credit_offsets {
 145     my ( $self, $cond, $attr ) = @_;
 146
 147     unless ( $self->is_credit ) {
 148         Koha::Exceptions::Account::IsNotCredit->throw(
 149             error => 'Account line ' . $self->id . ' is not a credit'
 150         );
 151     }
 152
 153     my $rs = $self->_result->search_related( 'account_offsets_credits', $cond, $attr);
 154     return unless $rs;
 155     return Koha::Account::Offsets->_new_from_dbic($rs);
 156 }
 157
 158 =head3 debit_offsets
 159
 160 Return the debit_offsets linked to this account line if some exist
 161
 162 =cut
 163
 164 sub debit_offsets {
 165     my ( $self, $cond, $attr ) = @_;
 166
 167     unless ( $self->is_debit ) {
 168         Koha::Exceptions::Account::IsNotDebit->throw(
 169             error => 'Account line ' . $self->id . ' is not a debit'
 170         );
 171     }
 172
 173     my $rs = $self->_result->search_related( 'account_offsets_debits', $cond, $attr);
 174     return unless $rs;
 175     return Koha::Account::Offsets->_new_from_dbic($rs);
 176 }
 177
 178 =head3 credits
 179
 180   my $credits = $accountline->credits;
 181   my $credits = $accountline->credits( $cond, $attr );
 182
 183 Return the credits linked to this account line if some exist.
 184 Search conditions and attributes may be passed if you wish to filter
 185 the resultant resultant resultset.
 186
 187 =cut
 188
 189 sub credits {
 190     my ( $self, $cond, $attr ) = @_;
 191
 192     unless ( $self->is_debit ) {
 193         Koha::Exceptions::Account::IsNotDebit->throw(
 194             error => 'Account line ' . $self->id . ' is not a debit'
 195         );
 196     }
 197
 198     my $cond_m = { map { "credit.".$_ => $cond->{$_} } keys %{$cond}};
 199     my $rs =
 200       $self->_result->search_related('account_offsets_debits')
 201       ->search_related( 'credit', $cond_m, $attr );
 202     return unless $rs;
 203     return Koha::Account::Lines->_new_from_dbic($rs);
 204 }
 205
 206 =head3 debits
 207
 208   my $debits = $accountline->debits;
 209   my $debits = $accountline->debits( $cond, $attr );
 210
 211 Return the debits linked to this account line if some exist.
 212 Search conditions and attributes may be passed if you wish to filter
 213 the resultant resultant resultset.
 214
 215 =cut
 216
 217 sub debits {
 218     my ( $self, $cond, $attr ) = @_;
 219
 220     unless ( $self->is_credit ) {
 221         Koha::Exceptions::Account::IsNotCredit->throw(
 222             error => 'Account line ' . $self->id . ' is not a credit'
 223         );
 224     }
 225
 226     my $cond_m = { map { "debit.".$_ => $cond->{$_} } keys %{$cond}};
 227     my $rs =
 228       $self->_result->search_related('account_offsets_credits')
 229       ->search_related( 'debit', $cond_m, $attr );
 230     return unless $rs;
 231     return Koha::Account::Lines->_new_from_dbic($rs);
 232 }
 233
 234 =head3 void
 235
 236   $payment_accountline->void({
 237       interface => $interface,
 238       [ staff_id => $staff_id, branch => $branchcode ]
 239   });
 240
 241 Used to 'void' (or reverse) a payment/credit. It will roll back any offsets
 242 created by the application of this credit upon any debits and mark the credit
 243 as 'void' by updating it's status to "VOID".
 244
 245 =cut
 246
 247 sub void {
 248     my ($self, $params) = @_;
 249
 250     # Make sure it is a credit we are voiding
 251     unless ( $self->is_credit ) {
 252         Koha::Exceptions::Account::IsNotCredit->throw(
 253             error => 'Account line ' . $self->id . 'is not a credit' );
 254     }
 255
 256     # Make sure it is not already voided
 257     if ( $self->status && $self->status eq 'VOID' ) {
 258         Koha::Exceptions::Account->throw(
 259             error => 'Account line ' . $self->id . 'is already void' );
 260     }
 261
 262     # Check for mandatory parameters
 263     my @mandatory = ( 'interface' );
 264     for my $param (@mandatory) {
 265         unless ( defined( $params->{$param} ) ) {
 266             Koha::Exceptions::MissingParameter->throw(
 267                 error => "The $param parameter is mandatory" );
 268         }
 269     }
 270
 271     # More mandatory parameters
 272     if ( $params->{interface} eq 'intranet' ) {
 273         my @optional = ( 'staff_id', 'branch' );
 274         for my $param (@optional) {
 275             unless ( defined( $params->{$param} ) ) {
 276                 Koha::Exceptions::MissingParameter->throw( error =>
 277 "The $param parameter is mandatory when interface is set to 'intranet'"
 278                 );
 279             }
 280         }
 281     }
 282
 283     # Find any applied offsets for the credit so we may reverse them
 284     my @account_offsets =
 285       Koha::Account::Offsets->search(
 286         { credit_id => $self->id, amount => { '<' => 0 }  } )->as_list;
 287
 288     my $void;
 289     $self->_result->result_source->schema->txn_do(
 290         sub {
 291
 292             # A 'void' is a 'debit'
 293             $void = Koha::Account::Line->new(
 294                 {
 295                     borrowernumber    => $self->borrowernumber,
 296                     date              => \'NOW()',
 297                     debit_type_code   => 'VOID',
 298                     amount            => $self->amount * -1,
 299                     amountoutstanding => $self->amount * -1,
 300                     manager_id        => $params->{staff_id},
 301                     interface         => $params->{interface},
 302                     branchcode        => $params->{branch},
 303                 }
 304             )->store();
 305
 306             # Record the creation offset
 307             Koha::Account::Offset->new(
 308                 {
 309                     debit_id => $void->id,
 310                     type     => 'CREATE',
 311                     amount   => $self->amount * -1
 312                 }
 313             )->store();
 314
 315             # Link void to payment
 316             $self->set({
 317                 amountoutstanding => $self->amount,
 318                 status => 'VOID'
 319             })->store();
 320             $self->apply( { debits => [$void] } );
 321
 322             # Reverse any applied payments
 323             foreach my $account_offset (@account_offsets) {
 324                 my $fee_paid =
 325                   Koha::Account::Lines->find( $account_offset->debit_id );
 326
 327                 next unless $fee_paid;
 328
 329                 my $amount_paid = $account_offset->amount * -1; # amount paid is stored as a negative amount
 330                 my $new_amount = $fee_paid->amountoutstanding + $amount_paid;
 331                 $fee_paid->amountoutstanding($new_amount);
 332                 $fee_paid->store();
 333
 334                 Koha::Account::Offset->new(
 335                     {
 336                         credit_id => $self->id,
 337                         debit_id  => $fee_paid->id,
 338                         amount    => $amount_paid,
 339                         type      => 'VOID',
 340                     }
 341                 )->store();
 342             }
 343
 344             if ( C4::Context->preference("FinesLog") ) {
 345                 logaction(
 346                     "FINES", 'VOID',
 347                     $self->borrowernumber,
 348                     Dumper(
 349                         {
 350                             action         => 'void_payment',
 351                             borrowernumber => $self->borrowernumber,
 352                             amount            => $self->amount,
 353                             amountoutstanding => $self->amountoutstanding,
 354                             description       => $self->description,
 355                             credit_type_code  => $self->credit_type_code,
 356                             payment_type      => $self->payment_type,
 357                             note              => $self->note,
 358                             itemnumber        => $self->itemnumber,
 359                             manager_id        => $self->manager_id,
 360                             offsets =>
 361                               [ map { $_->unblessed } @account_offsets ],
 362                         }
 363                     )
 364                 );
 365             }
 366         }
 367     );
 368
 369     $void->discard_changes;
 370     return $void;
 371 }
 372
 373 =head3 cancel
 374
 375   $debit_accountline->cancel();
 376
 377 Cancel a charge. It will mark the debit as 'cancelled' by updating its
 378 status to 'CANCELLED'.
 379
 380 Charges that have been fully or partially paid cannot be cancelled.
 381
 382 Returns the cancellation accountline.
 383
 384 =cut
 385
 386 sub cancel {
 387     my ( $self, $params ) = @_;
 388
 389     # Make sure it is a charge we are reducing
 390     unless ( $self->is_debit ) {
 391         Koha::Exceptions::Account::IsNotDebit->throw(
 392             error => 'Account line ' . $self->id . 'is not a debit' );
 393     }
 394     if ( $self->debit_type_code eq 'PAYOUT' ) {
 395         Koha::Exceptions::Account::IsNotDebit->throw(
 396             error => 'Account line ' . $self->id . 'is a payout' );
 397     }
 398
 399     # Make sure it is not already cancelled
 400     if ( $self->status && $self->status eq 'CANCELLED' ) {
 401         Koha::Exceptions::Account->throw(
 402             error => 'Account line ' . $self->id . 'is already cancelled' );
 403     }
 404
 405     # Make sure it has not be paid yet
 406     if ( $self->amount != $self->amountoutstanding ) {
 407         Koha::Exceptions::Account->throw(
 408             error => 'Account line ' . $self->id . 'is already offset' );
 409     }
 410
 411     # Check for mandatory parameters
 412     my @mandatory = ( 'staff_id', 'branch' );
 413     for my $param (@mandatory) {
 414         unless ( defined( $params->{$param} ) ) {
 415             Koha::Exceptions::MissingParameter->throw(
 416                 error => "The $param parameter is mandatory" );
 417         }
 418     }
 419
 420     my $cancellation;
 421     $self->_result->result_source->schema->txn_do(
 422         sub {
 423
 424             # A 'cancellation' is a 'credit'
 425             $cancellation = Koha::Account::Line->new(
 426                 {
 427                     date              => \'NOW()',
 428                     amount            => 0 - $self->amount,
 429                     credit_type_code  => 'CANCELLATION',
 430                     status            => 'ADDED',
 431                     amountoutstanding => 0 - $self->amount,
 432                     manager_id        => $params->{staff_id},
 433                     borrowernumber    => $self->borrowernumber,
 434                     interface         => 'intranet',
 435                     branchcode        => $params->{branch},
 436                 }
 437             )->store();
 438
 439             my $cancellation_offset = Koha::Account::Offset->new(
 440                 {
 441                     credit_id => $cancellation->accountlines_id,
 442                     type      => 'CREATE',
 443                     amount    => 0 - $self->amount
 444                 }
 445             )->store();
 446
 447             # Link cancellation to charge
 448             $cancellation->apply( { debits => [$self] } );
 449             $cancellation->status('APPLIED')->store();
 450
 451             # Update status of original debit
 452             $self->status('CANCELLED')->store;
 453         }
 454     );
 455
 456     $cancellation->discard_changes;
 457     return $cancellation;
 458 }
 459
 460 =head3 reduce
 461
 462   $charge_accountline->reduce({
 463       reduction_type => $reduction_type
 464   });
 465
 466 Used to 'reduce' a charge/debit by adding a credit to offset against the amount
 467 outstanding.
 468
 469 May be used to apply a discount whilst retaining the original debit amounts or
 470 to apply a full or partial refund for example when a lost item is found and
 471 returned.
 472
 473 It will immediately be applied to the given debit unless the debit has already
 474 been paid, in which case a 'zero' offset will be added to maintain a link to
 475 the debit but the outstanding credit will be left so it may be applied to other
 476 debts.
 477
 478 Reduction type may be one of:
 479
 480 * REFUND
 481 * DISCOUNT
 482
 483 Returns the reduction accountline (which will be a credit)
 484
 485 =cut
 486
 487 sub reduce {
 488     my ( $self, $params ) = @_;
 489
 490     # Make sure it is a charge we are reducing
 491     unless ( $self->is_debit ) {
 492         Koha::Exceptions::Account::IsNotDebit->throw(
 493             error => 'Account line ' . $self->id . 'is not a debit' );
 494     }
 495     if ( $self->debit_type_code eq 'PAYOUT' ) {
 496         Koha::Exceptions::Account::IsNotDebit->throw(
 497             error => 'Account line ' . $self->id . 'is a payout' );
 498     }
 499
 500     # Check for mandatory parameters
 501     my @mandatory = ( 'interface', 'reduction_type', 'amount' );
 502     for my $param (@mandatory) {
 503         unless ( defined( $params->{$param} ) ) {
 504             Koha::Exceptions::MissingParameter->throw(
 505                 error => "The $param parameter is mandatory" );
 506         }
 507     }
 508
 509     # More mandatory parameters
 510     if ( $params->{interface} eq 'intranet' ) {
 511         my @optional = ( 'staff_id', 'branch' );
 512         for my $param (@optional) {
 513             unless ( defined( $params->{$param} ) ) {
 514                 Koha::Exceptions::MissingParameter->throw( error =>
 515 "The $param parameter is mandatory when interface is set to 'intranet'"
 516                 );
 517             }
 518         }
 519     }
 520
 521     # Make sure the reduction isn't more than the original
 522     my $original = $self->amount;
 523     Koha::Exceptions::Account::AmountNotPositive->throw(
 524         error => 'Reduce amount passed is not positive' )
 525       unless ( $params->{amount} > 0 );
 526     Koha::Exceptions::ParameterTooHigh->throw( error =>
 527 "Amount to reduce ($params->{amount}) is higher than original amount ($original)"
 528     ) unless ( $original >= $params->{amount} );
 529     my $reduced =
 530       $self->credits( { credit_type_code => [ 'DISCOUNT', 'REFUND' ] } )->total;
 531     Koha::Exceptions::ParameterTooHigh->throw( error =>
 532 "Combined reduction ($params->{amount} + $reduced) is higher than original amount ("
 533           . abs($original)
 534           . ")" )
 535       unless ( $original >= ( $params->{amount} + abs($reduced) ) );
 536
 537     my $status = { 'REFUND' => 'REFUNDED', 'DISCOUNT' => 'DISCOUNTED' };
 538
 539     my $reduction;
 540     $self->_result->result_source->schema->txn_do(
 541         sub {
 542
 543             # A 'reduction' is a 'credit'
 544             $reduction = Koha::Account::Line->new(
 545                 {
 546                     date              => \'NOW()',
 547                     amount            => 0 - $params->{amount},
 548                     credit_type_code  => $params->{reduction_type},
 549                     status            => 'ADDED',
 550                     amountoutstanding => 0 - $params->{amount},
 551                     manager_id        => $params->{staff_id},
 552                     borrowernumber    => $self->borrowernumber,
 553                     interface         => $params->{interface},
 554                     branchcode        => $params->{branch},
 555                 }
 556             )->store();
 557
 558             my $reduction_offset = Koha::Account::Offset->new(
 559                 {
 560                     credit_id => $reduction->accountlines_id,
 561                     type      => 'CREATE',
 562                     amount    => 0 - $params->{amount}
 563                 }
 564             )->store();
 565
 566             # Link reduction to charge (and apply as required)
 567             my $debit_outstanding = $self->amountoutstanding;
 568             if ( $debit_outstanding >= $params->{amount} ) {
 569
 570                 $reduction->apply( { debits => [$self] } );
 571                 $reduction->status('APPLIED')->store();
 572             }
 573             else {
 574
 575                 # Zero amount offset used to link original 'debit' to
 576                 # reduction 'credit'
 577                 my $link_reduction_offset = Koha::Account::Offset->new(
 578                     {
 579                         credit_id => $reduction->accountlines_id,
 580                         debit_id  => $self->accountlines_id,
 581                         type      => 'APPLY',
 582                         amount    => 0
 583                     }
 584                 )->store();
 585             }
 586
 587             # Update status of original debit
 588             $self->status( $status->{ $params->{reduction_type} } )->store;
 589         }
 590     );
 591
 592     $reduction->discard_changes;
 593     return $reduction;
 594 }
 595
 596 =head3 apply
 597
 598     my $debits = $account->outstanding_debits;
 599     my $credit = $credit->apply( { debits => $debits } );
 600
 601 Applies the credit to a given debits array reference.
 602
 603 =head4 arguments hashref
 604
 605 =over 4
 606
 607 =item debits - Koha::Account::Lines object set of debits
 608
 609 =back
 610
 611 =cut
 612
 613 sub apply {
 614     my ( $self, $params ) = @_;
 615
 616     my $debits      = $params->{debits};
 617
 618     unless ( $self->is_credit ) {
 619         Koha::Exceptions::Account::IsNotCredit->throw(
 620             error => 'Account line ' . $self->id . ' is not a credit'
 621         );
 622     }
 623
 624     my $available_credit = $self->amountoutstanding * -1;
 625
 626     unless ( $available_credit > 0 ) {
 627         Koha::Exceptions::Account::NoAvailableCredit->throw(
 628             error => 'Outstanding credit is ' . $available_credit . ' and cannot be applied'
 629         );
 630     }
 631
 632     my $schema = Koha::Database->new->schema;
 633
 634     $schema->txn_do( sub {
 635         for my $debit ( @{$debits} ) {
 636
 637             unless ( $debit->is_debit ) {
 638                 Koha::Exceptions::Account::IsNotDebit->throw(
 639                     error => 'Account line ' . $debit->id . 'is not a debit'
 640                 );
 641             }
 642             my $amount_to_cancel;
 643             my $owed = $debit->amountoutstanding;
 644
 645             if ( $available_credit >= $owed ) {
 646                 $amount_to_cancel = $owed;
 647             }
 648             else {    # $available_credit < $debit->amountoutstanding
 649                 $amount_to_cancel = $available_credit;
 650             }
 651
 652             # record the account offset
 653             Koha::Account::Offset->new(
 654                 {   credit_id => $self->id,
 655                     debit_id  => $debit->id,
 656                     amount    => $amount_to_cancel * -1,
 657                     type      => 'APPLY'
 658                 }
 659             )->store();
 660
 661             $available_credit -= $amount_to_cancel;
 662
 663             $self->amountoutstanding( $available_credit * -1 )->store;
 664             $debit->amountoutstanding( $owed - $amount_to_cancel )->store;
 665
 666             # Attempt to renew the item associated with this debit if
 667             # appropriate
 668             if ( $self->credit_type_code ne 'FORGIVEN' && $debit->is_renewable ) {
 669                 my $outcome = $debit->renew_item( { interface => $params->{interface} } );
 670                 $self->add_message(
 671                     {
 672                         type    => 'info',
 673                         message => 'renewal',
 674                         payload => $outcome
 675                     }
 676                 ) if $outcome;
 677             }
 678             $debit->discard_changes; # Refresh values from DB to clear floating point remainders
 679
 680             # Same logic exists in Koha::Account::pay
 681             if (
 682                 C4::Context->preference('MarkLostItemsAsReturned') =~
 683                 m|onpayment|
 684                 && $debit->debit_type_code
 685                 && $debit->debit_type_code eq 'LOST'
 686                 && $debit->amountoutstanding == 0
 687                 && $debit->itemnumber
 688                 && !(
 689                        $self->credit_type_code eq 'LOST_FOUND'
 690                     && $self->itemnumber == $debit->itemnumber
 691                 )
 692               )
 693             {
 694                 C4::Circulation::ReturnLostItem( $self->borrowernumber,
 695                     $debit->itemnumber );
 696             }
 697
 698             last if $available_credit == 0;
 699         }
 700     });
 701
 702     return $self;
 703 }
 704
 705 =head3 payout
 706
 707   $credit_accountline->payout(
 708     {
 709         payout_type => $payout_type,
 710         register_id => $register_id,
 711         staff_id    => $staff_id,
 712         interface   => 'intranet',
 713         amount      => $amount
 714     }
 715   );
 716
 717 Used to 'pay out' a credit to a user.
 718
 719 Payout type may be one of any existing payment types
 720
 721 Returns the payout debit line that is created via this transaction.
 722
 723 =cut
 724
 725 sub payout {
 726     my ( $self, $params ) = @_;
 727
 728     # Make sure it is a credit we are paying out
 729     unless ( $self->is_credit ) {
 730         Koha::Exceptions::Account::IsNotCredit->throw(
 731             error => 'Account line ' . $self->id . ' is not a credit' );
 732     }
 733
 734     # Check for mandatory parameters
 735     my @mandatory =
 736       ( 'interface', 'staff_id', 'branch', 'payout_type', 'amount' );
 737     for my $param (@mandatory) {
 738         unless ( defined( $params->{$param} ) ) {
 739             Koha::Exceptions::MissingParameter->throw(
 740                 error => "The $param parameter is mandatory" );
 741         }
 742     }
 743
 744     # Make sure there is outstanding credit to pay out
 745     my $outstanding = -1 * $self->amountoutstanding;
 746     my $amount =
 747       $params->{amount} ? $params->{amount} : $outstanding;
 748     Koha::Exceptions::Account::AmountNotPositive->throw(
 749         error => 'Payout amount passed is not positive' )
 750       unless ( $amount > 0 );
 751     Koha::Exceptions::ParameterTooHigh->throw(
 752         error => "Amount to payout ($amount) is higher than amountoutstanding ($outstanding)" )
 753       unless ($outstanding >= $amount );
 754
 755     # Make sure we record the cash register for cash transactions
 756     Koha::Exceptions::Account::RegisterRequired->throw()
 757       if ( C4::Context->preference("UseCashRegisters")
 758         && defined( $params->{payout_type} )
 759         && ( $params->{payout_type} eq 'CASH' || $params->{payout_type} eq 'SIP00' )
 760         && !defined( $params->{cash_register} ) );
 761
 762     my $payout;
 763     $self->_result->result_source->schema->txn_do(
 764         sub {
 765
 766             # A 'payout' is a 'debit'
 767             $payout = Koha::Account::Line->new(
 768                 {
 769                     date              => \'NOW()',
 770                     amount            => $amount,
 771                     debit_type_code   => 'PAYOUT',
 772                     payment_type      => $params->{payout_type},
 773                     amountoutstanding => $amount,
 774                     manager_id        => $params->{staff_id},
 775                     borrowernumber    => $self->borrowernumber,
 776                     interface         => $params->{interface},
 777                     branchcode        => $params->{branch},
 778                     register_id       => $params->{cash_register}
 779                 }
 780             )->store();
 781
 782             my $payout_offset = Koha::Account::Offset->new(
 783                 {
 784                     debit_id => $payout->accountlines_id,
 785                     type     => 'CREATE',
 786                     amount   => $amount
 787                 }
 788             )->store();
 789
 790             $self->apply( { debits => [$payout] } );
 791             $self->status('PAID')->store;
 792         }
 793     );
 794
 795     $payout->discard_changes;
 796     return $payout;
 797 }
 798
 799 =head3 adjust
 800
 801 This method allows updating a debit or credit on a patron's account
 802
 803     $account_line->adjust(
 804         {
 805             amount    => $amount,
 806             type      => $update_type,
 807             interface => $interface
 808         }
 809     );
 810
 811 $update_type can be any of:
 812   - overdue_update
 813
 814 Authors Note: The intention here is that this method is only used
 815 to adjust accountlines where the final amount is not yet known/fixed.
 816 Incrementing fines are the only existing case at the time of writing,
 817 all other forms of 'adjustment' should be recorded as distinct credits
 818 or debits and applied, via an offset, to the corresponding debit or credit.
 819
 820 =cut
 821
 822 sub adjust {
 823     my ( $self, $params ) = @_;
 824
 825     my $amount       = $params->{amount};
 826     my $update_type  = $params->{type};
 827     my $interface    = $params->{interface};
 828
 829     unless ( exists($Koha::Account::Line::allowed_update->{$update_type}) ) {
 830         Koha::Exceptions::Account::UnrecognisedType->throw(
 831             error => 'Update type not recognised'
 832         );
 833     }
 834
 835     my $debit_type_code = $self->debit_type_code;
 836     my $account_status  = $self->status;
 837     unless (
 838         (
 839             exists(
 840                 $Koha::Account::Line::allowed_update->{$update_type}
 841                   ->{$debit_type_code}
 842             )
 843             && ( $Koha::Account::Line::allowed_update->{$update_type}
 844                 ->{$debit_type_code} eq $account_status )
 845         )
 846       )
 847     {
 848         Koha::Exceptions::Account::UnrecognisedType->throw(
 849             error => 'Update type not allowed on this debit_type' );
 850     }
 851
 852     my $schema = Koha::Database->new->schema;
 853
 854     $schema->txn_do(
 855         sub {
 856
 857             my $amount_before             = $self->amount;
 858             my $amount_outstanding_before = $self->amountoutstanding;
 859             my $difference                = $amount - $amount_before;
 860             my $new_outstanding           = $amount_outstanding_before + $difference;
 861
 862             my $offset_type = $debit_type_code;
 863             $offset_type .= ( $difference > 0 ) ? "_INCREASE" : "_DECREASE";
 864
 865             # Catch cases that require patron refunds
 866             if ( $new_outstanding < 0 ) {
 867                 my $account =
 868                   Koha::Patrons->find( $self->borrowernumber )->account;
 869                 my $credit = $account->add_credit(
 870                     {
 871                         amount      => $new_outstanding * -1,
 872                         type        => 'OVERPAYMENT',
 873                         interface   => $interface,
 874                         ( $update_type eq 'overdue_update' ? ( item_id => $self->itemnumber ) : ()),
 875                     }
 876                 );
 877                 $new_outstanding = 0;
 878             }
 879
 880             # Update the account line
 881             $self->set(
 882                 {
 883                     date              => \'NOW()',
 884                     amount            => $amount,
 885                     amountoutstanding => $new_outstanding,
 886                 }
 887             )->store();
 888
 889             # Record the account offset
 890             my $account_offset = Koha::Account::Offset->new(
 891                 {
 892                     debit_id => $self->id,
 893                     type     => $offset_type,
 894                     amount   => $difference
 895                 }
 896             )->store();
 897
 898             if ( C4::Context->preference("FinesLog") ) {
 899                 logaction(
 900                     "FINES", 'UPDATE', #undef becomes UPDATE in UpdateFine
 901                     $self->borrowernumber,
 902                     Dumper(
 903                         {   action            => $update_type,
 904                             borrowernumber    => $self->borrowernumber,
 905                             amount            => $amount,
 906                             description       => undef,
 907                             amountoutstanding => $new_outstanding,
 908                             debit_type_code   => $self->debit_type_code,
 909                             note              => undef,
 910                             itemnumber        => $self->itemnumber,
 911                             manager_id        => undef,
 912                         }
 913                     )
 914                 ) if ( $update_type eq 'overdue_update' );
 915             }
 916         }
 917     );
 918
 919     return $self;
 920 }
 921
 922 =head3 is_credit
 923
 924     my $bool = $line->is_credit;
 925
 926 =cut
 927
 928 sub is_credit {
 929     my ($self) = @_;
 930
 931     return defined $self->credit_type_code;
 932 }
 933
 934 =head3 is_debit
 935
 936     my $bool = $line->is_debit;
 937
 938 =cut
 939
 940 sub is_debit {
 941     my ($self) = @_;
 942
 943     return !$self->is_credit;
 944 }
 945
 946 =head3 to_api_mapping
 947
 948 This method returns the mapping for representing a Koha::Account::Line object
 949 on the API.
 950
 951 =cut
 952
 953 sub to_api_mapping {
 954     return {
 955         accountlines_id   => 'account_line_id',
 956         credit_type_code  => 'credit_type',
 957         debit_type_code   => 'debit_type',
 958         amountoutstanding => 'amount_outstanding',
 959         borrowernumber    => 'patron_id',
 960         branchcode        => 'library_id',
 961         issue_id          => 'checkout_id',
 962         itemnumber        => 'item_id',
 963         manager_id        => 'user_id',
 964         note              => 'internal_note',
 965         register_id       => 'cash_register_id',
 966     };
 967
 968 }
 969
 970 =head3 is_renewable
 971
 972     my $bool = $line->is_renewable;
 973
 974 =cut
 975
 976 sub is_renewable {
 977     my ($self) = @_;
 978
 979     return (
 980         $self->amountoutstanding == 0 &&
 981         $self->debit_type_code &&
 982         $self->debit_type_code eq 'OVERDUE' &&
 983         $self->status &&
 984         $self->status eq 'UNRETURNED' &&
 985         $self->item &&
 986         $self->patron
 987     ) ? 1 : 0;
 988 }
 989
 990 =head3 renew_item
 991
 992     my $renew_result = $line->renew_item;
 993
 994 Conditionally attempt to renew an item and return the outcome. This is
 995 as a consequence of the fine on an item being fully paid off.
 996 Caller must call is_renewable before.
 997
 998 =cut
 999
1000 sub renew_item {
1001     my ($self, $params) = @_;
1002
1003     my $outcome = {};
1004
1005     # We want to reject the call to renew if:
1006     # - The RenewAccruingItemWhenPaid syspref is off
1007     # OR
1008     # - The RenewAccruingItemInOpac syspref is off
1009     # - There is an interface param passed and it's value is 'opac'
1010
1011     if (
1012         !C4::Context->preference('RenewAccruingItemWhenPaid') ||
1013         (
1014             !C4::Context->preference('RenewAccruingItemInOpac') &&
1015             $params->{interface} &&
1016             $params->{interface} eq 'opac'
1017         )
1018     ) {
1019         return;
1020     }
1021
1022     my $itemnumber = $self->item->itemnumber;
1023     my ( $can_renew, $error ) = C4::Circulation::CanBookBeRenewed(
1024         $self->patron,
1025         $self->item->checkout
1026     );
1027     if ( $can_renew ) {
1028         my $borrowernumber = $self->patron->borrowernumber;
1029         my $due_date = C4::Circulation::AddRenewal(
1030             $borrowernumber,
1031             $itemnumber,
1032             $self->{branchcode},
1033             undef,
1034             undef,
1035             undef,
1036             0
1037         );
1038         return {
1039             itemnumber => $itemnumber,
1040             due_date   => $due_date,
1041             success    => 1
1042         };
1043     } else {
1044         return {
1045             itemnumber => $itemnumber,
1046             error      => $error,
1047             success    => 0
1048         };
1049     }
1050
1051 }
1052
1053 =head3 store
1054
1055 Specific store method to generate credit number before saving
1056
1057 =cut
1058
1059 sub store {
1060     my ($self) = @_;
1061
1062     my $AutoCreditNumber = C4::Context->preference('AutoCreditNumber');
1063     my $credit_number_enabled = $self->is_credit && $self->credit_type->credit_number_enabled;
1064
1065     if ($AutoCreditNumber && $credit_number_enabled && !$self->in_storage) {
1066         if (defined $self->credit_number) {
1067             Koha::Exceptions::Account->throw('AutoCreditNumber is enabled but credit_number is already defined');
1068         }
1069
1070         my $rs = Koha::Database->new->schema->resultset($self->_type);
1071
1072         if ($AutoCreditNumber eq 'incremental') {
1073             my $max = $rs->search({
1074                 credit_number => { -regexp => '^[0-9]+$' }
1075             }, {
1076                 select => \'CAST(credit_number AS UNSIGNED)',
1077                 as => ['credit_number'],
1078             })->get_column('credit_number')->max;
1079             $max //= 0;
1080             $self->credit_number($max + 1);
1081         } elsif ($AutoCreditNumber eq 'annual') {
1082             my $now = dt_from_string;
1083             my $prefix = sprintf('%d-', $now->year);
1084             my $max = $rs->search({
1085                 -and => [
1086                     credit_number => { -regexp => '[0-9]{4}$' },
1087                     credit_number => { -like => "$prefix%" },
1088                 ],
1089             })->get_column('credit_number')->max;
1090             $max //= $prefix . '0000';
1091             my $incr = substr($max, length $prefix);
1092             $self->credit_number(sprintf('%s%04d', $prefix, $incr + 1));
1093         } elsif ($AutoCreditNumber eq 'branchyyyymmincr') {
1094             my $userenv = C4::Context->userenv;
1095             if ($userenv) {
1096                 my $branch = $userenv->{branch};
1097                 my $now = dt_from_string;
1098                 my $prefix = sprintf('%s%d%02d', $branch, $now->year, $now->month);
1099                 my $pattern = $prefix;
1100                 $pattern =~ s/([\?%_])/\\$1/g;
1101                 my $max = $rs->search({
1102                     -and => [
1103                         credit_number => { -regexp => '[0-9]{4}$' },
1104                         credit_number => { -like => "$pattern%" },
1105                     ],
1106                 })->get_column('credit_number')->max;
1107                 $max //= $prefix . '0000';
1108                 my $incr = substr($max, length $prefix);
1109                 $self->credit_number(sprintf('%s%04d', $prefix, $incr + 1));
1110             }
1111         }
1112     }
1113
1114     return $self->SUPER::store();
1115 }
1116
1117 =head2 Internal methods
1118
1119 =cut
1120
1121 =head3 _type
1122
1123 =cut
1124
1125 sub _type {
1126     return 'Accountline';
1127 }
1128
1129 1;
1130
1131 =head2 Name mappings
1132
1133 =head3 $allowed_update
1134
1135 =cut
1136
1137 our $allowed_update = { 'overdue_update' => { 'OVERDUE' => 'UNRETURNED' } };
1138
1139 =head1 AUTHORS
1140
1141 Kyle M Hall <kyle@bywatersolutions.com >
1142 Tomás Cohen Arazi <tomascohen@theke.io>
1143 Martin Renvoize <martin.renvoize@ptfs-europe.com>
1144
1145 =cut