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