FS/FS/cust_pay.pm

   1 package FS::cust_pay;
   2
   3 use strict;
   4 use vars qw( @ISA $conf $unsuspendauto $ignore_noapply @encrypted_fields );
   5 use Date::Format;
   6 use Business::CreditCard;
   7 use Text::Template;
   8 use FS::Misc qw(send_email);
   9 use FS::Record qw( dbh qsearch qsearchs );
  10 use FS::payby;
  11 use FS::cust_main_Mixin;
  12 use FS::payinfo_Mixin;
  13 use FS::cust_bill;
  14 use FS::cust_bill_pay;
  15 use FS::cust_pay_refund;
  16 use FS::cust_main;
  17 use FS::cust_pay_void;
  18
  19 @ISA = qw(FS::Record FS::cust_main_Mixin FS::payinfo_Mixin  );
  20
  21 $ignore_noapply = 0;
  22
  23 #ask FS::UID to run this stuff for us later
  24 FS::UID->install_callback( sub {
  25   $conf = new FS::Conf;
  26   $unsuspendauto = $conf->exists('unsuspendauto');
  27 } );
  28
  29 @encrypted_fields = ('payinfo');
  30
  31 =head1 NAME
  32
  33 FS::cust_pay - Object methods for cust_pay objects
  34
  35 =head1 SYNOPSIS
  36
  37   use FS::cust_pay;
  38
  39   $record = new FS::cust_pay \%hash;
  40   $record = new FS::cust_pay { 'column' => 'value' };
  41
  42   $error = $record->insert;
  43
  44   $error = $new_record->replace($old_record);
  45
  46   $error = $record->delete;
  47
  48   $error = $record->check;
  49
  50 =head1 DESCRIPTION
  51
  52 An FS::cust_pay object represents a payment; the transfer of money from a
  53 customer.  FS::cust_pay inherits from FS::Record.  The following fields are
  54 currently supported:
  55
  56 =over 4
  57
  58 =item paynum - primary key (assigned automatically for new payments)
  59
  60 =item custnum - customer (see L<FS::cust_main>)
  61
  62 =item paid - Amount of this payment
  63
  64 =item _date - specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
  65 L<Time::Local> and L<Date::Parse> for conversion functions.
  66
  67 =item payby - Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
  68
  69 =item payinfo - Payment Information (See L<FS::payinfo_Mixin> for data format)
  70
  71 =item paymask - Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
  72
  73 =item paybatch - text field for tracking card processing or other batch grouping
  74
  75 =item payunique - Optional unique identifer to prevent duplicate transactions.
  76
  77 =item closed - books closed flag, empty or `Y'
  78
  79 =back
  80
  81 =head1 METHODS
  82
  83 =over 4
  84
  85 =item new HASHREF
  86
  87 Creates a new payment.  To add the payment to the databse, see L<"insert">.
  88
  89 =cut
  90
  91 sub table { 'cust_pay'; }
  92 sub cust_linked { $_[0]->cust_main_custnum; }
  93 sub cust_unlinked_msg {
  94   my $self = shift;
  95   "WARNING: can't find cust_main.custnum ". $self->custnum.
  96   ' (cust_pay.paynum '. $self->paynum. ')';
  97 }
  98
  99 =item insert
 100
 101 Adds this payment to the database.
 102
 103 For backwards-compatibility and convenience, if the additional field invnum
 104 is defined, an FS::cust_bill_pay record for the full amount of the payment
 105 will be created.  In this case, custnum is optional.  An hash of optional
 106 arguments may be passed.  Currently "manual" is supported.  If true, a
 107 payment receipt is sent instead of a statement when 'payment_receipt_email'
 108 configuration option is set.
 109
 110 =cut
 111
 112 sub insert {
 113   my ($self, %options) = @_;
 114
 115   local $SIG{HUP} = 'IGNORE';
 116   local $SIG{INT} = 'IGNORE';
 117   local $SIG{QUIT} = 'IGNORE';
 118   local $SIG{TERM} = 'IGNORE';
 119   local $SIG{TSTP} = 'IGNORE';
 120   local $SIG{PIPE} = 'IGNORE';
 121
 122   my $oldAutoCommit = $FS::UID::AutoCommit;
 123   local $FS::UID::AutoCommit = 0;
 124   my $dbh = dbh;
 125
 126   my $cust_bill;
 127   if ( $self->invnum ) {
 128     $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
 129       or do {
 130         $dbh->rollback if $oldAutoCommit;
 131         return "Unknown cust_bill.invnum: ". $self->invnum;
 132       };
 133     $self->custnum($cust_bill->custnum );
 134   }
 135
 136
 137   my $error = $self->check;
 138   return $error if $error;
 139
 140   my $cust_main = $self->cust_main;
 141   my $old_balance = $cust_main->balance;
 142
 143   $error = $self->SUPER::insert;
 144   if ( $error ) {
 145     $dbh->rollback if $oldAutoCommit;
 146     return "error inserting $self: $error";
 147   }
 148
 149   if ( $self->invnum ) {
 150     my $cust_bill_pay = new FS::cust_bill_pay {
 151       'invnum' => $self->invnum,
 152       'paynum' => $self->paynum,
 153       'amount' => $self->paid,
 154       '_date'  => $self->_date,
 155     };
 156     $error = $cust_bill_pay->insert;
 157     if ( $error ) {
 158       if ( $ignore_noapply ) {
 159         warn "warning: error inserting $cust_bill_pay: $error ".
 160              "(ignore_noapply flag set; inserting cust_pay record anyway)\n";
 161       } else {
 162         $dbh->rollback if $oldAutoCommit;
 163         return "error inserting $cust_bill_pay: $error";
 164       }
 165     }
 166   }
 167
 168   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 169
 170   #false laziness w/ cust_credit::insert
 171   if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
 172     my @errors = $cust_main->unsuspend;
 173     #return
 174     # side-fx with nested transactions?  upstack rolls back?
 175     warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
 176          join(' / ', @errors)
 177       if @errors;
 178   }
 179   #eslaf
 180
 181   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 182
 183   #my $cust_main = $self->cust_main;
 184   if ( $conf->exists('payment_receipt_email')
 185        && grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list
 186   ) {
 187
 188     $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
 189
 190     my $error;
 191     if (    ( exists($options{'manual'}) && $options{'manual'} )
 192          || ! $conf->exists('invoice_html_statement')
 193          || ! $cust_bill
 194        ) {
 195
 196       my $receipt_template = new Text::Template (
 197         TYPE   => 'ARRAY',
 198         SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
 199       ) or do {
 200         warn "can't create payment receipt template: $Text::Template::ERROR";
 201         return '';
 202       };
 203
 204       my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ }
 205                              $cust_main->invoicing_list;
 206
 207       my $payby = $self->payby;
 208       my $payinfo = $self->payinfo;
 209       $payby =~ s/^BILL$/Check/ if $payinfo;
 210       $payinfo = $self->paymask if $payby eq 'CARD' || $payby eq 'CHEK';
 211       $payby =~ s/^CHEK$/Electronic check/;
 212
 213       $error = send_email(
 214         'from'    => $conf->config('invoice_from'), #??? well as good as any
 215         'to'      => \@invoicing_list,
 216         'subject' => 'Payment receipt',
 217         'body'    => [ $receipt_template->fill_in( HASH => {
 218                        'date'    => time2str("%a %B %o, %Y", $self->_date),
 219                        'name'    => $cust_main->name,
 220                        'paynum'  => $self->paynum,
 221                        'paid'    => sprintf("%.2f", $self->paid),
 222                        'payby'   => ucfirst(lc($payby)),
 223                        'payinfo' => $payinfo,
 224                        'balance' => $cust_main->balance,
 225                      } ) ],
 226       );
 227
 228     } else {
 229
 230       my $queue = new FS::queue {
 231          'paynum' => $self->paynum,
 232          'job'    => 'FS::cust_bill::queueable_email',
 233       };
 234       $error = $queue->insert(
 235         'invnum' => $cust_bill->invnum,
 236         'template' => 'statement',
 237       );
 238
 239     }
 240
 241     if ( $error ) {
 242       warn "can't send payment receipt/statement: $error";
 243     }
 244
 245   }
 246
 247   '';
 248
 249 }
 250
 251 =item void [ REASON ]
 252
 253 Voids this payment: deletes the payment and all associated applications and
 254 adds a record of the voided payment to the FS::cust_pay_void table.
 255
 256 =cut
 257
 258 sub void {
 259   my $self = shift;
 260
 261   local $SIG{HUP} = 'IGNORE';
 262   local $SIG{INT} = 'IGNORE';
 263   local $SIG{QUIT} = 'IGNORE';
 264   local $SIG{TERM} = 'IGNORE';
 265   local $SIG{TSTP} = 'IGNORE';
 266   local $SIG{PIPE} = 'IGNORE';
 267
 268   my $oldAutoCommit = $FS::UID::AutoCommit;
 269   local $FS::UID::AutoCommit = 0;
 270   my $dbh = dbh;
 271
 272   my $cust_pay_void = new FS::cust_pay_void ( {
 273     map { $_ => $self->get($_) } $self->fields
 274   } );
 275   $cust_pay_void->reason(shift) if scalar(@_);
 276   my $error = $cust_pay_void->insert;
 277   if ( $error ) {
 278     $dbh->rollback if $oldAutoCommit;
 279     return $error;
 280   }
 281
 282   $error = $self->delete;
 283   if ( $error ) {
 284     $dbh->rollback if $oldAutoCommit;
 285     return $error;
 286   }
 287
 288   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 289
 290   '';
 291
 292 }
 293
 294 =item delete
 295
 296 Unless the closed flag is set, deletes this payment and all associated
 297 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>).  In most
 298 cases, you want to use the void method instead to leave a record of the
 299 deleted payment.
 300
 301 =cut
 302
 303 # very similar to FS::cust_credit::delete
 304 sub delete {
 305   my $self = shift;
 306   return "Can't delete closed payment" if $self->closed =~ /^Y/i;
 307
 308   local $SIG{HUP} = 'IGNORE';
 309   local $SIG{INT} = 'IGNORE';
 310   local $SIG{QUIT} = 'IGNORE';
 311   local $SIG{TERM} = 'IGNORE';
 312   local $SIG{TSTP} = 'IGNORE';
 313   local $SIG{PIPE} = 'IGNORE';
 314
 315   my $oldAutoCommit = $FS::UID::AutoCommit;
 316   local $FS::UID::AutoCommit = 0;
 317   my $dbh = dbh;
 318
 319   foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
 320     my $error = $app->delete;
 321     if ( $error ) {
 322       $dbh->rollback if $oldAutoCommit;
 323       return $error;
 324     }
 325   }
 326
 327   my $error = $self->SUPER::delete(@_);
 328   if ( $error ) {
 329     $dbh->rollback if $oldAutoCommit;
 330     return $error;
 331   }
 332
 333   if ( $conf->config('deletepayments') ne '' ) {
 334
 335     my $cust_main = $self->cust_main;
 336
 337     my $error = send_email(
 338       'from'    => $conf->config('invoice_from'), #??? well as good as any
 339       'to'      => $conf->config('deletepayments'),
 340       'subject' => 'FREESIDE NOTIFICATION: Payment deleted',
 341       'body'    => [
 342         "This is an automatic message from your Freeside installation\n",
 343         "informing you that the following payment has been deleted:\n",
 344         "\n",
 345         'paynum: '. $self->paynum. "\n",
 346         'custnum: '. $self->custnum.
 347           " (". $cust_main->last. ", ". $cust_main->first. ")\n",
 348         'paid: $'. sprintf("%.2f", $self->paid). "\n",
 349         'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n",
 350         'payby: '. $self->payby. "\n",
 351         'payinfo: '. $self->paymask. "\n",
 352         'paybatch: '. $self->paybatch. "\n",
 353       ],
 354     );
 355
 356     if ( $error ) {
 357       $dbh->rollback if $oldAutoCommit;
 358       return "can't send payment deletion notification: $error";
 359     }
 360
 361   }
 362
 363   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 364
 365   '';
 366
 367 }
 368
 369 =item replace OLD_RECORD
 370
 371 You can, but probably shouldn't modify payments...
 372
 373 =cut
 374
 375 sub replace {
 376   #return "Can't modify payment!"
 377   my $self = shift;
 378   return "Can't modify closed payment" if $self->closed =~ /^Y/i;
 379   $self->SUPER::replace(@_);
 380 }
 381
 382 =item check
 383
 384 Checks all fields to make sure this is a valid payment.  If there is an error,
 385 returns the error, otherwise returns false.  Called by the insert method.
 386
 387 =cut
 388
 389 sub check {
 390   my $self = shift;
 391
 392   my $error =
 393     $self->ut_numbern('paynum')
 394     || $self->ut_numbern('custnum')
 395     || $self->ut_money('paid')
 396     || $self->ut_numbern('_date')
 397     || $self->ut_textn('paybatch')
 398     || $self->ut_textn('payunique')
 399     || $self->ut_enum('closed', [ '', 'Y' ])
 400     || $self->payinfo_check()
 401   ;
 402   return $error if $error;
 403
 404   return "paid must be > 0 " if $self->paid <= 0;
 405
 406   return "unknown cust_main.custnum: ". $self->custnum
 407     unless $self->invnum
 408            || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 409
 410   $self->_date(time) unless $self->_date;
 411
 412   # UNIQUE index should catch this too, without race conditions, but this
 413   # should give a better error message the other 99.9% of the time...
 414   if ( length($self->payunique)
 415        && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
 416     #well, it *could* be a better error message
 417     return "duplicate transaction".
 418            " - a payment with unique identifer ". $self->payunique.
 419            " already exists";
 420   }
 421
 422   $self->SUPER::check;
 423 }
 424
 425 =item batch_insert CUST_PAY_OBJECT, ...
 426
 427 Class method which inserts multiple payments.  Takes a list of FS::cust_pay
 428 objects.  Returns a list, each element representing the status of inserting the
 429 corresponding payment - empty.  If there is an error inserting any payment, the
 430 entire transaction is rolled back, i.e. all payments are inserted or none are.
 431
 432 For example:
 433
 434   my @errors = FS::cust_pay->batch_insert(@cust_pay);
 435   my $num_errors = scalar(grep $_, @errors);
 436   if ( $num_errors == 0 ) {
 437     #success; all payments were inserted
 438   } else {
 439     #failure; no payments were inserted.
 440   }
 441
 442 =cut
 443
 444 sub batch_insert {
 445   my $self = shift; #class method
 446
 447   local $SIG{HUP} = 'IGNORE';
 448   local $SIG{INT} = 'IGNORE';
 449   local $SIG{QUIT} = 'IGNORE';
 450   local $SIG{TERM} = 'IGNORE';
 451   local $SIG{TSTP} = 'IGNORE';
 452   local $SIG{PIPE} = 'IGNORE';
 453
 454   my $oldAutoCommit = $FS::UID::AutoCommit;
 455   local $FS::UID::AutoCommit = 0;
 456   my $dbh = dbh;
 457
 458   my $errors = 0;
 459
 460   my @errors = map {
 461     my $error = $_->insert( 'manual' => 1 );
 462     if ( $error ) {
 463       $errors++;
 464     } else {
 465       $_->cust_main->apply_payments;
 466     }
 467     $error;
 468   } @_;
 469
 470   if ( $errors ) {
 471     $dbh->rollback if $oldAutoCommit;
 472   } else {
 473     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 474   }
 475
 476   @errors;
 477
 478 }
 479
 480 =item cust_bill_pay
 481
 482 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
 483 payment.
 484
 485 =cut
 486
 487 sub cust_bill_pay {
 488   my $self = shift;
 489   sort {    $a->_date  <=> $b->_date
 490          || $a->invnum <=> $b->invnum }
 491     qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
 492   ;
 493 }
 494
 495 =item cust_pay_refund
 496
 497 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
 498 payment.
 499
 500 =cut
 501
 502 sub cust_pay_refund {
 503   my $self = shift;
 504   sort { $a->_date <=> $b->_date }
 505     qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
 506   ;
 507 }
 508
 509
 510 =item unapplied
 511
 512 Returns the amount of this payment that is still unapplied; which is
 513 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
 514 applications (see L<FS::cust_pay_refund>).
 515
 516 =cut
 517
 518 sub unapplied {
 519   my $self = shift;
 520   my $amount = $self->paid;
 521   $amount -= $_->amount foreach ( $self->cust_bill_pay );
 522   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 523   sprintf("%.2f", $amount );
 524 }
 525
 526 =item unrefunded
 527
 528 Returns the amount of this payment that has not been refuned; which is
 529 paid minus all  refund applications (see L<FS::cust_pay_refund>).
 530
 531 =cut
 532
 533 sub unrefunded {
 534   my $self = shift;
 535   my $amount = $self->paid;
 536   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 537   sprintf("%.2f", $amount );
 538 }
 539
 540
 541 =item cust_main
 542
 543 Returns the parent customer object (see L<FS::cust_main>).
 544
 545 =cut
 546
 547 sub cust_main {
 548   my $self = shift;
 549   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 550 }
 551
 552 =item payby_name
 553
 554 Returns a name for the payby field.
 555
 556 =cut
 557
 558 sub payby_name {
 559   my $self = shift;
 560   FS::payby->shortname( $self->payby );
 561 }
 562
 563 =item gatewaynum
 564
 565 Returns a gatewaynum for the processing gateway.
 566
 567 =item processor
 568
 569 Returns a name for the processing gateway.
 570
 571 =item authorization
 572
 573 Returns a name for the processing gateway.
 574
 575 =item order_number
 576
 577 Returns a name for the processing gateway.
 578
 579 =cut
 580
 581 sub gatewaynum    { shift->_parse_paybatch->{'gatewaynum'}; }
 582 sub processor     { shift->_parse_paybatch->{'processor'}; }
 583 sub authorization { shift->_parse_paybatch->{'authorization'}; }
 584 sub order_number  { shift->_parse_paybatch->{'order_number'}; }
 585
 586 #sucks that this stuff is in paybatch like this in the first place,
 587 #but at least other code can start to use new field names
 588 #(code nicked from FS::cust_main::realtime_refund_bop)
 589 sub _parse_paybatch {
 590   my $self = shift;
 591
 592   $self->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
 593     or return {};
 594               #"Can't parse paybatch for paynum $options{'paynum'}: ".
 595               #  $cust_pay->paybatch;
 596
 597   my( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
 598
 599   if ( $gatewaynum ) { #gateway for the payment to be refunded
 600
 601     my $payment_gateway =
 602       qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
 603
 604     die "payment gateway $gatewaynum not found" #?
 605       unless $payment_gateway;
 606
 607     $processor = $payment_gateway->gateway_module;
 608
 609   }
 610
 611   {
 612     'gatewaynum'    => $gatewaynum,
 613     'processor'     => $processor,
 614     'authorization' => $auth,
 615     'order_number'  => $order_number,
 616   };
 617
 618 }
 619
 620 =back
 621
 622 =head1 CLASS METHODS
 623
 624 =over 4
 625
 626 =item unapplied_sql
 627
 628 Returns an SQL fragment to retreive the unapplied amount.
 629
 630 =cut
 631
 632 sub unapplied_sql {
 633   #my $class = shift;
 634
 635   "paid
 636         - COALESCE(
 637                     ( SELECT SUM(amount) FROM cust_bill_pay
 638                         WHERE cust_pay.paynum = cust_bill_pay.paynum )
 639                     ,0
 640                   )
 641         - COALESCE(
 642                     ( SELECT SUM(amount) FROM cust_pay_refund
 643                         WHERE cust_pay.paynum = cust_pay_refund.paynum )
 644                     ,0
 645                   )
 646   ";
 647
 648 }
 649
 650 =back
 651
 652 =head1 BUGS
 653
 654 Delete and replace methods.
 655
 656 =head1 SEE ALSO
 657
 658 L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>, schema.html from the
 659 base documentation.
 660
 661 =cut
 662
 663 1;
 664