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