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