FS/FS/cust_pay.pm

   1 package FS::cust_pay;
   2
   3 use strict;
   4 use base qw( FS::otaker_Mixin FS::payinfo_transaction_Mixin FS::cust_main_Mixin
   5              FS::Record );
   6 use vars qw( $DEBUG $me $conf @encrypted_fields
   7              $unsuspendauto $ignore_noapply
   8            );
   9 use Date::Format;
  10 use Business::CreditCard;
  11 use Text::Template;
  12 use FS::Misc::DateTime qw( parse_datetime ); #for batch_import
  13 use FS::Record qw( dbh qsearch qsearchs );
  14 use FS::CurrentUser;
  15 use FS::payby;
  16 use FS::cust_main_Mixin;
  17 use FS::payinfo_transaction_Mixin;
  18 use FS::cust_bill;
  19 use FS::cust_bill_pay;
  20 use FS::cust_pay_refund;
  21 use FS::cust_main;
  22 use FS::cust_pkg;
  23 use FS::cust_pay_void;
  24 use FS::upgrade_journal;
  25 use FS::Cursor;
  26
  27 $DEBUG = 0;
  28
  29 $me = '[FS::cust_pay]';
  30
  31 $ignore_noapply = 0;
  32
  33 #ask FS::UID to run this stuff for us later
  34 FS::UID->install_callback( sub {
  35   $conf = new FS::Conf;
  36   $unsuspendauto = $conf->exists('unsuspendauto');
  37 } );
  38
  39 @encrypted_fields = ('payinfo');
  40 sub nohistory_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 || $_[0]->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   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 474
 475   '';
 476
 477 }
 478
 479 =item replace [ OLD_RECORD ]
 480
 481 You can, but probably shouldn't modify payments...
 482
 483 Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
 484 supplied, replaces this record.  If there is an error, returns the error,
 485 otherwise returns false.
 486
 487 =cut
 488
 489 sub replace {
 490   my $self = shift;
 491   return "Can't modify closed payment" if $self->closed =~ /^Y/i;
 492   $self->SUPER::replace(@_);
 493 }
 494
 495 =item check
 496
 497 Checks all fields to make sure this is a valid payment.  If there is an error,
 498 returns the error, otherwise returns false.  Called by the insert method.
 499
 500 =cut
 501
 502 sub check {
 503   my $self = shift;
 504
 505   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
 506
 507   my $error =
 508     $self->ut_numbern('paynum')
 509     || $self->ut_numbern('custnum')
 510     || $self->ut_numbern('_date')
 511     || $self->ut_money('paid')
 512     || $self->ut_alphan('otaker')
 513     || $self->ut_textn('paybatch')
 514     || $self->ut_textn('payunique')
 515     || $self->ut_enum('closed', [ '', 'Y' ])
 516     || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
 517     || $self->ut_textn('bank')
 518     || $self->ut_alphan('depositor')
 519     || $self->ut_numbern('account')
 520     || $self->ut_numbern('teller')
 521     || $self->ut_foreign_keyn('batchnum', 'pay_batch', 'batchnum')
 522     || $self->payinfo_check()
 523   ;
 524   return $error if $error;
 525
 526   return "paid must be > 0 " if $self->paid <= 0;
 527
 528   return "unknown cust_main.custnum: ". $self->custnum
 529     unless $self->invnum
 530            || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 531
 532   $self->_date(time) unless $self->_date;
 533
 534   return "invalid discount_term"
 535    if ($self->discount_term && $self->discount_term < 2);
 536
 537   if ( $self->payby eq 'CASH' and $conf->exists('require_cash_deposit_info') ) {
 538     foreach (qw(bank depositor account teller)) {
 539       return "$_ required" if $self->get($_) eq '';
 540     }
 541   }
 542
 543 #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
 544 #  # UNIQUE index should catch this too, without race conditions, but this
 545 #  # should give a better error message the other 99.9% of the time...
 546 #  if ( length($self->payunique)
 547 #       && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
 548 #    #well, it *could* be a better error message
 549 #    return "duplicate transaction".
 550 #           " - a payment with unique identifer ". $self->payunique.
 551 #           " already exists";
 552 #  }
 553
 554   $self->SUPER::check;
 555 }
 556
 557 =item send_receipt HASHREF | OPTION => VALUE ...
 558
 559 Sends a payment receipt for this payment..
 560
 561 Available options:
 562
 563 =over 4
 564
 565 =item manual
 566
 567 Flag indicating the payment is being made manually.
 568
 569 =item cust_bill
 570
 571 Invoice (FS::cust_bill) object.  If not specified, the most recent invoice
 572 will be assumed.
 573
 574 =item cust_main
 575
 576 Customer (FS::cust_main) object (for efficiency).
 577
 578 =back
 579
 580 =cut
 581
 582 sub send_receipt {
 583   my $self = shift;
 584   my $opt = ref($_[0]) ? shift : { @_ };
 585
 586   my $cust_bill = $opt->{'cust_bill'};
 587   my $cust_main = $opt->{'cust_main'} || $self->cust_main;
 588
 589   my $conf = new FS::Conf;
 590
 591   return '' unless $conf->config_bool('payment_receipt', $cust_main->agentnum);
 592
 593   my @invoicing_list = $cust_main->invoicing_list_emailonly;
 594   return '' unless @invoicing_list;
 595
 596   $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
 597
 598   my $error = '';
 599
 600   if (    ( exists($opt->{'manual'}) && $opt->{'manual'} )
 601        #|| ! $conf->exists('invoice_html_statement')
 602        || ! $cust_bill
 603      )
 604   {
 605     my $msgnum = $conf->config('payment_receipt_msgnum', $cust_main->agentnum);
 606     if ( $msgnum ) {
 607
 608       my $queue = new FS::queue {
 609         'job'     => 'FS::Misc::process_send_email',
 610         'paynum'  => $self->paynum,
 611         'custnum' => $cust_main->custnum,
 612       };
 613       $error = $queue->insert(
 614          FS::msg_template->by_key($msgnum)->prepare(
 615           'cust_main'   => $cust_main,
 616           'object'      => $self,
 617           'from_config' => 'payment_receipt_from',
 618         )
 619       );
 620
 621     } elsif ( $conf->exists('payment_receipt_email') ) {
 622
 623       my $receipt_template = new Text::Template (
 624         TYPE   => 'ARRAY',
 625         SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
 626       ) or do {
 627         warn "can't create payment receipt template: $Text::Template::ERROR";
 628         return '';
 629       };
 630
 631       my $payby = $self->payby;
 632       my $payinfo = $self->payinfo;
 633       $payby =~ s/^BILL$/Check/ if $payinfo;
 634       if ( $payby eq 'CARD' || $payby eq 'CHEK' ) {
 635         $payinfo = $self->paymask
 636       } else {
 637         $payinfo = $self->decrypt($payinfo);
 638       }
 639       $payby =~ s/^CHEK$/Electronic check/;
 640
 641       my %fill_in = (
 642         'date'         => time2str("%a %B %o, %Y", $self->_date),
 643         'name'         => $cust_main->name,
 644         'paynum'       => $self->paynum,
 645         'paid'         => sprintf("%.2f", $self->paid),
 646         'payby'        => ucfirst(lc($payby)),
 647         'payinfo'      => $payinfo,
 648         'balance'      => $cust_main->balance,
 649         'company_name' => $conf->config('company_name', $cust_main->agentnum),
 650       );
 651
 652       if ( $opt->{'cust_pkg'} ) {
 653         $fill_in{'pkg'} = $opt->{'cust_pkg'}->part_pkg->pkg;
 654         #setup date, other things?
 655       }
 656
 657       my $queue = new FS::queue {
 658         'job'     => 'FS::Misc::process_send_generated_email',
 659         'paynum'  => $self->paynum,
 660         'custnum' => $cust_main->custnum,
 661       };
 662       $error = $queue->insert(
 663         'from'    => $conf->config('invoice_from', $cust_main->agentnum),
 664                                    #invoice_from??? well as good as any
 665         'to'      => \@invoicing_list,
 666         'subject' => 'Payment receipt',
 667         'body'    => [ $receipt_template->fill_in( HASH => \%fill_in ) ],
 668       );
 669
 670     } else {
 671
 672       warn "payment_receipt is on, but no payment_receipt_msgnum\n";
 673
 674     }
 675
 676   } elsif ( ! $cust_main->invoice_noemail ) { #not manual
 677
 678     my $queue = new FS::queue {
 679        'job'     => 'FS::cust_bill::queueable_email',
 680        'paynum'  => $self->paynum,
 681        'custnum' => $cust_main->custnum,
 682     };
 683
 684     $error = $queue->insert(
 685       'invnum'      => $cust_bill->invnum,
 686       'template'    => 'statement',
 687       'notice_name' => 'Statement',
 688       'no_coupon'   => 1,
 689     );
 690
 691   }
 692
 693   warn "send_receipt: $error\n" if $error;
 694 }
 695
 696 =item cust_bill_pay
 697
 698 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
 699 payment.
 700
 701 =cut
 702
 703 sub cust_bill_pay {
 704   my $self = shift;
 705   map { $_ } #return $self->num_cust_bill_pay unless wantarray;
 706   sort {    $a->_date  <=> $b->_date
 707          || $a->invnum <=> $b->invnum }
 708     qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
 709   ;
 710 }
 711
 712 =item cust_pay_refund
 713
 714 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
 715 payment.
 716
 717 =cut
 718
 719 sub cust_pay_refund {
 720   my $self = shift;
 721   map { $_ } #return $self->num_cust_pay_refund unless wantarray;
 722   sort { $a->_date <=> $b->_date }
 723     qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
 724   ;
 725 }
 726
 727
 728 =item unapplied
 729
 730 Returns the amount of this payment that is still unapplied; which is
 731 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
 732 applications (see L<FS::cust_pay_refund>).
 733
 734 =cut
 735
 736 sub unapplied {
 737   my $self = shift;
 738   my $amount = $self->paid;
 739   $amount -= $_->amount foreach ( $self->cust_bill_pay );
 740   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 741   sprintf("%.2f", $amount );
 742 }
 743
 744 =item unrefunded
 745
 746 Returns the amount of this payment that has not been refuned; which is
 747 paid minus all  refund applications (see L<FS::cust_pay_refund>).
 748
 749 =cut
 750
 751 sub unrefunded {
 752   my $self = shift;
 753   my $amount = $self->paid;
 754   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 755   sprintf("%.2f", $amount );
 756 }
 757
 758 =item amount
 759
 760 Returns the "paid" field.
 761
 762 =cut
 763
 764 sub amount {
 765   my $self = shift;
 766   $self->paid();
 767 }
 768
 769 =back
 770
 771 =head1 CLASS METHODS
 772
 773 =over 4
 774
 775 =item batch_insert CUST_PAY_OBJECT, ...
 776
 777 Class method which inserts multiple payments.  Takes a list of FS::cust_pay
 778 objects.  Returns a list, each element representing the status of inserting the
 779 corresponding payment - empty.  If there is an error inserting any payment, the
 780 entire transaction is rolled back, i.e. all payments are inserted or none are.
 781
 782 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
 783 reference to an array of (uninserted) FS::cust_bill_pay objects.  If so,
 784 those objects will be inserted with the paynum of the payment, and for
 785 each one, an error message or an empty string will be inserted into the
 786 list of errors.
 787
 788 For example:
 789
 790   my @errors = FS::cust_pay->batch_insert(@cust_pay);
 791   my $num_errors = scalar(grep $_, @errors);
 792   if ( $num_errors == 0 ) {
 793     #success; all payments were inserted
 794   } else {
 795     #failure; no payments were inserted.
 796   }
 797
 798 =cut
 799
 800 sub batch_insert {
 801   my $self = shift; #class method
 802
 803   local $SIG{HUP} = 'IGNORE';
 804   local $SIG{INT} = 'IGNORE';
 805   local $SIG{QUIT} = 'IGNORE';
 806   local $SIG{TERM} = 'IGNORE';
 807   local $SIG{TSTP} = 'IGNORE';
 808   local $SIG{PIPE} = 'IGNORE';
 809
 810   my $oldAutoCommit = $FS::UID::AutoCommit;
 811   local $FS::UID::AutoCommit = 0;
 812   my $dbh = dbh;
 813
 814   my $num_errors = 0;
 815
 816   my @errors;
 817   foreach my $cust_pay (@_) {
 818     my $error = $cust_pay->insert( 'manual' => 1 );
 819     push @errors, $error;
 820     $num_errors++ if $error;
 821
 822     if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
 823
 824       foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
 825         if ( $error ) { # insert placeholders if cust_pay wasn't inserted
 826           push @errors, '';
 827         }
 828         else {
 829           $cust_bill_pay->set('paynum', $cust_pay->paynum);
 830           my $apply_error = $cust_bill_pay->insert;
 831           push @errors, $apply_error || '';
 832           $num_errors++ if $apply_error;
 833         }
 834       }
 835
 836     } elsif ( !$error ) { #normal case: apply payments as usual
 837       $cust_pay->cust_main->apply_payments;
 838     }
 839
 840   }
 841
 842   if ( $num_errors ) {
 843     $dbh->rollback if $oldAutoCommit;
 844   } else {
 845     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 846   }
 847
 848   @errors;
 849
 850 }
 851
 852 =item unapplied_sql
 853
 854 Returns an SQL fragment to retreive the unapplied amount.
 855
 856 =cut
 857
 858 sub unapplied_sql {
 859   my ($class, $start, $end) = @_;
 860   my $bill_start   = $start ? "AND cust_bill_pay._date <= $start"   : '';
 861   my $bill_end     = $end   ? "AND cust_bill_pay._date > $end"     : '';
 862   my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
 863   my $refund_end   = $end   ? "AND cust_pay_refund._date > $end"   : '';
 864
 865   "paid
 866         - COALESCE(
 867                     ( SELECT SUM(amount) FROM cust_bill_pay
 868                         WHERE cust_pay.paynum = cust_bill_pay.paynum
 869                         $bill_start $bill_end )
 870                     ,0
 871                   )
 872         - COALESCE(
 873                     ( SELECT SUM(amount) FROM cust_pay_refund
 874                         WHERE cust_pay.paynum = cust_pay_refund.paynum
 875                         $refund_start $refund_end )
 876                     ,0
 877                   )
 878   ";
 879
 880 }
 881
 882 # _upgrade_data
 883 #
 884 # Used by FS::Upgrade to migrate to a new database.
 885
 886 use FS::h_cust_pay;
 887
 888 sub _upgrade_data {  #class method
 889   my ($class, %opts) = @_;
 890
 891   warn "$me upgrading $class\n" if $DEBUG;
 892
 893   local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
 894
 895   ##
 896   # otaker/ivan upgrade
 897   ##
 898
 899   unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
 900
 901     #not the most efficient, but hey, it only has to run once
 902
 903     my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ".
 904                 "  AND usernum IS NULL ".
 905                 "  AND 0 < ( SELECT COUNT(*) FROM cust_main                 ".
 906                 "              WHERE cust_main.custnum = cust_pay.custnum ) ";
 907
 908     my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
 909
 910     my $sth = dbh->prepare($count_sql) or die dbh->errstr;
 911     $sth->execute or die $sth->errstr;
 912     my $total = $sth->fetchrow_arrayref->[0];
 913     #warn "$total cust_pay records to update\n"
 914     #  if $DEBUG;
 915     local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
 916
 917     my $count = 0;
 918     my $lastprog = 0;
 919
 920     my @cust_pay = qsearch( {
 921         'table'     => 'cust_pay',
 922         'hashref'   => {},
 923         'extra_sql' => $where,
 924         'order_by'  => 'ORDER BY paynum',
 925     } );
 926
 927     foreach my $cust_pay (@cust_pay) {
 928
 929       my $h_cust_pay = $cust_pay->h_search('insert');
 930       if ( $h_cust_pay ) {
 931         next if $cust_pay->otaker eq $h_cust_pay->history_user;
 932         #$cust_pay->otaker($h_cust_pay->history_user);
 933         $cust_pay->set('otaker', $h_cust_pay->history_user);
 934       } else {
 935         $cust_pay->set('otaker', 'legacy');
 936       }
 937
 938       delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
 939       my $error = $cust_pay->replace;
 940
 941       if ( $error ) {
 942         warn " *** WARNING: Error updating order taker for payment paynum ".
 943              $cust_pay->paynun. ": $error\n";
 944         next;
 945       }
 946
 947       $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
 948
 949       $count++;
 950       if ( $DEBUG > 1 && $lastprog + 30 < time ) {
 951         warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
 952         $lastprog = time;
 953       }
 954
 955     }
 956
 957     FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
 958   }
 959
 960   ###
 961   # payinfo N/A upgrade
 962   ###
 963
 964   unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
 965
 966     #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
 967
 968     my @na_cust_pay = qsearch( {
 969       'table'     => 'cust_pay',
 970       'hashref'   => {}, #could be encrypted# { 'payinfo' => 'N/A' },
 971       'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
 972     } );
 973
 974     foreach my $na ( @na_cust_pay ) {
 975
 976       next unless $na->payinfo eq 'N/A';
 977
 978       my $cust_pay_pending =
 979         qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
 980       unless ( $cust_pay_pending ) {
 981         warn " *** WARNING: not-yet recoverable N/A card for payment ".
 982              $na->paynum. " (no cust_pay_pending)\n";
 983         next;
 984       }
 985       $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
 986       my $error = $na->replace;
 987       if ( $error ) {
 988         warn " *** WARNING: Error updating payinfo for payment paynum ".
 989              $na->paynun. ": $error\n";
 990         next;
 991       }
 992
 993     }
 994
 995     FS::upgrade_journal->set_done('cust_pay__payinfo_na');
 996   }
 997
 998   ###
 999   # otaker->usernum upgrade
1000   ###
1001
1002   delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1003   $class->_upgrade_otaker(%opts);
1004   $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1005
1006   ###
1007   # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1008   ###
1009   my $search = FS::Cursor->new( {
1010     'table'     => 'cust_pay',
1011     'addl_from' => ' JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS text) ',
1012   } );
1013   while (my $cust_pay = $search->fetch) {
1014     $cust_pay->set('batchnum' => $cust_pay->paybatch);
1015     $cust_pay->set('paybatch' => '');
1016     my $error = $cust_pay->replace;
1017     warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n  $error"
1018     if $error;
1019   }
1020
1021   ###
1022   # migrate gateway info from the misused 'paybatch' field
1023   ###
1024
1025   # not only cust_pay, but also voided and refunded payments
1026   if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1027     local $FS::Record::nowarn_classload=1;
1028     # really inefficient, but again, only has to run once
1029     foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1030       my $and_batchnum_is_null =
1031         ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1032       my $search = FS::Cursor->new({
1033         table     => $table,
1034         extra_sql => "WHERE payby IN('CARD','CHEK') ".
1035                      "AND (paybatch IS NOT NULL ".
1036                      "OR (paybatch IS NULL AND auth IS NULL
1037                      $and_batchnum_is_null ) )",
1038       });
1039       while ( my $object = $search->fetch ) {
1040         if ( $object->paybatch eq '' ) {
1041           # repair for a previous upgrade that didn't save 'auth'
1042           my $pkey = $object->primary_key;
1043           # find the last history record that had a paybatch value
1044           my $h = qsearchs({
1045               table   => "h_$table",
1046               hashref => {
1047                 $pkey     => $object->$pkey,
1048                 paybatch  => { op=>'!=', value=>''},
1049                 history_action => 'replace_old',
1050               },
1051               order_by => 'ORDER BY history_date DESC LIMIT 1',
1052           });
1053           if (!$h) {
1054             warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1055             next;
1056           }
1057           # if the paybatch didn't have an auth string, then it's fine
1058           $h->paybatch =~ /:(\w+):/ or next;
1059           # set paybatch to what it was in that record
1060           $object->set('paybatch', $h->paybatch)
1061           # and then upgrade it like the old records
1062         }
1063
1064         my $parsed = $object->_parse_paybatch;
1065         if (keys %$parsed) {
1066           $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1067           $object->set('auth' => $parsed->{authorization});
1068           $object->set('paybatch', '');
1069           my $error = $object->replace;
1070           warn "error parsing CARD/CHEK paybatch fields on $object #".
1071             $object->get($object->primary_key).":\n  $error\n"
1072             if $error;
1073         }
1074       } #$object
1075     } #$table
1076     FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1077   }
1078 }
1079
1080 =back
1081
1082 =head1 SUBROUTINES
1083
1084 =over 4
1085
1086 =item batch_import HASHREF
1087
1088 Inserts new payments.
1089
1090 =cut
1091
1092 sub batch_import {
1093   my $param = shift;
1094
1095   my $fh       = $param->{filehandle};
1096   my $format   = $param->{'format'};
1097
1098   my $agentnum = $param->{agentnum};
1099   my $_date    = $param->{_date};
1100   $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1101   my $paybatch = $param->{'paybatch'};
1102
1103   # here is the agent virtualization
1104   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1105
1106   my @fields;
1107   my $payby;
1108   if ( $format eq 'simple' ) {
1109     @fields = qw( custnum agent_custid paid payinfo );
1110     $payby = 'BILL';
1111   } elsif ( $format eq 'extended' ) {
1112     die "unimplemented\n";
1113     @fields = qw( );
1114     $payby = 'BILL';
1115   } else {
1116     die "unknown format $format";
1117   }
1118
1119   eval "use Text::CSV_XS;";
1120   die $@ if $@;
1121
1122   my $csv = new Text::CSV_XS;
1123
1124   my $imported = 0;
1125
1126   local $SIG{HUP} = 'IGNORE';
1127   local $SIG{INT} = 'IGNORE';
1128   local $SIG{QUIT} = 'IGNORE';
1129   local $SIG{TERM} = 'IGNORE';
1130   local $SIG{TSTP} = 'IGNORE';
1131   local $SIG{PIPE} = 'IGNORE';
1132
1133   my $oldAutoCommit = $FS::UID::AutoCommit;
1134   local $FS::UID::AutoCommit = 0;
1135   my $dbh = dbh;
1136
1137   my $line;
1138   while ( defined($line=<$fh>) ) {
1139
1140     $csv->parse($line) or do {
1141       $dbh->rollback if $oldAutoCommit;
1142       return "can't parse: ". $csv->error_input();
1143     };
1144
1145     my @columns = $csv->fields();
1146
1147     my %cust_pay = (
1148       payby    => $payby,
1149       paybatch => $paybatch,
1150     );
1151     $cust_pay{_date} = $_date if $_date;
1152
1153     my $cust_main;
1154     foreach my $field ( @fields ) {
1155
1156       if ( $field eq 'agent_custid'
1157         && $agentnum
1158         && $columns[0] =~ /\S+/ )
1159       {
1160
1161         my $agent_custid = $columns[0];
1162         my %hash = ( 'agent_custid' => $agent_custid,
1163                      'agentnum'     => $agentnum,
1164                    );
1165
1166         if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1167           $dbh->rollback if $oldAutoCommit;
1168           return "can't specify custnum with agent_custid $agent_custid";
1169         }
1170
1171         $cust_main = qsearchs({
1172                                 'table'     => 'cust_main',
1173                                 'hashref'   => \%hash,
1174                                 'extra_sql' => $extra_sql,
1175                              });
1176
1177         unless ( $cust_main ) {
1178           $dbh->rollback if $oldAutoCommit;
1179           return "can't find customer with agent_custid $agent_custid";
1180         }
1181
1182         $field = 'custnum';
1183         $columns[0] = $cust_main->custnum;
1184       }
1185
1186       $cust_pay{$field} = shift @columns;
1187     }
1188
1189     my $cust_pay = new FS::cust_pay( \%cust_pay );
1190     my $error = $cust_pay->insert;
1191
1192     if ( $error ) {
1193       $dbh->rollback if $oldAutoCommit;
1194       return "can't insert payment for $line: $error";
1195     }
1196
1197     if ( $format eq 'simple' ) {
1198       # include agentnum for less surprise?
1199       $cust_main = qsearchs({
1200                              'table'     => 'cust_main',
1201                              'hashref'   => { 'custnum' => $cust_pay->custnum },
1202                              'extra_sql' => $extra_sql,
1203                            })
1204         unless $cust_main;
1205
1206       unless ( $cust_main ) {
1207         $dbh->rollback if $oldAutoCommit;
1208         return "can't find customer to which payments apply at line: $line";
1209       }
1210
1211       $error = $cust_main->apply_payments_and_credits;
1212       if ( $error ) {
1213         $dbh->rollback if $oldAutoCommit;
1214         return "can't apply payments to customer for $line: $error";
1215       }
1216
1217     }
1218
1219     $imported++;
1220   }
1221
1222   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1223
1224   return "Empty file!" unless $imported;
1225
1226   ''; #no error
1227
1228 }
1229
1230 =back
1231
1232 =head1 BUGS
1233
1234 Delete and replace methods.
1235
1236 =head1 SEE ALSO
1237
1238 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1239 schema.html from the base documentation.
1240
1241 =cut
1242
1243 1;
1244