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