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       );
 654
 655     } elsif ( $conf->exists('payment_receipt_email') ) {
 656
 657       my $receipt_template = new Text::Template (
 658         TYPE   => 'ARRAY',
 659         SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
 660       ) or do {
 661         warn "can't create payment receipt template: $Text::Template::ERROR";
 662         return '';
 663       };
 664
 665       my $payby = $self->payby;
 666       my $payinfo = $self->payinfo;
 667       $payby =~ s/^BILL$/Check/ if $payinfo;
 668       if ( $payby eq 'CARD' || $payby eq 'CHEK' ) {
 669         $payinfo = $self->paymask
 670       } else {
 671         $payinfo = $self->decrypt($payinfo);
 672       }
 673       $payby =~ s/^CHEK$/Electronic check/;
 674
 675       my %fill_in = (
 676         'date'         => time2str("%a %B %o, %Y", $self->_date),
 677         'name'         => $cust_main->name,
 678         'paynum'       => $self->paynum,
 679         'paid'         => sprintf("%.2f", $self->paid),
 680         'payby'        => ucfirst(lc($payby)),
 681         'payinfo'      => $payinfo,
 682         'balance'      => $cust_main->balance,
 683         'company_name' => $conf->config('company_name', $cust_main->agentnum),
 684       );
 685
 686       if ( $opt->{'cust_pkg'} ) {
 687         $fill_in{'pkg'} = $opt->{'cust_pkg'}->part_pkg->pkg;
 688         #setup date, other things?
 689       }
 690
 691       my $queue = new FS::queue {
 692         'job'     => 'FS::Misc::process_send_generated_email',
 693         'paynum'  => $self->paynum,
 694         'custnum' => $cust_main->custnum,
 695       };
 696       $error = $queue->insert(
 697         'from'    => $conf->config('invoice_from', $cust_main->agentnum),
 698                                    #invoice_from??? well as good as any
 699         'to'      => \@invoicing_list,
 700         'subject' => 'Payment receipt',
 701         'body'    => [ $receipt_template->fill_in( HASH => \%fill_in ) ],
 702       );
 703
 704     } else {
 705
 706       warn "payment_receipt is on, but no payment_receipt_msgnum\n";
 707
 708     }
 709
 710   } elsif ( ! $cust_main->invoice_noemail ) { #not manual
 711
 712     my $queue = new FS::queue {
 713        'job'     => 'FS::cust_bill::queueable_email',
 714        'paynum'  => $self->paynum,
 715        'custnum' => $cust_main->custnum,
 716     };
 717
 718     $error = $queue->insert(
 719       'invnum'      => $cust_bill->invnum,
 720       'template'    => 'statement',
 721       'notice_name' => 'Statement',
 722       'no_coupon'   => 1,
 723     );
 724
 725   }
 726
 727   warn "send_receipt: $error\n" if $error;
 728 }
 729
 730 =item cust_bill_pay
 731
 732 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
 733 payment.
 734
 735 =cut
 736
 737 sub cust_bill_pay {
 738   my $self = shift;
 739   map { $_ } #return $self->num_cust_bill_pay unless wantarray;
 740   sort {    $a->_date  <=> $b->_date
 741          || $a->invnum <=> $b->invnum }
 742     qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
 743   ;
 744 }
 745
 746 =item cust_pay_refund
 747
 748 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
 749 payment.
 750
 751 =cut
 752
 753 sub cust_pay_refund {
 754   my $self = shift;
 755   map { $_ } #return $self->num_cust_pay_refund unless wantarray;
 756   sort { $a->_date <=> $b->_date }
 757     qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
 758   ;
 759 }
 760
 761
 762 =item unapplied
 763
 764 Returns the amount of this payment that is still unapplied; which is
 765 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
 766 applications (see L<FS::cust_pay_refund>).
 767
 768 =cut
 769
 770 sub unapplied {
 771   my $self = shift;
 772   my $amount = $self->paid;
 773   $amount -= $_->amount foreach ( $self->cust_bill_pay );
 774   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 775   sprintf("%.2f", $amount );
 776 }
 777
 778 =item unrefunded
 779
 780 Returns the amount of this payment that has not been refuned; which is
 781 paid minus all  refund applications (see L<FS::cust_pay_refund>).
 782
 783 =cut
 784
 785 sub unrefunded {
 786   my $self = shift;
 787   my $amount = $self->paid;
 788   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 789   sprintf("%.2f", $amount );
 790 }
 791
 792 =item amount
 793
 794 Returns the "paid" field.
 795
 796 =cut
 797
 798 sub amount {
 799   my $self = shift;
 800   $self->paid();
 801 }
 802
 803 =back
 804
 805 =head1 CLASS METHODS
 806
 807 =over 4
 808
 809 =item batch_insert CUST_PAY_OBJECT, ...
 810
 811 Class method which inserts multiple payments.  Takes a list of FS::cust_pay
 812 objects.  Returns a list, each element representing the status of inserting the
 813 corresponding payment - empty.  If there is an error inserting any payment, the
 814 entire transaction is rolled back, i.e. all payments are inserted or none are.
 815
 816 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
 817 reference to an array of (uninserted) FS::cust_bill_pay objects.  If so,
 818 those objects will be inserted with the paynum of the payment, and for
 819 each one, an error message or an empty string will be inserted into the
 820 list of errors.
 821
 822 For example:
 823
 824   my @errors = FS::cust_pay->batch_insert(@cust_pay);
 825   my $num_errors = scalar(grep $_, @errors);
 826   if ( $num_errors == 0 ) {
 827     #success; all payments were inserted
 828   } else {
 829     #failure; no payments were inserted.
 830   }
 831
 832 =cut
 833
 834 sub batch_insert {
 835   my $self = shift; #class method
 836
 837   local $SIG{HUP} = 'IGNORE';
 838   local $SIG{INT} = 'IGNORE';
 839   local $SIG{QUIT} = 'IGNORE';
 840   local $SIG{TERM} = 'IGNORE';
 841   local $SIG{TSTP} = 'IGNORE';
 842   local $SIG{PIPE} = 'IGNORE';
 843
 844   my $oldAutoCommit = $FS::UID::AutoCommit;
 845   local $FS::UID::AutoCommit = 0;
 846   my $dbh = dbh;
 847
 848   my $num_errors = 0;
 849
 850   my @errors;
 851   foreach my $cust_pay (@_) {
 852     my $error = $cust_pay->insert( 'manual' => 1 );
 853     push @errors, $error;
 854     $num_errors++ if $error;
 855
 856     if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
 857
 858       foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
 859         if ( $error ) { # insert placeholders if cust_pay wasn't inserted
 860           push @errors, '';
 861         }
 862         else {
 863           $cust_bill_pay->set('paynum', $cust_pay->paynum);
 864           my $apply_error = $cust_bill_pay->insert;
 865           push @errors, $apply_error || '';
 866           $num_errors++ if $apply_error;
 867         }
 868       }
 869
 870     } elsif ( !$error ) { #normal case: apply payments as usual
 871       $cust_pay->cust_main->apply_payments;
 872     }
 873
 874   }
 875
 876   if ( $num_errors ) {
 877     $dbh->rollback if $oldAutoCommit;
 878   } else {
 879     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 880   }
 881
 882   @errors;
 883
 884 }
 885
 886 =item unapplied_sql
 887
 888 Returns an SQL fragment to retreive the unapplied amount.
 889
 890 =cut
 891
 892 sub unapplied_sql {
 893   my ($class, $start, $end) = @_;
 894   my $bill_start   = $start ? "AND cust_bill_pay._date <= $start"   : '';
 895   my $bill_end     = $end   ? "AND cust_bill_pay._date > $end"     : '';
 896   my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
 897   my $refund_end   = $end   ? "AND cust_pay_refund._date > $end"   : '';
 898
 899   "paid
 900         - COALESCE(
 901                     ( SELECT SUM(amount) FROM cust_bill_pay
 902                         WHERE cust_pay.paynum = cust_bill_pay.paynum
 903                         $bill_start $bill_end )
 904                     ,0
 905                   )
 906         - COALESCE(
 907                     ( SELECT SUM(amount) FROM cust_pay_refund
 908                         WHERE cust_pay.paynum = cust_pay_refund.paynum
 909                         $refund_start $refund_end )
 910                     ,0
 911                   )
 912   ";
 913
 914 }
 915
 916 # _upgrade_data
 917 #
 918 # Used by FS::Upgrade to migrate to a new database.
 919
 920 use FS::h_cust_pay;
 921
 922 sub _upgrade_data {  #class method
 923   my ($class, %opts) = @_;
 924
 925   warn "$me upgrading $class\n" if $DEBUG;
 926
 927   local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
 928
 929   ##
 930   # otaker/ivan upgrade
 931   ##
 932
 933   unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
 934
 935     #not the most efficient, but hey, it only has to run once
 936
 937     my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ".
 938                 "  AND usernum IS NULL ".
 939                 "  AND 0 < ( SELECT COUNT(*) FROM cust_main                 ".
 940                 "              WHERE cust_main.custnum = cust_pay.custnum ) ";
 941
 942     my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
 943
 944     my $sth = dbh->prepare($count_sql) or die dbh->errstr;
 945     $sth->execute or die $sth->errstr;
 946     my $total = $sth->fetchrow_arrayref->[0];
 947     #warn "$total cust_pay records to update\n"
 948     #  if $DEBUG;
 949     local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
 950
 951     my $count = 0;
 952     my $lastprog = 0;
 953
 954     my @cust_pay = qsearch( {
 955         'table'     => 'cust_pay',
 956         'hashref'   => {},
 957         'extra_sql' => $where,
 958         'order_by'  => 'ORDER BY paynum',
 959     } );
 960
 961     foreach my $cust_pay (@cust_pay) {
 962
 963       my $h_cust_pay = $cust_pay->h_search('insert');
 964       if ( $h_cust_pay ) {
 965         next if $cust_pay->otaker eq $h_cust_pay->history_user;
 966         #$cust_pay->otaker($h_cust_pay->history_user);
 967         $cust_pay->set('otaker', $h_cust_pay->history_user);
 968       } else {
 969         $cust_pay->set('otaker', 'legacy');
 970       }
 971
 972       delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
 973       my $error = $cust_pay->replace;
 974
 975       if ( $error ) {
 976         warn " *** WARNING: Error updating order taker for payment paynum ".
 977              $cust_pay->paynun. ": $error\n";
 978         next;
 979       }
 980
 981       $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
 982
 983       $count++;
 984       if ( $DEBUG > 1 && $lastprog + 30 < time ) {
 985         warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
 986         $lastprog = time;
 987       }
 988
 989     }
 990
 991     FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
 992   }
 993
 994   ###
 995   # payinfo N/A upgrade
 996   ###
 997
 998   unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
 999
1000     #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1001
1002     my @na_cust_pay = qsearch( {
1003       'table'     => 'cust_pay',
1004       'hashref'   => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1005       'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1006     } );
1007
1008     foreach my $na ( @na_cust_pay ) {
1009
1010       next unless $na->payinfo eq 'N/A';
1011
1012       my $cust_pay_pending =
1013         qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1014       unless ( $cust_pay_pending ) {
1015         warn " *** WARNING: not-yet recoverable N/A card for payment ".
1016              $na->paynum. " (no cust_pay_pending)\n";
1017         next;
1018       }
1019       $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1020       my $error = $na->replace;
1021       if ( $error ) {
1022         warn " *** WARNING: Error updating payinfo for payment paynum ".
1023              $na->paynun. ": $error\n";
1024         next;
1025       }
1026
1027     }
1028
1029     FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1030   }
1031
1032   ###
1033   # otaker->usernum upgrade
1034   ###
1035
1036   delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1037   $class->_upgrade_otaker(%opts);
1038   $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1039
1040   ###
1041   # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1042   ###
1043   my $search = FS::Cursor->new( {
1044     'table'     => 'cust_pay',
1045     'addl_from' => ' JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS text) ',
1046   } );
1047   while (my $cust_pay = $search->fetch) {
1048     $cust_pay->set('batchnum' => $cust_pay->paybatch);
1049     $cust_pay->set('paybatch' => '');
1050     my $error = $cust_pay->replace;
1051     warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n  $error"
1052     if $error;
1053   }
1054
1055   ###
1056   # migrate gateway info from the misused 'paybatch' field
1057   ###
1058
1059   # not only cust_pay, but also voided and refunded payments
1060   if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1061     local $FS::Record::nowarn_classload=1;
1062     # really inefficient, but again, only has to run once
1063     foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1064       my $and_batchnum_is_null =
1065         ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1066       my $search = FS::Cursor->new({
1067         table     => $table,
1068         extra_sql => "WHERE payby IN('CARD','CHEK') ".
1069                      "AND (paybatch IS NOT NULL ".
1070                      "OR (paybatch IS NULL AND auth IS NULL
1071                      $and_batchnum_is_null ) )",
1072       });
1073       while ( my $object = $search->fetch ) {
1074         if ( $object->paybatch eq '' ) {
1075           # repair for a previous upgrade that didn't save 'auth'
1076           my $pkey = $object->primary_key;
1077           # find the last history record that had a paybatch value
1078           my $h = qsearchs({
1079               table   => "h_$table",
1080               hashref => {
1081                 $pkey     => $object->$pkey,
1082                 paybatch  => { op=>'!=', value=>''},
1083                 history_action => 'replace_old',
1084               },
1085               order_by => 'ORDER BY history_date DESC LIMIT 1',
1086           });
1087           if (!$h) {
1088             warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1089             next;
1090           }
1091           # if the paybatch didn't have an auth string, then it's fine
1092           $h->paybatch =~ /:(\w+):/ or next;
1093           # set paybatch to what it was in that record
1094           $object->set('paybatch', $h->paybatch)
1095           # and then upgrade it like the old records
1096         }
1097
1098         my $parsed = $object->_parse_paybatch;
1099         if (keys %$parsed) {
1100           $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1101           $object->set('auth' => $parsed->{authorization});
1102           $object->set('paybatch', '');
1103           my $error = $object->replace;
1104           warn "error parsing CARD/CHEK paybatch fields on $object #".
1105             $object->get($object->primary_key).":\n  $error\n"
1106             if $error;
1107         }
1108       } #$object
1109     } #$table
1110     FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1111   }
1112 }
1113
1114 =back
1115
1116 =head1 SUBROUTINES
1117
1118 =over 4
1119
1120 =item batch_import HASHREF
1121
1122 Inserts new payments.
1123
1124 =cut
1125
1126 sub batch_import {
1127   my $param = shift;
1128
1129   my $fh       = $param->{filehandle};
1130   my $format   = $param->{'format'};
1131
1132   my $agentnum = $param->{agentnum};
1133   my $_date    = $param->{_date};
1134   $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1135   my $paybatch = $param->{'paybatch'};
1136
1137   my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1138   my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1139
1140   # here is the agent virtualization
1141   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1142
1143   my @fields;
1144   my $payby;
1145   if ( $format eq 'simple' ) {
1146     @fields = qw( custnum agent_custid paid payinfo );
1147     $payby = 'BILL';
1148   } elsif ( $format eq 'extended' ) {
1149     die "unimplemented\n";
1150     @fields = qw( );
1151     $payby = 'BILL';
1152   } else {
1153     die "unknown format $format";
1154   }
1155
1156   eval "use Text::CSV_XS;";
1157   die $@ if $@;
1158
1159   my $csv = new Text::CSV_XS;
1160
1161   my $imported = 0;
1162
1163   local $SIG{HUP} = 'IGNORE';
1164   local $SIG{INT} = 'IGNORE';
1165   local $SIG{QUIT} = 'IGNORE';
1166   local $SIG{TERM} = 'IGNORE';
1167   local $SIG{TSTP} = 'IGNORE';
1168   local $SIG{PIPE} = 'IGNORE';
1169
1170   my $oldAutoCommit = $FS::UID::AutoCommit;
1171   local $FS::UID::AutoCommit = 0;
1172   my $dbh = dbh;
1173
1174   my $line;
1175   while ( defined($line=<$fh>) ) {
1176
1177     $csv->parse($line) or do {
1178       $dbh->rollback if $oldAutoCommit;
1179       return "can't parse: ". $csv->error_input();
1180     };
1181
1182     my @columns = $csv->fields();
1183
1184     my %cust_pay = (
1185       payby    => $payby,
1186       paybatch => $paybatch,
1187     );
1188     $cust_pay{_date} = $_date if $_date;
1189
1190     my $cust_main;
1191     foreach my $field ( @fields ) {
1192
1193       if ( $field eq 'agent_custid'
1194         && $agentnum
1195         && $columns[0] =~ /\S+/ )
1196       {
1197
1198         my $agent_custid = $columns[0];
1199         my %hash = ( 'agent_custid' => $agent_custid,
1200                      'agentnum'     => $agentnum,
1201                    );
1202
1203         if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1204           $dbh->rollback if $oldAutoCommit;
1205           return "can't specify custnum with agent_custid $agent_custid";
1206         }
1207
1208         $cust_main = qsearchs({
1209                                 'table'     => 'cust_main',
1210                                 'hashref'   => \%hash,
1211                                 'extra_sql' => $extra_sql,
1212                              });
1213
1214         unless ( $cust_main ) {
1215           $dbh->rollback if $oldAutoCommit;
1216           return "can't find customer with agent_custid $agent_custid";
1217         }
1218
1219         $field = 'custnum';
1220         $columns[0] = $cust_main->custnum;
1221       }
1222
1223       $cust_pay{$field} = shift @columns;
1224     }
1225
1226     if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1227                          && length($1) == $custnum_length ) {
1228       $cust_pay{custnum} = $2;
1229     }
1230
1231     my $cust_pay = new FS::cust_pay( \%cust_pay );
1232     my $error = $cust_pay->insert;
1233
1234     if ( $error ) {
1235       $dbh->rollback if $oldAutoCommit;
1236       return "can't insert payment for $line: $error";
1237     }
1238
1239     if ( $format eq 'simple' ) {
1240       # include agentnum for less surprise?
1241       $cust_main = qsearchs({
1242                              'table'     => 'cust_main',
1243                              'hashref'   => { 'custnum' => $cust_pay->custnum },
1244                              'extra_sql' => $extra_sql,
1245                            })
1246         unless $cust_main;
1247
1248       unless ( $cust_main ) {
1249         $dbh->rollback if $oldAutoCommit;
1250         return "can't find customer to which payments apply at line: $line";
1251       }
1252
1253       $error = $cust_main->apply_payments_and_credits;
1254       if ( $error ) {
1255         $dbh->rollback if $oldAutoCommit;
1256         return "can't apply payments to customer for $line: $error";
1257       }
1258
1259     }
1260
1261     $imported++;
1262   }
1263
1264   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1265
1266   return "Empty file!" unless $imported;
1267
1268   ''; #no error
1269
1270 }
1271
1272 =back
1273
1274 =head1 BUGS
1275
1276 Delete and replace methods.
1277
1278 =head1 SEE ALSO
1279
1280 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1281 schema.html from the base documentation.
1282
1283 =cut
1284
1285 1;
1286