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