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