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 );
  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   if ( $error ) {
 420     $dbh->rollback if $oldAutoCommit;
 421     return $error;
 422   }
 423
 424   $error = $self->delete;
 425   if ( $error ) {
 426     $dbh->rollback if $oldAutoCommit;
 427     return $error;
 428   }
 429
 430   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 431
 432   '';
 433
 434 }
 435
 436 =item delete
 437
 438 Unless the closed flag is set, deletes this payment and all associated
 439 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>).  In most
 440 cases, you want to use the void method instead to leave a record of the
 441 deleted payment.
 442
 443 =cut
 444
 445 # very similar to FS::cust_credit::delete
 446 sub delete {
 447   my $self = shift;
 448   return "Can't delete closed payment" if $self->closed =~ /^Y/i;
 449
 450   local $SIG{HUP} = 'IGNORE';
 451   local $SIG{INT} = 'IGNORE';
 452   local $SIG{QUIT} = 'IGNORE';
 453   local $SIG{TERM} = 'IGNORE';
 454   local $SIG{TSTP} = 'IGNORE';
 455   local $SIG{PIPE} = 'IGNORE';
 456
 457   my $oldAutoCommit = $FS::UID::AutoCommit;
 458   local $FS::UID::AutoCommit = 0;
 459   my $dbh = dbh;
 460
 461   foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
 462     my $error = $app->delete;
 463     if ( $error ) {
 464       $dbh->rollback if $oldAutoCommit;
 465       return $error;
 466     }
 467   }
 468
 469   my $error = $self->SUPER::delete(@_);
 470   if ( $error ) {
 471     $dbh->rollback if $oldAutoCommit;
 472     return $error;
 473   }
 474
 475   if (    $conf->exists('deletepayments')
 476        && $conf->config('deletepayments') ne '' ) {
 477
 478     my $cust_main = $self->cust_main;
 479
 480     my $error = send_email(
 481       'from'    => $conf->config('invoice_from', $self->cust_main->agentnum),
 482                                  #invoice_from??? well as good as any
 483       'to'      => $conf->config('deletepayments'),
 484       'subject' => 'FREESIDE NOTIFICATION: Payment deleted',
 485       'body'    => [
 486         "This is an automatic message from your Freeside installation\n",
 487         "informing you that the following payment has been deleted:\n",
 488         "\n",
 489         'paynum: '. $self->paynum. "\n",
 490         'custnum: '. $self->custnum.
 491           " (". $cust_main->last. ", ". $cust_main->first. ")\n",
 492         'paid: $'. sprintf("%.2f", $self->paid). "\n",
 493         'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n",
 494         'payby: '. $self->payby. "\n",
 495         'payinfo: '. $self->paymask. "\n",
 496         'paybatch: '. $self->paybatch. "\n",
 497       ],
 498     );
 499
 500     if ( $error ) {
 501       $dbh->rollback if $oldAutoCommit;
 502       return "can't send payment deletion notification: $error";
 503     }
 504
 505   }
 506
 507   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 508
 509   '';
 510
 511 }
 512
 513 =item replace [ OLD_RECORD ]
 514
 515 You can, but probably shouldn't modify payments...
 516
 517 Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
 518 supplied, replaces this record.  If there is an error, returns the error,
 519 otherwise returns false.
 520
 521 =cut
 522
 523 sub replace {
 524   my $self = shift;
 525   return "Can't modify closed payment" if $self->closed =~ /^Y/i;
 526   $self->SUPER::replace(@_);
 527 }
 528
 529 =item check
 530
 531 Checks all fields to make sure this is a valid payment.  If there is an error,
 532 returns the error, otherwise returns false.  Called by the insert method.
 533
 534 =cut
 535
 536 sub check {
 537   my $self = shift;
 538
 539   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
 540
 541   my $error =
 542     $self->ut_numbern('paynum')
 543     || $self->ut_numbern('custnum')
 544     || $self->ut_numbern('_date')
 545     || $self->ut_money('paid')
 546     || $self->ut_alphan('otaker')
 547     || $self->ut_textn('paybatch')
 548     || $self->ut_textn('payunique')
 549     || $self->ut_enum('closed', [ '', 'Y' ])
 550     || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
 551     || $self->ut_textn('bank')
 552     || $self->ut_alphan('depositor')
 553     || $self->ut_numbern('account')
 554     || $self->ut_numbern('teller')
 555     || $self->ut_foreign_keyn('batchnum', 'pay_batch', 'batchnum')
 556     || $self->payinfo_check()
 557   ;
 558   return $error if $error;
 559
 560   return "paid must be > 0 " if $self->paid <= 0;
 561
 562   return "unknown cust_main.custnum: ". $self->custnum
 563     unless $self->invnum
 564            || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 565
 566   $self->_date(time) unless $self->_date;
 567
 568   return "invalid discount_term"
 569    if ($self->discount_term && $self->discount_term < 2);
 570
 571   if ( $self->payby eq 'CASH' and $conf->exists('require_cash_deposit_info') ) {
 572     foreach (qw(bank depositor account teller)) {
 573       return "$_ required" if $self->get($_) eq '';
 574     }
 575   }
 576
 577 #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
 578 #  # UNIQUE index should catch this too, without race conditions, but this
 579 #  # should give a better error message the other 99.9% of the time...
 580 #  if ( length($self->payunique)
 581 #       && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
 582 #    #well, it *could* be a better error message
 583 #    return "duplicate transaction".
 584 #           " - a payment with unique identifer ". $self->payunique.
 585 #           " already exists";
 586 #  }
 587
 588   $self->SUPER::check;
 589 }
 590
 591 =item send_receipt HASHREF | OPTION => VALUE ...
 592
 593 Sends a payment receipt for this payment..
 594
 595 Available options:
 596
 597 =over 4
 598
 599 =item manual
 600
 601 Flag indicating the payment is being made manually.
 602
 603 =item cust_bill
 604
 605 Invoice (FS::cust_bill) object.  If not specified, the most recent invoice
 606 will be assumed.
 607
 608 =item cust_main
 609
 610 Customer (FS::cust_main) object (for efficiency).
 611
 612 =back
 613
 614 =cut
 615
 616 sub send_receipt {
 617   my $self = shift;
 618   my $opt = ref($_[0]) ? shift : { @_ };
 619
 620   my $cust_bill = $opt->{'cust_bill'};
 621   my $cust_main = $opt->{'cust_main'} || $self->cust_main;
 622
 623   my $conf = new FS::Conf;
 624
 625   return '' unless $conf->config_bool('payment_receipt', $cust_main->agentnum);
 626
 627   my @invoicing_list = $cust_main->invoicing_list_emailonly;
 628   return '' unless @invoicing_list;
 629
 630   $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
 631
 632   my $error = '';
 633
 634   if (    ( exists($opt->{'manual'}) && $opt->{'manual'} )
 635        #|| ! $conf->exists('invoice_html_statement')
 636        || ! $cust_bill
 637      )
 638   {
 639     my $msgnum = $conf->config('payment_receipt_msgnum', $cust_main->agentnum);
 640     if ( $msgnum ) {
 641
 642       my $queue = new FS::queue {
 643         'job'     => 'FS::Misc::process_send_email',
 644         'paynum'  => $self->paynum,
 645         'custnum' => $cust_main->custnum,
 646       };
 647       $error = $queue->insert(
 648         FS::msg_template->by_key($msgnum)->prepare(
 649           'cust_main'   => $cust_main,
 650           'object'      => $self,
 651           'from_config' => 'payment_receipt_from',
 652         ),
 653         'msgtype' => 'receipt', # override msg_template's default
 654       );
 655
 656     } elsif ( $conf->exists('payment_receipt_email') ) {
 657
 658       my $receipt_template = new Text::Template (
 659         TYPE   => 'ARRAY',
 660         SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
 661       ) or do {
 662         warn "can't create payment receipt template: $Text::Template::ERROR";
 663         return '';
 664       };
 665
 666       my $payby = $self->payby;
 667       my $payinfo = $self->payinfo;
 668       $payby =~ s/^BILL$/Check/ if $payinfo;
 669       if ( $payby eq 'CARD' || $payby eq 'CHEK' ) {
 670         $payinfo = $self->paymask
 671       } else {
 672         $payinfo = $self->decrypt($payinfo);
 673       }
 674       $payby =~ s/^CHEK$/Electronic check/;
 675
 676       my %fill_in = (
 677         'date'         => time2str("%a %B %o, %Y", $self->_date),
 678         'name'         => $cust_main->name,
 679         'paynum'       => $self->paynum,
 680         'paid'         => sprintf("%.2f", $self->paid),
 681         'payby'        => ucfirst(lc($payby)),
 682         'payinfo'      => $payinfo,
 683         'balance'      => $cust_main->balance,
 684         'company_name' => $conf->config('company_name', $cust_main->agentnum),
 685       );
 686
 687       if ( $opt->{'cust_pkg'} ) {
 688         $fill_in{'pkg'} = $opt->{'cust_pkg'}->part_pkg->pkg;
 689         #setup date, other things?
 690       }
 691
 692       my $queue = new FS::queue {
 693         'job'     => 'FS::Misc::process_send_generated_email',
 694         'paynum'  => $self->paynum,
 695         'custnum' => $cust_main->custnum,
 696         'msgtype' => 'receipt',
 697       };
 698       $error = $queue->insert(
 699         'from'    => $conf->config('invoice_from', $cust_main->agentnum),
 700                                    #invoice_from??? well as good as any
 701         'to'      => \@invoicing_list,
 702         'subject' => 'Payment receipt',
 703         'body'    => [ $receipt_template->fill_in( HASH => \%fill_in ) ],
 704       );
 705
 706     } else {
 707
 708       warn "payment_receipt is on, but no payment_receipt_msgnum\n";
 709
 710     }
 711
 712   } elsif ( ! $cust_main->invoice_noemail ) { #not manual
 713
 714     my $queue = new FS::queue {
 715        'job'     => 'FS::cust_bill::queueable_email',
 716        'paynum'  => $self->paynum,
 717        'custnum' => $cust_main->custnum,
 718     };
 719
 720     $error = $queue->insert(
 721       'invnum'      => $cust_bill->invnum,
 722       'template'    => 'statement',
 723       'notice_name' => 'Statement',
 724       'no_coupon'   => 1,
 725     );
 726
 727   }
 728
 729   warn "send_receipt: $error\n" if $error;
 730 }
 731
 732 =item cust_bill_pay
 733
 734 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
 735 payment.
 736
 737 =cut
 738
 739 sub cust_bill_pay {
 740   my $self = shift;
 741   map { $_ } #return $self->num_cust_bill_pay unless wantarray;
 742   sort {    $a->_date  <=> $b->_date
 743          || $a->invnum <=> $b->invnum }
 744     qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
 745   ;
 746 }
 747
 748 =item cust_pay_refund
 749
 750 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
 751 payment.
 752
 753 =cut
 754
 755 sub cust_pay_refund {
 756   my $self = shift;
 757   map { $_ } #return $self->num_cust_pay_refund unless wantarray;
 758   sort { $a->_date <=> $b->_date }
 759     qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
 760   ;
 761 }
 762
 763
 764 =item unapplied
 765
 766 Returns the amount of this payment that is still unapplied; which is
 767 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
 768 applications (see L<FS::cust_pay_refund>).
 769
 770 =cut
 771
 772 sub unapplied {
 773   my $self = shift;
 774   my $amount = $self->paid;
 775   $amount -= $_->amount foreach ( $self->cust_bill_pay );
 776   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 777   sprintf("%.2f", $amount );
 778 }
 779
 780 =item unrefunded
 781
 782 Returns the amount of this payment that has not been refuned; which is
 783 paid minus all  refund applications (see L<FS::cust_pay_refund>).
 784
 785 =cut
 786
 787 sub unrefunded {
 788   my $self = shift;
 789   my $amount = $self->paid;
 790   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 791   sprintf("%.2f", $amount );
 792 }
 793
 794 =item amount
 795
 796 Returns the "paid" field.
 797
 798 =cut
 799
 800 sub amount {
 801   my $self = shift;
 802   $self->paid();
 803 }
 804
 805 =back
 806
 807 =head1 CLASS METHODS
 808
 809 =over 4
 810
 811 =item batch_insert CUST_PAY_OBJECT, ...
 812
 813 Class method which inserts multiple payments.  Takes a list of FS::cust_pay
 814 objects.  Returns a list, each element representing the status of inserting the
 815 corresponding payment - empty.  If there is an error inserting any payment, the
 816 entire transaction is rolled back, i.e. all payments are inserted or none are.
 817
 818 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
 819 reference to an array of (uninserted) FS::cust_bill_pay objects.  If so,
 820 those objects will be inserted with the paynum of the payment, and for
 821 each one, an error message or an empty string will be inserted into the
 822 list of errors.
 823
 824 For example:
 825
 826   my @errors = FS::cust_pay->batch_insert(@cust_pay);
 827   my $num_errors = scalar(grep $_, @errors);
 828   if ( $num_errors == 0 ) {
 829     #success; all payments were inserted
 830   } else {
 831     #failure; no payments were inserted.
 832   }
 833
 834 =cut
 835
 836 sub batch_insert {
 837   my $self = shift; #class method
 838
 839   local $SIG{HUP} = 'IGNORE';
 840   local $SIG{INT} = 'IGNORE';
 841   local $SIG{QUIT} = 'IGNORE';
 842   local $SIG{TERM} = 'IGNORE';
 843   local $SIG{TSTP} = 'IGNORE';
 844   local $SIG{PIPE} = 'IGNORE';
 845
 846   my $oldAutoCommit = $FS::UID::AutoCommit;
 847   local $FS::UID::AutoCommit = 0;
 848   my $dbh = dbh;
 849
 850   my $num_errors = 0;
 851
 852   my @errors;
 853   foreach my $cust_pay (@_) {
 854     my $error = $cust_pay->insert( 'manual' => 1 );
 855     push @errors, $error;
 856     $num_errors++ if $error;
 857
 858     if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
 859
 860       foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
 861         if ( $error ) { # insert placeholders if cust_pay wasn't inserted
 862           push @errors, '';
 863         }
 864         else {
 865           $cust_bill_pay->set('paynum', $cust_pay->paynum);
 866           my $apply_error = $cust_bill_pay->insert;
 867           push @errors, $apply_error || '';
 868           $num_errors++ if $apply_error;
 869         }
 870       }
 871
 872     } elsif ( !$error ) { #normal case: apply payments as usual
 873       $cust_pay->cust_main->apply_payments;
 874     }
 875
 876   }
 877
 878   if ( $num_errors ) {
 879     $dbh->rollback if $oldAutoCommit;
 880   } else {
 881     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 882   }
 883
 884   @errors;
 885
 886 }
 887
 888 =item unapplied_sql
 889
 890 Returns an SQL fragment to retreive the unapplied amount.
 891
 892 =cut
 893
 894 sub unapplied_sql {
 895   my ($class, $start, $end) = @_;
 896   my $bill_start   = $start ? "AND cust_bill_pay._date <= $start"   : '';
 897   my $bill_end     = $end   ? "AND cust_bill_pay._date > $end"     : '';
 898   my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
 899   my $refund_end   = $end   ? "AND cust_pay_refund._date > $end"   : '';
 900
 901   "paid
 902         - COALESCE(
 903                     ( SELECT SUM(amount) FROM cust_bill_pay
 904                         WHERE cust_pay.paynum = cust_bill_pay.paynum
 905                         $bill_start $bill_end )
 906                     ,0
 907                   )
 908         - COALESCE(
 909                     ( SELECT SUM(amount) FROM cust_pay_refund
 910                         WHERE cust_pay.paynum = cust_pay_refund.paynum
 911                         $refund_start $refund_end )
 912                     ,0
 913                   )
 914   ";
 915
 916 }
 917
 918 # _upgrade_data
 919 #
 920 # Used by FS::Upgrade to migrate to a new database.
 921
 922 use FS::h_cust_pay;
 923
 924 sub _upgrade_data {  #class method
 925   my ($class, %opts) = @_;
 926
 927   warn "$me upgrading $class\n" if $DEBUG;
 928
 929   local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
 930
 931   ##
 932   # otaker/ivan upgrade
 933   ##
 934
 935   unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
 936
 937     #not the most efficient, but hey, it only has to run once
 938
 939     my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ".
 940                 "  AND usernum IS NULL ".
 941                 "  AND 0 < ( SELECT COUNT(*) FROM cust_main                 ".
 942                 "              WHERE cust_main.custnum = cust_pay.custnum ) ";
 943
 944     my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
 945
 946     my $sth = dbh->prepare($count_sql) or die dbh->errstr;
 947     $sth->execute or die $sth->errstr;
 948     my $total = $sth->fetchrow_arrayref->[0];
 949     #warn "$total cust_pay records to update\n"
 950     #  if $DEBUG;
 951     local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
 952
 953     my $count = 0;
 954     my $lastprog = 0;
 955
 956     my @cust_pay = qsearch( {
 957         'table'     => 'cust_pay',
 958         'hashref'   => {},
 959         'extra_sql' => $where,
 960         'order_by'  => 'ORDER BY paynum',
 961     } );
 962
 963     foreach my $cust_pay (@cust_pay) {
 964
 965       my $h_cust_pay = $cust_pay->h_search('insert');
 966       if ( $h_cust_pay ) {
 967         next if $cust_pay->otaker eq $h_cust_pay->history_user;
 968         #$cust_pay->otaker($h_cust_pay->history_user);
 969         $cust_pay->set('otaker', $h_cust_pay->history_user);
 970       } else {
 971         $cust_pay->set('otaker', 'legacy');
 972       }
 973
 974       delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
 975       my $error = $cust_pay->replace;
 976
 977       if ( $error ) {
 978         warn " *** WARNING: Error updating order taker for payment paynum ".
 979              $cust_pay->paynun. ": $error\n";
 980         next;
 981       }
 982
 983       $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
 984
 985       $count++;
 986       if ( $DEBUG > 1 && $lastprog + 30 < time ) {
 987         warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
 988         $lastprog = time;
 989       }
 990
 991     }
 992
 993     FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
 994   }
 995
 996   ###
 997   # payinfo N/A upgrade
 998   ###
 999
1000   unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1001
1002     #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1003
1004     my @na_cust_pay = qsearch( {
1005       'table'     => 'cust_pay',
1006       'hashref'   => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1007       'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1008     } );
1009
1010     foreach my $na ( @na_cust_pay ) {
1011
1012       next unless $na->payinfo eq 'N/A';
1013
1014       my $cust_pay_pending =
1015         qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1016       unless ( $cust_pay_pending ) {
1017         warn " *** WARNING: not-yet recoverable N/A card for payment ".
1018              $na->paynum. " (no cust_pay_pending)\n";
1019         next;
1020       }
1021       $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1022       my $error = $na->replace;
1023       if ( $error ) {
1024         warn " *** WARNING: Error updating payinfo for payment paynum ".
1025              $na->paynun. ": $error\n";
1026         next;
1027       }
1028
1029     }
1030
1031     FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1032   }
1033
1034   ###
1035   # otaker->usernum upgrade
1036   ###
1037
1038   delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1039   $class->_upgrade_otaker(%opts);
1040   $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1041
1042   ###
1043   # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1044   ###
1045   my $search = FS::Cursor->new( {
1046     'table'     => 'cust_pay',
1047     'addl_from' => ' JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS text) ',
1048   } );
1049   while (my $cust_pay = $search->fetch) {
1050     $cust_pay->set('batchnum' => $cust_pay->paybatch);
1051     $cust_pay->set('paybatch' => '');
1052     my $error = $cust_pay->replace;
1053     warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n  $error"
1054     if $error;
1055   }
1056
1057   ###
1058   # migrate gateway info from the misused 'paybatch' field
1059   ###
1060
1061   # not only cust_pay, but also voided and refunded payments
1062   if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1063     local $FS::Record::nowarn_classload=1;
1064     # really inefficient, but again, only has to run once
1065     foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1066       my $and_batchnum_is_null =
1067         ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1068       my $search = FS::Cursor->new({
1069         table     => $table,
1070         extra_sql => "WHERE payby IN('CARD','CHEK') ".
1071                      "AND (paybatch IS NOT NULL ".
1072                      "OR (paybatch IS NULL AND auth IS NULL
1073                      $and_batchnum_is_null ) )",
1074       });
1075       while ( my $object = $search->fetch ) {
1076         if ( $object->paybatch eq '' ) {
1077           # repair for a previous upgrade that didn't save 'auth'
1078           my $pkey = $object->primary_key;
1079           # find the last history record that had a paybatch value
1080           my $h = qsearchs({
1081               table   => "h_$table",
1082               hashref => {
1083                 $pkey     => $object->$pkey,
1084                 paybatch  => { op=>'!=', value=>''},
1085                 history_action => 'replace_old',
1086               },
1087               order_by => 'ORDER BY history_date DESC LIMIT 1',
1088           });
1089           if (!$h) {
1090             warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1091             next;
1092           }
1093           # if the paybatch didn't have an auth string, then it's fine
1094           $h->paybatch =~ /:(\w+):/ or next;
1095           # set paybatch to what it was in that record
1096           $object->set('paybatch', $h->paybatch)
1097           # and then upgrade it like the old records
1098         }
1099
1100         my $parsed = $object->_parse_paybatch;
1101         if (keys %$parsed) {
1102           $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1103           $object->set('auth' => $parsed->{authorization});
1104           $object->set('paybatch', '');
1105           my $error = $object->replace;
1106           warn "error parsing CARD/CHEK paybatch fields on $object #".
1107             $object->get($object->primary_key).":\n  $error\n"
1108             if $error;
1109         }
1110       } #$object
1111     } #$table
1112     FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1113   }
1114 }
1115
1116 =back
1117
1118 =head1 SUBROUTINES
1119
1120 =over 4
1121
1122 =item batch_import HASHREF
1123
1124 Inserts new payments.
1125
1126 =cut
1127
1128 sub batch_import {
1129   my $param = shift;
1130
1131   my $fh       = $param->{filehandle};
1132   my $format   = $param->{'format'};
1133
1134   my $agentnum = $param->{agentnum};
1135   my $_date    = $param->{_date};
1136   $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1137   my $paybatch = $param->{'paybatch'};
1138
1139   my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1140   my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1141
1142   # here is the agent virtualization
1143   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1144
1145   my @fields;
1146   my $payby;
1147   if ( $format eq 'simple' ) {
1148     @fields = qw( custnum agent_custid paid payinfo );
1149     $payby = 'BILL';
1150   } elsif ( $format eq 'extended' ) {
1151     die "unimplemented\n";
1152     @fields = qw( );
1153     $payby = 'BILL';
1154   } else {
1155     die "unknown format $format";
1156   }
1157
1158   eval "use Text::CSV_XS;";
1159   die $@ if $@;
1160
1161   my $csv = new Text::CSV_XS;
1162
1163   my $imported = 0;
1164
1165   local $SIG{HUP} = 'IGNORE';
1166   local $SIG{INT} = 'IGNORE';
1167   local $SIG{QUIT} = 'IGNORE';
1168   local $SIG{TERM} = 'IGNORE';
1169   local $SIG{TSTP} = 'IGNORE';
1170   local $SIG{PIPE} = 'IGNORE';
1171
1172   my $oldAutoCommit = $FS::UID::AutoCommit;
1173   local $FS::UID::AutoCommit = 0;
1174   my $dbh = dbh;
1175
1176   my $line;
1177   while ( defined($line=<$fh>) ) {
1178
1179     $csv->parse($line) or do {
1180       $dbh->rollback if $oldAutoCommit;
1181       return "can't parse: ". $csv->error_input();
1182     };
1183
1184     my @columns = $csv->fields();
1185
1186     my %cust_pay = (
1187       payby    => $payby,
1188       paybatch => $paybatch,
1189     );
1190     $cust_pay{_date} = $_date if $_date;
1191
1192     my $cust_main;
1193     foreach my $field ( @fields ) {
1194
1195       if ( $field eq 'agent_custid'
1196         && $agentnum
1197         && $columns[0] =~ /\S+/ )
1198       {
1199
1200         my $agent_custid = $columns[0];
1201         my %hash = ( 'agent_custid' => $agent_custid,
1202                      'agentnum'     => $agentnum,
1203                    );
1204
1205         if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1206           $dbh->rollback if $oldAutoCommit;
1207           return "can't specify custnum with agent_custid $agent_custid";
1208         }
1209
1210         $cust_main = qsearchs({
1211                                 'table'     => 'cust_main',
1212                                 'hashref'   => \%hash,
1213                                 'extra_sql' => $extra_sql,
1214                              });
1215
1216         unless ( $cust_main ) {
1217           $dbh->rollback if $oldAutoCommit;
1218           return "can't find customer with agent_custid $agent_custid";
1219         }
1220
1221         $field = 'custnum';
1222         $columns[0] = $cust_main->custnum;
1223       }
1224
1225       $cust_pay{$field} = shift @columns;
1226     }
1227
1228     if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1229                          && length($1) == $custnum_length ) {
1230       $cust_pay{custnum} = $2;
1231     }
1232
1233     my $cust_pay = new FS::cust_pay( \%cust_pay );
1234     my $error = $cust_pay->insert;
1235
1236     if ( $error ) {
1237       $dbh->rollback if $oldAutoCommit;
1238       return "can't insert payment for $line: $error";
1239     }
1240
1241     if ( $format eq 'simple' ) {
1242       # include agentnum for less surprise?
1243       $cust_main = qsearchs({
1244                              'table'     => 'cust_main',
1245                              'hashref'   => { 'custnum' => $cust_pay->custnum },
1246                              'extra_sql' => $extra_sql,
1247                            })
1248         unless $cust_main;
1249
1250       unless ( $cust_main ) {
1251         $dbh->rollback if $oldAutoCommit;
1252         return "can't find customer to which payments apply at line: $line";
1253       }
1254
1255       $error = $cust_main->apply_payments_and_credits;
1256       if ( $error ) {
1257         $dbh->rollback if $oldAutoCommit;
1258         return "can't apply payments to customer for $line: $error";
1259       }
1260
1261     }
1262
1263     $imported++;
1264   }
1265
1266   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1267
1268   return "Empty file!" unless $imported;
1269
1270   ''; #no error
1271
1272 }
1273
1274 =back
1275
1276 =head1 BUGS
1277
1278 Delete and replace methods.
1279
1280 =head1 SEE ALSO
1281
1282 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1283 schema.html from the base documentation.
1284
1285 =cut
1286
1287 1;
1288