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