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