FS/FS/cust_pay.pm

   1 package FS::cust_pay;
   2
   3 use strict;
   4 use base qw( FS::otaker_Mixin FS::payinfo_transaction_Mixin FS::cust_main_Mixin
   5              FS::Record );
   6 use vars qw( $DEBUG $me $conf @encrypted_fields
   7              $unsuspendauto $ignore_noapply
   8            );
   9 use Date::Format;
  10 use Business::CreditCard;
  11 use Text::Template;
  12 use FS::Misc::DateTime qw( parse_datetime ); #for batch_import
  13 use FS::Record qw( dbh qsearch qsearchs );
  14 use FS::UID qw( driver_name );
  15 use FS::CurrentUser;
  16 use FS::payby;
  17 use FS::cust_main_Mixin;
  18 use FS::payinfo_transaction_Mixin;
  19 use FS::cust_bill;
  20 use FS::cust_bill_pay;
  21 use FS::cust_pay_refund;
  22 use FS::cust_main;
  23 use FS::cust_pkg;
  24 use FS::cust_pay_void;
  25 use FS::upgrade_journal;
  26 use FS::Cursor;
  27
  28 $DEBUG = 0;
  29
  30 $me = '[FS::cust_pay]';
  31
  32 $ignore_noapply = 0;
  33
  34 #ask FS::UID to run this stuff for us later
  35 FS::UID->install_callback( sub {
  36   $conf = new FS::Conf;
  37   $unsuspendauto = $conf->exists('unsuspendauto');
  38 } );
  39
  40 @encrypted_fields = ('payinfo');
  41 sub nohistory_fields { ('payinfo'); }
  42
  43 =head1 NAME
  44
  45 FS::cust_pay - Object methods for cust_pay objects
  46
  47 =head1 SYNOPSIS
  48
  49   use FS::cust_pay;
  50
  51   $record = new FS::cust_pay \%hash;
  52   $record = new FS::cust_pay { 'column' => 'value' };
  53
  54   $error = $record->insert;
  55
  56   $error = $new_record->replace($old_record);
  57
  58   $error = $record->delete;
  59
  60   $error = $record->check;
  61
  62 =head1 DESCRIPTION
  63
  64 An FS::cust_pay object represents a payment; the transfer of money from a
  65 customer.  FS::cust_pay inherits from FS::Record.  The following fields are
  66 currently supported:
  67
  68 =over 4
  69
  70 =item paynum
  71
  72 primary key (assigned automatically for new payments)
  73
  74 =item custnum
  75
  76 customer (see L<FS::cust_main>)
  77
  78 =item _date
  79
  80 specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
  81 L<Time::Local> and L<Date::Parse> for conversion functions.
  82
  83 =item paid
  84
  85 Amount of this payment
  86
  87 =item usernum
  88
  89 order taker (see L<FS::access_user>)
  90
  91 =item payby
  92
  93 Payment Type (See L<FS::payinfo_Mixin> for valid values)
  94
  95 =item payinfo
  96
  97 Payment Information (See L<FS::payinfo_Mixin> for data format)
  98
  99 =item paymask
 100
 101 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
 102
 103 =item paybatch
 104
 105 obsolete text field for tracking card processing or other batch grouping
 106
 107 =item payunique
 108
 109 Optional unique identifer to prevent duplicate transactions.
 110
 111 =item closed
 112
 113 books closed flag, empty or `Y'
 114
 115 =item pkgnum
 116
 117 Desired pkgnum when using experimental package balances.
 118
 119 =item no_auto_apply
 120
 121 Flag to only allow manual application of payment, empty or 'Y'
 122
 123 =item bank
 124
 125 The bank where the payment was deposited.
 126
 127 =item depositor
 128
 129 The name of the depositor.
 130
 131 =item account
 132
 133 The deposit account number.
 134
 135 =item teller
 136
 137 The teller number.
 138
 139 =item batchnum
 140
 141 The number of the batch this payment came from (see L<FS::pay_batch>),
 142 or null if it was processed through a realtime gateway or entered manually.
 143
 144 =item gatewaynum
 145
 146 The number of the realtime or batch gateway L<FS::payment_gateway>) this
 147 payment was processed through.  Null if it was entered manually or processed
 148 by the "system default" gateway, which doesn't have a number.
 149
 150 =item processor
 151
 152 The name of the processor module (Business::OnlinePayment, ::BatchPayment,
 153 or ::OnlineThirdPartyPayment subclass) used for this payment.  Slightly
 154 redundant with C<gatewaynum>.
 155
 156 =item auth
 157
 158 The authorization number returned by the credit card network.
 159
 160 =item order_number
 161
 162 The transaction ID returned by the gateway, if any.  This is usually what
 163 you would use to initiate a void or refund of the payment.
 164
 165 =back
 166
 167 =head1 METHODS
 168
 169 =over 4
 170
 171 =item new HASHREF
 172
 173 Creates a new payment.  To add the payment to the databse, see L<"insert">.
 174
 175 =cut
 176
 177 sub table { 'cust_pay'; }
 178 sub cust_linked { $_[0]->cust_main_custnum || $_[0]->custnum; }
 179 sub cust_unlinked_msg {
 180   my $self = shift;
 181   "WARNING: can't find cust_main.custnum ". $self->custnum.
 182   ' (cust_pay.paynum '. $self->paynum. ')';
 183 }
 184
 185 =item insert [ OPTION => VALUE ... ]
 186
 187 Adds this payment to the database.
 188
 189 For backwards-compatibility and convenience, if the additional field invnum
 190 is defined, an FS::cust_bill_pay record for the full amount of the payment
 191 will be created.  In this case, custnum is optional.
 192
 193 If the additional field discount_term is defined then a prepayment discount
 194 is taken for that length of time.  It is an error for the customer to owe
 195 after this payment is made.
 196
 197 A hash of optional arguments may be passed.  The following arguments are
 198 supported:
 199
 200 =over 4
 201
 202 =item manual
 203
 204 If true, a payment receipt is sent instead of a statement when
 205 'payment_receipt_email' configuration option is set.
 206
 207 About the "manual" flag: Normally, if the 'payment_receipt' config option
 208 is set, and the customer has an invoice email address, inserting a payment
 209 causes a I<statement> to be emailed to the customer.  If the payment is
 210 considered "manual" (or if the customer has no invoices), then it will
 211 instead send a I<payment receipt>.  "manual" should be true whenever a
 212 payment is created directly from the web interface, from a user-initiated
 213 realtime payment, or from a third-party payment via self-service.  It should
 214 be I<false> when creating a payment from a billing event or from a batch.
 215
 216 =item noemail
 217
 218 Don't send an email receipt.  (Note: does not currently work when
 219 payment_receipt-trigger is set to something other than default / cust_bill)
 220
 221 =back
 222
 223 =cut
 224
 225 sub insert {
 226   my($self, %options) = @_;
 227
 228   local $SIG{HUP} = 'IGNORE';
 229   local $SIG{INT} = 'IGNORE';
 230   local $SIG{QUIT} = 'IGNORE';
 231   local $SIG{TERM} = 'IGNORE';
 232   local $SIG{TSTP} = 'IGNORE';
 233   local $SIG{PIPE} = 'IGNORE';
 234
 235   my $oldAutoCommit = $FS::UID::AutoCommit;
 236   local $FS::UID::AutoCommit = 0;
 237   my $dbh = dbh;
 238
 239   my $cust_bill;
 240   if ( $self->invnum ) {
 241     $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
 242       or do {
 243         $dbh->rollback if $oldAutoCommit;
 244         return "Unknown cust_bill.invnum: ". $self->invnum;
 245       };
 246     if ($self->custnum && ($cust_bill->custnum ne $self->custnum)) {
 247       $dbh->rollback if $oldAutoCommit;
 248       return "Invoice custnum ".$cust_bill->custnum
 249         ." does not match specified custnum ".$self->custnum
 250         ." for invoice ".$self->invnum;
 251     }
 252     $self->custnum($cust_bill->custnum );
 253   }
 254
 255   my $error = $self->check;
 256   return $error if $error;
 257
 258   my $cust_main = $self->cust_main;
 259   my $old_balance = $cust_main->balance;
 260
 261   $error = $self->SUPER::insert;
 262   if ( $error ) {
 263     $dbh->rollback if $oldAutoCommit;
 264     return "error inserting cust_pay: $error";
 265   }
 266
 267   if ( my $credit_type = $conf->config('prepayment_discounts-credit_type') ) {
 268     if ( my $months = $self->discount_term ) {
 269       # XXX this should be moved out somewhere, but discount_term_values
 270       # doesn't fit right
 271       my ($cust_bill) = ($cust_main->cust_bill)[-1]; # most recent invoice
 272       return "can't accept prepayment for an unbilled customer" if !$cust_bill;
 273
 274       # %billing_pkgs contains this customer's active monthly packages.
 275       # Recurring fees for those packages will be credited and then rebilled
 276       # for the full discount term.  Other packages on the last invoice
 277       # (canceled, non-monthly recurring, or one-time charges) will be
 278       # left as they are.
 279       my %billing_pkgs = map { $_->pkgnum => $_ }
 280                          grep { $_->part_pkg->freq eq '1' }
 281                          $cust_main->billing_pkgs;
 282       my $credit = 0; # sum of recurring charges from that invoice
 283       my $last_bill_date = 0; # the real bill date
 284       foreach my $item ( $cust_bill->cust_bill_pkg ) {
 285         next if !exists($billing_pkgs{$item->pkgnum}); # skip inactive packages
 286         $credit += $item->recur;
 287         $last_bill_date = $item->cust_pkg->last_bill
 288           if defined($item->cust_pkg)
 289             and $item->cust_pkg->last_bill > $last_bill_date
 290       }
 291
 292       my $cust_credit = new FS::cust_credit {
 293         'custnum' => $self->custnum,
 294         'amount'  => sprintf('%.2f', $credit),
 295         'reason'  => 'customer chose to prepay for discount',
 296       };
 297       $error = $cust_credit->insert('reason_type' => $credit_type);
 298       if ( $error ) {
 299         $dbh->rollback if $oldAutoCommit;
 300         return "error inserting prepayment credit: $error";
 301       }
 302       # don't apply it yet
 303
 304       # bill for the entire term
 305       $_->bill($_->last_bill) foreach (values %billing_pkgs);
 306       $error = $cust_main->bill(
 307         # no recurring_only, we want unbilled packages with start dates to
 308         # get billed
 309         'no_usage_reset' => 1,
 310         'time'           => $last_bill_date, # not $cust_bill->_date
 311         'pkg_list'       => [ values %billing_pkgs ],
 312         'freq_override'  => $months,
 313       );
 314       if ( $error ) {
 315         $dbh->rollback if $oldAutoCommit;
 316         return "error inserting cust_pay: $error";
 317       }
 318       $error = $cust_main->apply_payments_and_credits;
 319       if ( $error ) {
 320         $dbh->rollback if $oldAutoCommit;
 321         return "error inserting cust_pay: $error";
 322       }
 323       my $new_balance = $cust_main->balance;
 324       if ($new_balance > 0) {
 325         $dbh->rollback if $oldAutoCommit;
 326         return "balance after prepay discount attempt: $new_balance";
 327       }
 328       # user friendly: override the "apply only to this invoice" mode
 329       $self->invnum('');
 330
 331     }
 332
 333   }
 334
 335   if ( $self->invnum ) {
 336     my $cust_bill_pay = new FS::cust_bill_pay {
 337       'invnum' => $self->invnum,
 338       'paynum' => $self->paynum,
 339       'amount' => $self->paid,
 340       '_date'  => $self->_date,
 341     };
 342     $error = $cust_bill_pay->insert(%options);
 343     if ( $error ) {
 344       if ( $ignore_noapply ) {
 345         warn "warning: error inserting cust_bill_pay: $error ".
 346              "(ignore_noapply flag set; inserting cust_pay record anyway)\n";
 347       } else {
 348         $dbh->rollback if $oldAutoCommit;
 349         return "error inserting cust_bill_pay: $error";
 350       }
 351     }
 352   }
 353
 354   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 355
 356   #false laziness w/ cust_credit::insert
 357   if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
 358     my @errors = $cust_main->unsuspend;
 359     #return
 360     # side-fx with nested transactions?  upstack rolls back?
 361     warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
 362          join(' / ', @errors)
 363       if @errors;
 364   }
 365   #eslaf
 366
 367   #bill setup fees for voip_cdr bill_every_call packages
 368   #some false laziness w/search in freeside-cdrd
 369   my $addl_from =
 370     'LEFT JOIN part_pkg USING ( pkgpart ) '.
 371     "LEFT JOIN part_pkg_option
 372        ON ( cust_pkg.pkgpart = part_pkg_option.pkgpart
 373             AND part_pkg_option.optionname = 'bill_every_call' )";
 374
 375   my $extra_sql = " AND plan = 'voip_cdr' AND optionvalue = '1' ".
 376                   " AND ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 ) ";
 377
 378   my @cust_pkg = qsearch({
 379     'table'     => 'cust_pkg',
 380     'addl_from' => $addl_from,
 381     'hashref'   => { 'custnum' => $self->custnum,
 382                      'susp'    => '',
 383                      'cancel'  => '',
 384                    },
 385     'extra_sql' => $extra_sql,
 386   });
 387
 388   if ( @cust_pkg ) {
 389     warn "voip_cdr bill_every_call packages found; billing customer\n";
 390     my $bill_error = $self->cust_main->bill_and_collect( 'fatal' => 'return' );
 391     if ( $bill_error ) {
 392       warn "WARNING: Error billing customer: $bill_error\n";
 393     }
 394   }
 395   #end of billing setup fees for voip_cdr bill_every_call packages
 396
 397   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 398
 399   #payment receipt
 400   my $trigger = $conf->config('payment_receipt-trigger',
 401                               $self->cust_main->agentnum) || 'cust_pay';
 402   if ( $trigger eq 'cust_pay' ) {
 403     my $error = $self->send_receipt(
 404       'manual'    => $options{'manual'},
 405       'noemail'   => $options{'noemail'},
 406       'cust_bill' => $cust_bill,
 407       'cust_main' => $cust_main,
 408     );
 409     warn "can't send payment receipt/statement: $error" if $error;
 410   }
 411
 412   #run payment events immediately
 413   my $due_cust_event = $self->cust_main->due_cust_event(
 414     'eventtable'  => 'cust_pay',
 415     'objects'     => [ $self ],
 416   );
 417   if ( !ref($due_cust_event) ) {
 418     warn "Error searching for cust_pay billing events: $due_cust_event\n";
 419   } else {
 420     foreach my $cust_event (@$due_cust_event) {
 421       next unless $cust_event->test_conditions;
 422       if ( my $error = $cust_event->do_event() ) {
 423         warn "Error running cust_pay billing event: $error\n";
 424       }
 425     }
 426   }
 427
 428   '';
 429
 430 }
 431
 432 =item void [ REASON ]
 433
 434 Voids this payment: deletes the payment and all associated applications and
 435 adds a record of the voided payment to the FS::cust_pay_void table.
 436
 437 =cut
 438
 439 sub void {
 440   my $self = shift;
 441
 442   local $SIG{HUP} = 'IGNORE';
 443   local $SIG{INT} = 'IGNORE';
 444   local $SIG{QUIT} = 'IGNORE';
 445   local $SIG{TERM} = 'IGNORE';
 446   local $SIG{TSTP} = 'IGNORE';
 447   local $SIG{PIPE} = 'IGNORE';
 448
 449   my $oldAutoCommit = $FS::UID::AutoCommit;
 450   local $FS::UID::AutoCommit = 0;
 451   my $dbh = dbh;
 452
 453   my $cust_pay_void = new FS::cust_pay_void ( {
 454     map { $_ => $self->get($_) } $self->fields
 455   } );
 456   $cust_pay_void->reason(shift) if scalar(@_);
 457   my $error = $cust_pay_void->insert;
 458
 459   my $cust_pay_pending =
 460     qsearchs('cust_pay_pending', { paynum => $self->paynum });
 461   if ( $cust_pay_pending ) {
 462     $cust_pay_pending->set('void_paynum', $self->paynum);
 463     $cust_pay_pending->set('paynum', '');
 464     $error ||= $cust_pay_pending->replace;
 465   }
 466
 467   $error ||= $self->delete;
 468
 469   if ( $error ) {
 470     $dbh->rollback if $oldAutoCommit;
 471     return $error;
 472   }
 473
 474   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 475
 476   '';
 477
 478 }
 479
 480 =item delete
 481
 482 Unless the closed flag is set, deletes this payment and all associated
 483 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>).  In most
 484 cases, you want to use the void method instead to leave a record of the
 485 deleted payment.
 486
 487 =cut
 488
 489 # very similar to FS::cust_credit::delete
 490 sub delete {
 491   my $self = shift;
 492   return "Can't delete closed payment" if $self->closed =~ /^Y/i;
 493
 494   local $SIG{HUP} = 'IGNORE';
 495   local $SIG{INT} = 'IGNORE';
 496   local $SIG{QUIT} = 'IGNORE';
 497   local $SIG{TERM} = 'IGNORE';
 498   local $SIG{TSTP} = 'IGNORE';
 499   local $SIG{PIPE} = 'IGNORE';
 500
 501   my $oldAutoCommit = $FS::UID::AutoCommit;
 502   local $FS::UID::AutoCommit = 0;
 503   my $dbh = dbh;
 504
 505   foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
 506     my $error = $app->delete;
 507     if ( $error ) {
 508       $dbh->rollback if $oldAutoCommit;
 509       return $error;
 510     }
 511   }
 512
 513   my $error = $self->SUPER::delete(@_);
 514   if ( $error ) {
 515     $dbh->rollback if $oldAutoCommit;
 516     return $error;
 517   }
 518
 519   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 520
 521   '';
 522
 523 }
 524
 525 =item replace [ OLD_RECORD ]
 526
 527 You can, but probably shouldn't modify payments...
 528
 529 Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
 530 supplied, replaces this record.  If there is an error, returns the error,
 531 otherwise returns false.
 532
 533 =cut
 534
 535 sub replace {
 536   my $self = shift;
 537   return "Can't modify closed payment" if $self->closed =~ /^Y/i;
 538   $self->SUPER::replace(@_);
 539 }
 540
 541 =item check
 542
 543 Checks all fields to make sure this is a valid payment.  If there is an error,
 544 returns the error, otherwise returns false.  Called by the insert method.
 545
 546 =cut
 547
 548 sub check {
 549   my $self = shift;
 550
 551   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
 552
 553   my $error =
 554     $self->ut_numbern('paynum')
 555     || $self->ut_numbern('custnum')
 556     || $self->ut_numbern('_date')
 557     || $self->ut_money('paid')
 558     || $self->ut_alphan('otaker')
 559     || $self->ut_textn('paybatch')
 560     || $self->ut_textn('payunique')
 561     || $self->ut_enum('closed', [ '', 'Y' ])
 562     || $self->ut_flag('no_auto_apply')
 563     || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
 564     || $self->ut_textn('bank')
 565     || $self->ut_alphan('depositor')
 566     || $self->ut_numbern('account')
 567     || $self->ut_numbern('teller')
 568     || $self->ut_foreign_keyn('batchnum', 'pay_batch', 'batchnum')
 569     || $self->payinfo_check()
 570   ;
 571   return $error if $error;
 572
 573   return "paid must be > 0 " if $self->paid <= 0;
 574
 575   return "unknown cust_main.custnum: ". $self->custnum
 576     unless $self->invnum
 577            || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 578
 579   $self->_date(time) unless $self->_date;
 580
 581   return "invalid discount_term"
 582    if ($self->discount_term && $self->discount_term < 2);
 583
 584   if ( $self->payby eq 'CASH' and $conf->exists('require_cash_deposit_info') ) {
 585     foreach (qw(bank depositor account teller)) {
 586       return "$_ required" if $self->get($_) eq '';
 587     }
 588   }
 589
 590 #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
 591 #  # UNIQUE index should catch this too, without race conditions, but this
 592 #  # should give a better error message the other 99.9% of the time...
 593 #  if ( length($self->payunique)
 594 #       && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
 595 #    #well, it *could* be a better error message
 596 #    return "duplicate transaction".
 597 #           " - a payment with unique identifer ". $self->payunique.
 598 #           " already exists";
 599 #  }
 600
 601   $self->SUPER::check;
 602 }
 603
 604 =item send_receipt HASHREF | OPTION => VALUE ...
 605
 606 Sends a payment receipt for this payment..
 607
 608 Available options:
 609
 610 =over 4
 611
 612 =item manual
 613
 614 Flag indicating the payment is being made manually.
 615
 616 =item cust_bill
 617
 618 Invoice (FS::cust_bill) object.  If not specified, the most recent invoice
 619 will be assumed.
 620
 621 =item cust_main
 622
 623 Customer (FS::cust_main) object (for efficiency).
 624
 625 =item noemail
 626
 627 Don't send an email receipt.
 628
 629 =cut
 630
 631 =back
 632
 633 =cut
 634
 635 sub send_receipt {
 636   my $self = shift;
 637   my $opt = ref($_[0]) ? shift : { @_ };
 638
 639   my $cust_bill = $opt->{'cust_bill'};
 640   my $cust_main = $opt->{'cust_main'} || $self->cust_main;
 641
 642   my $conf = new FS::Conf;
 643
 644   return '' unless $conf->config_bool('payment_receipt', $cust_main->agentnum);
 645
 646   my @invoicing_list = $cust_main->invoicing_list_emailonly;
 647   return '' unless @invoicing_list;
 648
 649   $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
 650
 651   my $error = '';
 652
 653   if (    ( exists($opt->{'manual'}) && $opt->{'manual'} )
 654        #|| ! $conf->exists('invoice_html_statement')
 655        || ! $cust_bill
 656      )
 657   {
 658     my $msgnum = $conf->config('payment_receipt_msgnum', $cust_main->agentnum);
 659     if ( $msgnum ) {
 660
 661       my %substitutions = ();
 662       $substitutions{invnum} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
 663
 664       my $queue = new FS::queue {
 665         'job'     => 'FS::Misc::process_send_email',
 666         'paynum'  => $self->paynum,
 667         'custnum' => $cust_main->custnum,
 668       };
 669       $error = $queue->insert(
 670         FS::msg_template->by_key($msgnum)->prepare(
 671           'cust_main'     => $cust_main,
 672           'object'        => $self,
 673           'from_config'   => 'payment_receipt_from',
 674           'substitutions' => \%substitutions,
 675         ),
 676         'msgtype' => 'receipt', # override msg_template's default
 677       );
 678
 679     } elsif ( $conf->exists('payment_receipt_email') ) {
 680
 681       my $receipt_template = new Text::Template (
 682         TYPE   => 'ARRAY',
 683         SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
 684       ) or do {
 685         warn "can't create payment receipt template: $Text::Template::ERROR";
 686         return '';
 687       };
 688
 689       my $payby = $self->payby;
 690       my $payinfo = $self->payinfo;
 691       $payby =~ s/^BILL$/Check/ if $payinfo;
 692       if ( $payby eq 'CARD' || $payby eq 'CHEK' ) {
 693         $payinfo = $self->paymask
 694       } else {
 695         $payinfo = $self->decrypt($payinfo);
 696       }
 697       $payby =~ s/^CHEK$/Electronic check/;
 698
 699       my %fill_in = (
 700         'date'         => time2str("%a %B %o, %Y", $self->_date),
 701         'name'         => $cust_main->name,
 702         'paynum'       => $self->paynum,
 703         'paid'         => sprintf("%.2f", $self->paid),
 704         'payby'        => ucfirst(lc($payby)),
 705         'payinfo'      => $payinfo,
 706         'balance'      => $cust_main->balance,
 707         'company_name' => $conf->config('company_name', $cust_main->agentnum),
 708       );
 709
 710       $fill_in{'invnum'} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
 711
 712       if ( $opt->{'cust_pkg'} ) {
 713         $fill_in{'pkg'} = $opt->{'cust_pkg'}->part_pkg->pkg;
 714         #setup date, other things?
 715       }
 716
 717       my $queue = new FS::queue {
 718         'job'     => 'FS::Misc::process_send_generated_email',
 719         'paynum'  => $self->paynum,
 720         'custnum' => $cust_main->custnum,
 721         'msgtype' => 'receipt',
 722       };
 723       $error = $queue->insert(
 724         'from'    => $conf->invoice_from_full( $cust_main->agentnum ),
 725                                    #invoice_from??? well as good as any
 726         'to'      => \@invoicing_list,
 727         'subject' => 'Payment receipt',
 728         'body'    => [ $receipt_template->fill_in( HASH => \%fill_in ) ],
 729       );
 730
 731     } else {
 732
 733       warn "payment_receipt is on, but no payment_receipt_msgnum\n";
 734
 735     }
 736
 737   #not manual and no noemail flag (here or on the customer)
 738   } elsif ( ! $opt->{'noemail'} && ! $cust_main->invoice_noemail ) {
 739
 740     my $queue = new FS::queue {
 741        'job'     => 'FS::cust_bill::queueable_email',
 742        'paynum'  => $self->paynum,
 743        'custnum' => $cust_main->custnum,
 744     };
 745
 746     my %opt = (
 747       'invnum'      => $cust_bill->invnum,
 748       'no_coupon'   => 1,
 749     );
 750
 751     if ( my $mode = $conf->config('payment_receipt_statement_mode') ) {
 752       $opt{'mode'} = $mode;
 753     } else {
 754       # backward compatibility, no good fix for this yet as some people may
 755       # still have "invoice_latex_statement" and such options
 756       $opt{'template'} = 'statement';
 757       $opt{'notice_name'} = 'Statement';
 758     }
 759
 760     $error = $queue->insert(%opt);
 761
 762   }
 763
 764   warn "send_receipt: $error\n" if $error;
 765 }
 766
 767 =item cust_bill_pay
 768
 769 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
 770 payment.
 771
 772 =cut
 773
 774 sub cust_bill_pay {
 775   my $self = shift;
 776   map { $_ } #return $self->num_cust_bill_pay unless wantarray;
 777   sort {    $a->_date  <=> $b->_date
 778          || $a->invnum <=> $b->invnum }
 779     qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
 780   ;
 781 }
 782
 783 =item cust_pay_refund
 784
 785 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
 786 payment.
 787
 788 =cut
 789
 790 sub cust_pay_refund {
 791   my $self = shift;
 792   map { $_ } #return $self->num_cust_pay_refund unless wantarray;
 793   sort { $a->_date <=> $b->_date }
 794     qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
 795   ;
 796 }
 797
 798
 799 =item unapplied
 800
 801 Returns the amount of this payment that is still unapplied; which is
 802 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
 803 applications (see L<FS::cust_pay_refund>).
 804
 805 =cut
 806
 807 sub unapplied {
 808   my $self = shift;
 809   my $amount = $self->paid;
 810   $amount -= $_->amount foreach ( $self->cust_bill_pay );
 811   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 812   sprintf("%.2f", $amount );
 813 }
 814
 815 =item unrefunded
 816
 817 Returns the amount of this payment that has not been refuned; which is
 818 paid minus all  refund applications (see L<FS::cust_pay_refund>).
 819
 820 =cut
 821
 822 sub unrefunded {
 823   my $self = shift;
 824   my $amount = $self->paid;
 825   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 826   sprintf("%.2f", $amount );
 827 }
 828
 829 =item amount
 830
 831 Returns the "paid" field.
 832
 833 =cut
 834
 835 sub amount {
 836   my $self = shift;
 837   $self->paid();
 838 }
 839
 840 =item delete_cust_bill_pay OPTIONS
 841
 842 Deletes all associated cust_bill_pay records.
 843
 844 If option 'unapplied' is a specified, only deletes until
 845 this object's 'unapplied' value is >= the specified amount.
 846 (Deletes in order returned by L</cust_bill_pay>.)
 847
 848 =cut
 849
 850 sub delete_cust_bill_pay {
 851   my $self = shift;
 852   my %opt = @_;
 853
 854   local $SIG{HUP} = 'IGNORE';
 855   local $SIG{INT} = 'IGNORE';
 856   local $SIG{QUIT} = 'IGNORE';
 857   local $SIG{TERM} = 'IGNORE';
 858   local $SIG{TSTP} = 'IGNORE';
 859   local $SIG{PIPE} = 'IGNORE';
 860
 861   my $oldAutoCommit = $FS::UID::AutoCommit;
 862   local $FS::UID::AutoCommit = 0;
 863   my $dbh = dbh;
 864
 865   my $unapplied = $self->unapplied; #only need to look it up once
 866
 867   my $error = '';
 868
 869   # Maybe we should reverse the order these get deleted in?
 870   # ie delete newest first?
 871   # keeping consistent with how bop refunds work, for now...
 872   foreach my $cust_bill_pay ( $self->cust_bill_pay ) {
 873     last if $opt{'unapplied'} && ($unapplied > $opt{'unapplied'});
 874     $unapplied += $cust_bill_pay->amount;
 875     $error = $cust_bill_pay->delete;
 876     last if $error;
 877   }
 878
 879   if ($error) {
 880     $dbh->rollback if $oldAutoCommit;
 881     return $error;
 882   }
 883
 884   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 885   return '';
 886 }
 887
 888 =item refund HASHREF
 889
 890 Accepts input for creating a new FS::cust_refund object.
 891 Unapplies payment from invoices up to the amount of the refund,
 892 creates the refund and applies payment to refund.  Allows entire
 893 process to be handled in one transaction.
 894
 895 Causes a fatal error if called on CARD or CHEK payments.
 896
 897 =cut
 898
 899 sub refund {
 900   my $self = shift;
 901   my $hash = shift;
 902   die "Cannot call cust_pay->refund on " . $self->payby
 903     if grep { $_ eq $self->payby } qw(CARD CHEK);
 904
 905   local $SIG{HUP} = 'IGNORE';
 906   local $SIG{INT} = 'IGNORE';
 907   local $SIG{QUIT} = 'IGNORE';
 908   local $SIG{TERM} = 'IGNORE';
 909   local $SIG{TSTP} = 'IGNORE';
 910   local $SIG{PIPE} = 'IGNORE';
 911
 912   my $oldAutoCommit = $FS::UID::AutoCommit;
 913   local $FS::UID::AutoCommit = 0;
 914   my $dbh = dbh;
 915
 916   my $error = $self->delete_cust_bill_pay('amount' => $hash->{'amount'});
 917
 918   if ($error) {
 919     $dbh->rollback if $oldAutoCommit;
 920     return $error;
 921   }
 922
 923   $hash->{'paynum'} = $self->paynum;
 924   my $new = new FS::cust_refund ( $hash );
 925   $error = $new->insert;
 926
 927   if ($error) {
 928     $dbh->rollback if $oldAutoCommit;
 929     return $error;
 930   }
 931
 932   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 933   return '';
 934 }
 935
 936 =back
 937
 938 =head1 CLASS METHODS
 939
 940 =over 4
 941
 942 =item batch_insert CUST_PAY_OBJECT, ...
 943
 944 Class method which inserts multiple payments.  Takes a list of FS::cust_pay
 945 objects.  Returns a list, each element representing the status of inserting the
 946 corresponding payment - empty.  If there is an error inserting any payment, the
 947 entire transaction is rolled back, i.e. all payments are inserted or none are.
 948
 949 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
 950 reference to an array of (uninserted) FS::cust_bill_pay objects.  If so,
 951 those objects will be inserted with the paynum of the payment, and for
 952 each one, an error message or an empty string will be inserted into the
 953 list of errors.
 954
 955 For example:
 956
 957   my @errors = FS::cust_pay->batch_insert(@cust_pay);
 958   my $num_errors = scalar(grep $_, @errors);
 959   if ( $num_errors == 0 ) {
 960     #success; all payments were inserted
 961   } else {
 962     #failure; no payments were inserted.
 963   }
 964
 965 =cut
 966
 967 sub batch_insert {
 968   my $self = shift; #class method
 969
 970   local $SIG{HUP} = 'IGNORE';
 971   local $SIG{INT} = 'IGNORE';
 972   local $SIG{QUIT} = 'IGNORE';
 973   local $SIG{TERM} = 'IGNORE';
 974   local $SIG{TSTP} = 'IGNORE';
 975   local $SIG{PIPE} = 'IGNORE';
 976
 977   my $oldAutoCommit = $FS::UID::AutoCommit;
 978   local $FS::UID::AutoCommit = 0;
 979   my $dbh = dbh;
 980
 981   my $num_errors = 0;
 982
 983   my @errors;
 984   foreach my $cust_pay (@_) {
 985     my $error = $cust_pay->insert( 'manual' => 1 );
 986     push @errors, $error;
 987     $num_errors++ if $error;
 988
 989     if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
 990
 991       foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
 992         if ( $error ) { # insert placeholders if cust_pay wasn't inserted
 993           push @errors, '';
 994         }
 995         else {
 996           $cust_bill_pay->set('paynum', $cust_pay->paynum);
 997           my $apply_error = $cust_bill_pay->insert;
 998           push @errors, $apply_error || '';
 999           $num_errors++ if $apply_error;
1000         }
1001       }
1002
1003     } elsif ( !$error ) { #normal case: apply payments as usual
1004       $cust_pay->cust_main->apply_payments;
1005     }
1006
1007   }
1008
1009   if ( $num_errors ) {
1010     $dbh->rollback if $oldAutoCommit;
1011   } else {
1012     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1013   }
1014
1015   @errors;
1016
1017 }
1018
1019 =item unapplied_sql
1020
1021 Returns an SQL fragment to retreive the unapplied amount.
1022
1023 =cut
1024
1025 sub unapplied_sql {
1026   my ($class, $start, $end) = @_;
1027   my $bill_start   = $start ? "AND cust_bill_pay._date <= $start"   : '';
1028   my $bill_end     = $end   ? "AND cust_bill_pay._date > $end"     : '';
1029   my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
1030   my $refund_end   = $end   ? "AND cust_pay_refund._date > $end"   : '';
1031
1032   "paid
1033         - COALESCE(
1034                     ( SELECT SUM(amount) FROM cust_bill_pay
1035                         WHERE cust_pay.paynum = cust_bill_pay.paynum
1036                         $bill_start $bill_end )
1037                     ,0
1038                   )
1039         - COALESCE(
1040                     ( SELECT SUM(amount) FROM cust_pay_refund
1041                         WHERE cust_pay.paynum = cust_pay_refund.paynum
1042                         $refund_start $refund_end )
1043                     ,0
1044                   )
1045   ";
1046
1047 }
1048
1049 sub API_getinfo {
1050  my $self = shift;
1051  my @fields = grep { $_ ne 'payinfo' } $self->fields;
1052  +{ ( map { $_=>$self->$_ } @fields ),
1053   };
1054 }
1055
1056 # _upgrade_data
1057 #
1058 # Used by FS::Upgrade to migrate to a new database.
1059
1060 use FS::h_cust_pay;
1061
1062 sub _upgrade_data {  #class method
1063   my ($class, %opt) = @_;
1064
1065   warn "$me upgrading $class\n" if $DEBUG;
1066
1067   local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1068
1069   ##
1070   # otaker/ivan upgrade
1071   ##
1072
1073   unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
1074
1075     #not the most efficient, but hey, it only has to run once
1076
1077     my $where = " WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' )
1078                     AND usernum IS NULL
1079                     AND EXISTS ( SELECT 1 FROM cust_main
1080                                    WHERE cust_main.custnum = cust_pay.custnum )
1081                 ";
1082
1083     my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
1084
1085     my $sth = dbh->prepare($count_sql) or die dbh->errstr;
1086     $sth->execute or die $sth->errstr;
1087     my $total = $sth->fetchrow_arrayref->[0];
1088     #warn "$total cust_pay records to update\n"
1089     #  if $DEBUG;
1090     local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
1091
1092     my $count = 0;
1093     my $lastprog = 0;
1094
1095     my @cust_pay = qsearch( {
1096         'table'     => 'cust_pay',
1097         'hashref'   => {},
1098         'extra_sql' => $where,
1099         'order_by'  => 'ORDER BY paynum',
1100     } );
1101
1102     foreach my $cust_pay (@cust_pay) {
1103
1104       my $h_cust_pay = $cust_pay->h_search('insert');
1105       if ( $h_cust_pay ) {
1106         next if $cust_pay->otaker eq $h_cust_pay->history_user;
1107         #$cust_pay->otaker($h_cust_pay->history_user);
1108         $cust_pay->set('otaker', $h_cust_pay->history_user);
1109       } else {
1110         $cust_pay->set('otaker', 'legacy');
1111       }
1112
1113       my $error = $cust_pay->replace;
1114
1115       if ( $error ) {
1116         warn " *** WARNING: Error updating order taker for payment paynum ".
1117              $cust_pay->paynun. ": $error\n";
1118         next;
1119       }
1120
1121       $count++;
1122       if ( $DEBUG > 1 && $lastprog + 30 < time ) {
1123         warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
1124         $lastprog = time;
1125       }
1126
1127     }
1128
1129     FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
1130   }
1131
1132   ###
1133   # payinfo N/A upgrade
1134   ###
1135
1136   unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1137
1138     #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1139
1140     my @na_cust_pay = qsearch( {
1141       'table'     => 'cust_pay',
1142       'hashref'   => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1143       'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1144     } );
1145
1146     foreach my $na ( @na_cust_pay ) {
1147
1148       next unless $na->payinfo eq 'N/A';
1149
1150       my $cust_pay_pending =
1151         qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1152       unless ( $cust_pay_pending ) {
1153         warn " *** WARNING: not-yet recoverable N/A card for payment ".
1154              $na->paynum. " (no cust_pay_pending)\n";
1155         next;
1156       }
1157       $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1158       my $error = $na->replace;
1159       if ( $error ) {
1160         warn " *** WARNING: Error updating payinfo for payment paynum ".
1161              $na->paynun. ": $error\n";
1162         next;
1163       }
1164
1165     }
1166
1167     FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1168   }
1169
1170   ###
1171   # otaker->usernum upgrade
1172   ###
1173
1174   $class->_upgrade_otaker(%opt);
1175
1176   # if we do this anywhere else, it should become an FS::Upgrade method
1177   my $num_to_upgrade = $class->count('paybatch is not null');
1178   my $num_jobs = FS::queue->count('job = \'FS::cust_pay::process_upgrade_paybatch\' and status != \'failed\'');
1179   if ( $num_to_upgrade > 0 ) {
1180     warn "Need to migrate paybatch field in $num_to_upgrade payments.\n";
1181     if ( $opt{queue} ) {
1182       if ( $num_jobs > 0 ) {
1183         warn "Upgrade already queued.\n";
1184       } else {
1185         warn "Scheduling upgrade.\n";
1186         my $job = FS::queue->new({ job => 'FS::cust_pay::process_upgrade_paybatch' });
1187         $job->insert;
1188       }
1189     } else {
1190       process_upgrade_paybatch();
1191     }
1192   }
1193 }
1194
1195 sub process_upgrade_paybatch {
1196   my $dbh = dbh;
1197   local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1198   local $FS::UID::AutoCommit = 1;
1199
1200   ###
1201   # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1202   ###
1203   my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
1204   my $search = FS::Cursor->new( {
1205     'table'     => 'cust_pay',
1206     'addl_from' => " JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS $text) ",
1207   } );
1208   while (my $cust_pay = $search->fetch) {
1209     $cust_pay->set('batchnum' => $cust_pay->paybatch);
1210     $cust_pay->set('paybatch' => '');
1211     my $error = $cust_pay->replace;
1212     warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n  $error"
1213     if $error;
1214   }
1215
1216   ###
1217   # migrate gateway info from the misused 'paybatch' field
1218   ###
1219
1220   # not only cust_pay, but also voided and refunded payments
1221   if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1222     local $FS::Record::nowarn_classload=1;
1223     # really inefficient, but again, only has to run once
1224     foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1225       my $and_batchnum_is_null =
1226         ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1227       my $pkey = ($table =~ /^cust_pay/ ? 'paynum' : 'refundnum');
1228       my $search = FS::Cursor->new({
1229         table     => $table,
1230         extra_sql => "WHERE payby IN('CARD','CHEK') ".
1231                      "AND (paybatch IS NOT NULL ".
1232                      "OR (paybatch IS NULL AND auth IS NULL
1233                      $and_batchnum_is_null ) )
1234                      ORDER BY $pkey DESC"
1235       });
1236       while ( my $object = $search->fetch ) {
1237         if ( $object->paybatch eq '' ) {
1238           # repair for a previous upgrade that didn't save 'auth'
1239           my $pkey = $object->primary_key;
1240           # find the last history record that had a paybatch value
1241           my $h = qsearchs({
1242               table   => "h_$table",
1243               hashref => {
1244                 $pkey     => $object->$pkey,
1245                 paybatch  => { op=>'!=', value=>''},
1246                 history_action => 'replace_old',
1247               },
1248               order_by => 'ORDER BY history_date DESC LIMIT 1',
1249           });
1250           if (!$h) {
1251             warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1252             next;
1253           }
1254           # if the paybatch didn't have an auth string, then it's fine
1255           $h->paybatch =~ /:(\w+):/ or next;
1256           # set paybatch to what it was in that record
1257           $object->set('paybatch', $h->paybatch)
1258           # and then upgrade it like the old records
1259         }
1260
1261         my $parsed = $object->_parse_paybatch;
1262         if (keys %$parsed) {
1263           $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1264           $object->set('auth' => $parsed->{authorization});
1265           $object->set('paybatch', '');
1266           my $error = $object->replace;
1267           warn "error parsing CARD/CHEK paybatch fields on $object #".
1268             $object->get($object->primary_key).":\n  $error\n"
1269             if $error;
1270         }
1271       } #$object
1272     } #$table
1273     FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1274   }
1275 }
1276
1277 =back
1278
1279 =head1 SUBROUTINES
1280
1281 =over 4
1282
1283 =item process_batch_import
1284
1285 =cut
1286
1287 sub process_batch_import {
1288   my $job = shift;
1289
1290   my $hashcb = sub {
1291     my %hash = @_;
1292     my $custnum = $hash{'custnum'};
1293     my $agentnum = $hash{'agentnum'};
1294     my $agent_custid = $hash{'agent_custid'};
1295     #standardize date
1296     $hash{'_date'} = parse_datetime($hash{'_date'})
1297       if $hash{'_date'} && $hash{'_date'} =~ /\D/;
1298     #remove custnum_prefix
1299     my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1300     my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1301     if (
1302       $custnum_prefix
1303       && $custnum =~ /^$custnum_prefix(0*([1-9]\d*))$/
1304       && length($1) == $custnum_length
1305     ) {
1306       $custnum = $2;
1307     }
1308     # check agentnum against custnum and
1309     # translate agent_custid into regular custnum
1310     if ($custnum && $agent_custid) {
1311       die "can't specify both custnum and agent_custid\n";
1312     } elsif ($agentnum || $agent_custid) {
1313       # here is the agent virtualization
1314       my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1315       my %search;
1316       $search{'agentnum'} = $agentnum
1317         if $agentnum;
1318       $search{'agent_custid'} = $agent_custid
1319         if $agent_custid;
1320       $search{'custnum'} = $custnum
1321         if $custnum;
1322       my $cust_main = qsearchs({
1323         'table'     => 'cust_main',
1324         'hashref'   => \%search,
1325         'extra_sql' => $extra_sql,
1326       });
1327       die "can't find customer with" .
1328         ($agentnum ? " agentnum $agentnum" : '') .
1329         ($custnum  ? " custnum $custnum" : '') .
1330         ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
1331         unless $cust_main;
1332       die "mismatched customer number\n"
1333         if $custnum && ($custnum ne $cust_main->custnum);
1334       $custnum = $cust_main->custnum;
1335     }
1336     $hash{'custnum'} = $custnum;
1337     delete($hash{'agent_custid'});
1338     return %hash;
1339   };
1340
1341   my $opt = {
1342     'table'        => 'cust_pay',
1343     'params'       => [ '_date', 'agentnum', 'payby', 'paybatch' ],
1344                         #agent_custid isn't a cust_pay field, see hash callback
1345     'formats'      => { 'simple' =>
1346                           [ qw(custnum agent_custid paid payinfo invnum) ] },
1347     'format_types' => { 'simple' => '' }, #force infer from file extension
1348     'default_csv'  => 1, #if not .xls, will read as csv, regardless of extension
1349     'format_hash_callbacks' => { 'simple' => $hashcb },
1350     'insert_args_callback'  => sub { ( 'manual'=>1 ); },
1351     'postinsert_callback'   => sub {
1352       my $cust_pay = shift;
1353       my $cust_main = $cust_pay->cust_main
1354                         or return "can't find customer to which payments apply";
1355       my $error = $cust_main->apply_payments_and_credits;
1356       return $error
1357                ? "can't apply payments to customer ".$cust_pay->custnum."$error"
1358                : '';
1359     },
1360   };
1361
1362   FS::Record::process_batch_import( $job, $opt, @_ );
1363
1364 }
1365
1366 =item batch_import HASHREF
1367
1368 Inserts new payments.
1369
1370 =cut
1371
1372 sub batch_import {
1373   my $param = shift;
1374
1375   my $fh       = $param->{filehandle};
1376   my $format   = $param->{'format'};
1377
1378   my $agentnum = $param->{agentnum};
1379   my $_date    = $param->{_date};
1380   $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1381   my $paybatch = $param->{'paybatch'};
1382
1383   my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1384   my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1385
1386   # here is the agent virtualization
1387   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1388
1389   my @fields;
1390   my $payby;
1391   if ( $format eq 'simple' ) {
1392     @fields = qw( custnum agent_custid paid payinfo invnum );
1393     $payby = 'BILL';
1394   } elsif ( $format eq 'extended' ) {
1395     die "unimplemented\n";
1396     @fields = qw( );
1397     $payby = 'BILL';
1398   } else {
1399     die "unknown format $format";
1400   }
1401
1402   eval "use Text::CSV_XS;";
1403   die $@ if $@;
1404
1405   my $csv = new Text::CSV_XS;
1406
1407   my $imported = 0;
1408
1409   local $SIG{HUP} = 'IGNORE';
1410   local $SIG{INT} = 'IGNORE';
1411   local $SIG{QUIT} = 'IGNORE';
1412   local $SIG{TERM} = 'IGNORE';
1413   local $SIG{TSTP} = 'IGNORE';
1414   local $SIG{PIPE} = 'IGNORE';
1415
1416   my $oldAutoCommit = $FS::UID::AutoCommit;
1417   local $FS::UID::AutoCommit = 0;
1418   my $dbh = dbh;
1419
1420   my $line;
1421   while ( defined($line=<$fh>) ) {
1422
1423     $csv->parse($line) or do {
1424       $dbh->rollback if $oldAutoCommit;
1425       return "can't parse: ". $csv->error_input();
1426     };
1427
1428     my @columns = $csv->fields();
1429
1430     my %cust_pay = (
1431       payby    => $payby,
1432       paybatch => $paybatch,
1433     );
1434     $cust_pay{_date} = $_date if $_date;
1435
1436     my $cust_main;
1437     foreach my $field ( @fields ) {
1438
1439       if ( $field eq 'agent_custid'
1440         && $agentnum
1441         && $columns[0] =~ /\S+/ )
1442       {
1443
1444         my $agent_custid = $columns[0];
1445         my %hash = ( 'agent_custid' => $agent_custid,
1446                      'agentnum'     => $agentnum,
1447                    );
1448
1449         if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1450           $dbh->rollback if $oldAutoCommit;
1451           return "can't specify custnum with agent_custid $agent_custid";
1452         }
1453
1454         $cust_main = qsearchs({
1455                                 'table'     => 'cust_main',
1456                                 'hashref'   => \%hash,
1457                                 'extra_sql' => $extra_sql,
1458                              });
1459
1460         unless ( $cust_main ) {
1461           $dbh->rollback if $oldAutoCommit;
1462           return "can't find customer with agent_custid $agent_custid";
1463         }
1464
1465         $field = 'custnum';
1466         $columns[0] = $cust_main->custnum;
1467       }
1468
1469       $cust_pay{$field} = shift @columns;
1470     }
1471
1472     if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1473                          && length($1) == $custnum_length ) {
1474       $cust_pay{custnum} = $2;
1475     }
1476
1477     my $custnum = $cust_pay{custnum};
1478
1479     my $cust_pay = new FS::cust_pay( \%cust_pay );
1480     my $error = $cust_pay->insert;
1481
1482     if ( ! $error && $cust_pay->custnum != $custnum ) {
1483       #invnum was defined, and ->insert set custnum to the customer for that
1484       #invoice, but it wasn't the one the import specified.
1485       $dbh->rollback if $oldAutoCommit;
1486       $error = "specified invoice #". $cust_pay{invnum}.
1487                " is for custnum ". $cust_pay->custnum.
1488                ", not specified custnum $custnum";
1489     }
1490
1491     if ( $error ) {
1492       $dbh->rollback if $oldAutoCommit;
1493       return "can't insert payment for $line: $error";
1494     }
1495
1496     if ( $format eq 'simple' ) {
1497       # include agentnum for less surprise?
1498       $cust_main = qsearchs({
1499                              'table'     => 'cust_main',
1500                              'hashref'   => { 'custnum' => $cust_pay->custnum },
1501                              'extra_sql' => $extra_sql,
1502                            })
1503         unless $cust_main;
1504
1505       unless ( $cust_main ) {
1506         $dbh->rollback if $oldAutoCommit;
1507         return "can't find customer to which payments apply at line: $line";
1508       }
1509
1510       $error = $cust_main->apply_payments_and_credits;
1511       if ( $error ) {
1512         $dbh->rollback if $oldAutoCommit;
1513         return "can't apply payments to customer for $line: $error";
1514       }
1515
1516     }
1517
1518     $imported++;
1519   }
1520
1521   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1522
1523   return "Empty file!" unless $imported;
1524
1525   ''; #no error
1526
1527 }
1528
1529 =back
1530
1531 =head1 BUGS
1532
1533 Delete and replace methods.
1534
1535 =head1 SEE ALSO
1536
1537 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1538 schema.html from the base documentation.
1539
1540 =cut
1541
1542 1;
1543