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