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     my $error;
 196     if ( exists($options{ 'manual' }) && $options{ 'manual' } ) {
 197
 198       my $receipt_template = new Text::Template (
 199         TYPE   => 'ARRAY',
 200         SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
 201       ) or do {
 202         warn "can't create payment receipt template: $Text::Template::ERROR";
 203         return '';
 204       };
 205
 206       my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ }
 207                              $cust_main->invoicing_list;
 208
 209       my $payby = $self->payby;
 210       my $payinfo = $self->payinfo;
 211       $payby =~ s/^BILL$/Check/ if $payinfo;
 212       $payinfo = $self->paymask if $payby eq 'CARD' || $payby eq 'CHEK';
 213       $payby =~ s/^CHEK$/Electronic check/;
 214
 215       $error = send_email(
 216         'from'    => $conf->config('invoice_from'), #??? well as good as any
 217         'to'      => \@invoicing_list,
 218         'subject' => 'Payment receipt',
 219         'body'    => [ $receipt_template->fill_in( HASH => {
 220                        'date'    => time2str("%a %B %o, %Y", $self->_date),
 221                        'name'    => $cust_main->name,
 222                        'paynum'  => $self->paynum,
 223                        'paid'    => sprintf("%.2f", $self->paid),
 224                        'payby'   => ucfirst(lc($payby)),
 225                        'payinfo' => $payinfo,
 226                        'balance' => $cust_main->balance,
 227                      } ) ],
 228       );
 229     }else{
 230       unless($cust_bill){
 231         $cust_bill = ($cust_main->cust_bill)[-1];
 232       }
 233       if ($cust_bill) {
 234         my $queue = new FS::queue {
 235            'paynum' => $self->paynum,
 236            'job'    => 'FS::cust_bill::queueable_send',
 237         };
 238         $error = $queue->insert(
 239           'invnum' => $cust_bill->invnum,
 240           'template' => 'statement',
 241         );
 242       }
 243     }
 244     if ( $error ) {
 245       warn "can't send payment receipt/statement: $error";
 246     }
 247
 248   }
 249
 250   '';
 251
 252 }
 253
 254 =item void [ REASON ]
 255
 256 Voids this payment: deletes the payment and all associated applications and
 257 adds a record of the voided payment to the FS::cust_pay_void table.
 258
 259 =cut
 260
 261 sub void {
 262   my $self = shift;
 263
 264   local $SIG{HUP} = 'IGNORE';
 265   local $SIG{INT} = 'IGNORE';
 266   local $SIG{QUIT} = 'IGNORE';
 267   local $SIG{TERM} = 'IGNORE';
 268   local $SIG{TSTP} = 'IGNORE';
 269   local $SIG{PIPE} = 'IGNORE';
 270
 271   my $oldAutoCommit = $FS::UID::AutoCommit;
 272   local $FS::UID::AutoCommit = 0;
 273   my $dbh = dbh;
 274
 275   my $cust_pay_void = new FS::cust_pay_void ( {
 276     map { $_ => $self->get($_) } $self->fields
 277   } );
 278   $cust_pay_void->reason(shift) if scalar(@_);
 279   my $error = $cust_pay_void->insert;
 280   if ( $error ) {
 281     $dbh->rollback if $oldAutoCommit;
 282     return $error;
 283   }
 284
 285   $error = $self->delete;
 286   if ( $error ) {
 287     $dbh->rollback if $oldAutoCommit;
 288     return $error;
 289   }
 290
 291   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 292
 293   '';
 294
 295 }
 296
 297 =item delete
 298
 299 Unless the closed flag is set, deletes this payment and all associated
 300 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>).  In most
 301 cases, you want to use the void method instead to leave a record of the
 302 deleted payment.
 303
 304 =cut
 305
 306 # very similar to FS::cust_credit::delete
 307 sub delete {
 308   my $self = shift;
 309   return "Can't delete closed payment" if $self->closed =~ /^Y/i;
 310
 311   local $SIG{HUP} = 'IGNORE';
 312   local $SIG{INT} = 'IGNORE';
 313   local $SIG{QUIT} = 'IGNORE';
 314   local $SIG{TERM} = 'IGNORE';
 315   local $SIG{TSTP} = 'IGNORE';
 316   local $SIG{PIPE} = 'IGNORE';
 317
 318   my $oldAutoCommit = $FS::UID::AutoCommit;
 319   local $FS::UID::AutoCommit = 0;
 320   my $dbh = dbh;
 321
 322   foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
 323     my $error = $app->delete;
 324     if ( $error ) {
 325       $dbh->rollback if $oldAutoCommit;
 326       return $error;
 327     }
 328   }
 329
 330   my $error = $self->SUPER::delete(@_);
 331   if ( $error ) {
 332     $dbh->rollback if $oldAutoCommit;
 333     return $error;
 334   }
 335
 336   if ( $conf->config('deletepayments') ne '' ) {
 337
 338     my $cust_main = $self->cust_main;
 339
 340     my $error = send_email(
 341       'from'    => $conf->config('invoice_from'), #??? well as good as any
 342       'to'      => $conf->config('deletepayments'),
 343       'subject' => 'FREESIDE NOTIFICATION: Payment deleted',
 344       'body'    => [
 345         "This is an automatic message from your Freeside installation\n",
 346         "informing you that the following payment has been deleted:\n",
 347         "\n",
 348         'paynum: '. $self->paynum. "\n",
 349         'custnum: '. $self->custnum.
 350           " (". $cust_main->last. ", ". $cust_main->first. ")\n",
 351         'paid: $'. sprintf("%.2f", $self->paid). "\n",
 352         'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n",
 353         'payby: '. $self->payby. "\n",
 354         'payinfo: '. $self->paymask. "\n",
 355         'paybatch: '. $self->paybatch. "\n",
 356       ],
 357     );
 358
 359     if ( $error ) {
 360       $dbh->rollback if $oldAutoCommit;
 361       return "can't send payment deletion notification: $error";
 362     }
 363
 364   }
 365
 366   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 367
 368   '';
 369
 370 }
 371
 372 =item replace OLD_RECORD
 373
 374 You can, but probably shouldn't modify payments...
 375
 376 =cut
 377
 378 sub replace {
 379   #return "Can't modify payment!"
 380   my $self = shift;
 381   return "Can't modify closed payment" if $self->closed =~ /^Y/i;
 382   $self->SUPER::replace(@_);
 383 }
 384
 385 =item check
 386
 387 Checks all fields to make sure this is a valid payment.  If there is an error,
 388 returns the error, otherwise returns false.  Called by the insert method.
 389
 390 =cut
 391
 392 sub check {
 393   my $self = shift;
 394
 395   my $error =
 396     $self->ut_numbern('paynum')
 397     || $self->ut_numbern('custnum')
 398     || $self->ut_money('paid')
 399     || $self->ut_numbern('_date')
 400     || $self->ut_textn('paybatch')
 401     || $self->ut_enum('closed', [ '', 'Y' ])
 402     || $self->payinfo_check()
 403   ;
 404   return $error if $error;
 405
 406   return "paid must be > 0 " if $self->paid <= 0;
 407
 408   return "unknown cust_main.custnum: ". $self->custnum
 409     unless $self->invnum
 410            || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 411
 412   $self->_date(time) unless $self->_date;
 413
 414   $self->SUPER::check;
 415 }
 416
 417 =item batch_insert CUST_PAY_OBJECT, ...
 418
 419 Class method which inserts multiple payments.  Takes a list of FS::cust_pay
 420 objects.  Returns a list, each element representing the status of inserting the
 421 corresponding payment - empty.  If there is an error inserting any payment, the
 422 entire transaction is rolled back, i.e. all payments are inserted or none are.
 423
 424 For example:
 425
 426   my @errors = FS::cust_pay->batch_insert(@cust_pay);
 427   my $num_errors = scalar(grep $_, @errors);
 428   if ( $num_errors == 0 ) {
 429     #success; all payments were inserted
 430   } else {
 431     #failure; no payments were inserted.
 432   }
 433
 434 =cut
 435
 436 sub batch_insert {
 437   my $self = shift; #class method
 438
 439   local $SIG{HUP} = 'IGNORE';
 440   local $SIG{INT} = 'IGNORE';
 441   local $SIG{QUIT} = 'IGNORE';
 442   local $SIG{TERM} = 'IGNORE';
 443   local $SIG{TSTP} = 'IGNORE';
 444   local $SIG{PIPE} = 'IGNORE';
 445
 446   my $oldAutoCommit = $FS::UID::AutoCommit;
 447   local $FS::UID::AutoCommit = 0;
 448   my $dbh = dbh;
 449
 450   my $errors = 0;
 451
 452   my @errors = map {
 453     my $error = $_->insert( 'manual' => 1 );
 454     if ( $error ) {
 455       $errors++;
 456     } else {
 457       $_->cust_main->apply_payments;
 458     }
 459     $error;
 460   } @_;
 461
 462   if ( $errors ) {
 463     $dbh->rollback if $oldAutoCommit;
 464   } else {
 465     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 466   }
 467
 468   @errors;
 469
 470 }
 471
 472 =item cust_bill_pay
 473
 474 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
 475 payment.
 476
 477 =cut
 478
 479 sub cust_bill_pay {
 480   my $self = shift;
 481   sort {    $a->_date  <=> $b->_date
 482          || $a->invnum <=> $b->invnum }
 483     qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
 484   ;
 485 }
 486
 487 =item cust_pay_refund
 488
 489 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
 490 payment.
 491
 492 =cut
 493
 494 sub cust_pay_refund {
 495   my $self = shift;
 496   sort { $a->_date <=> $b->_date }
 497     qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
 498   ;
 499 }
 500
 501
 502 =item unapplied
 503
 504 Returns the amount of this payment that is still unapplied; which is
 505 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
 506 applications (see L<FS::cust_pay_refund>).
 507
 508 =cut
 509
 510 sub unapplied {
 511   my $self = shift;
 512   my $amount = $self->paid;
 513   $amount -= $_->amount foreach ( $self->cust_bill_pay );
 514   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 515   sprintf("%.2f", $amount );
 516 }
 517
 518 =item unrefunded
 519
 520 Returns the amount of this payment that has not been refuned; which is
 521 paid minus all  refund applications (see L<FS::cust_pay_refund>).
 522
 523 =cut
 524
 525 sub unrefunded {
 526   my $self = shift;
 527   my $amount = $self->paid;
 528   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 529   sprintf("%.2f", $amount );
 530 }
 531
 532
 533 =item cust_main
 534
 535 Returns the parent customer object (see L<FS::cust_main>).
 536
 537 =cut
 538
 539 sub cust_main {
 540   my $self = shift;
 541   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 542 }
 543
 544 =back
 545
 546 =head1 BUGS
 547
 548 Delete and replace methods.
 549
 550 =head1 SEE ALSO
 551
 552 L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>, schema.html from the
 553 base documentation.
 554
 555 =cut
 556
 557 1;
 558