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_enum('closed', [ '', 'Y' ])
 407     || $self->payinfo_check()
 408   ;
 409   return $error if $error;
 410
 411   return "paid must be > 0 " if $self->paid <= 0;
 412
 413   return "unknown cust_main.custnum: ". $self->custnum
 414     unless $self->invnum
 415            || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 416
 417   $self->_date(time) unless $self->_date;
 418
 419   $self->SUPER::check;
 420 }
 421
 422 =item batch_insert CUST_PAY_OBJECT, ...
 423
 424 Class method which inserts multiple payments.  Takes a list of FS::cust_pay
 425 objects.  Returns a list, each element representing the status of inserting the
 426 corresponding payment - empty.  If there is an error inserting any payment, the
 427 entire transaction is rolled back, i.e. all payments are inserted or none are.
 428
 429 For example:
 430
 431   my @errors = FS::cust_pay->batch_insert(@cust_pay);
 432   my $num_errors = scalar(grep $_, @errors);
 433   if ( $num_errors == 0 ) {
 434     #success; all payments were inserted
 435   } else {
 436     #failure; no payments were inserted.
 437   }
 438
 439 =cut
 440
 441 sub batch_insert {
 442   my $self = shift; #class method
 443
 444   local $SIG{HUP} = 'IGNORE';
 445   local $SIG{INT} = 'IGNORE';
 446   local $SIG{QUIT} = 'IGNORE';
 447   local $SIG{TERM} = 'IGNORE';
 448   local $SIG{TSTP} = 'IGNORE';
 449   local $SIG{PIPE} = 'IGNORE';
 450
 451   my $oldAutoCommit = $FS::UID::AutoCommit;
 452   local $FS::UID::AutoCommit = 0;
 453   my $dbh = dbh;
 454
 455   my $errors = 0;
 456
 457   my @errors = map {
 458     my $error = $_->insert( 'manual' => 1 );
 459     if ( $error ) {
 460       $errors++;
 461     } else {
 462       $_->cust_main->apply_payments;
 463     }
 464     $error;
 465   } @_;
 466
 467   if ( $errors ) {
 468     $dbh->rollback if $oldAutoCommit;
 469   } else {
 470     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 471   }
 472
 473   @errors;
 474
 475 }
 476
 477 =item cust_bill_pay
 478
 479 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
 480 payment.
 481
 482 =cut
 483
 484 sub cust_bill_pay {
 485   my $self = shift;
 486   sort {    $a->_date  <=> $b->_date
 487          || $a->invnum <=> $b->invnum }
 488     qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
 489   ;
 490 }
 491
 492 =item cust_pay_refund
 493
 494 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
 495 payment.
 496
 497 =cut
 498
 499 sub cust_pay_refund {
 500   my $self = shift;
 501   sort { $a->_date <=> $b->_date }
 502     qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
 503   ;
 504 }
 505
 506
 507 =item unapplied
 508
 509 Returns the amount of this payment that is still unapplied; which is
 510 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
 511 applications (see L<FS::cust_pay_refund>).
 512
 513 =cut
 514
 515 sub unapplied {
 516   my $self = shift;
 517   my $amount = $self->paid;
 518   $amount -= $_->amount foreach ( $self->cust_bill_pay );
 519   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 520   sprintf("%.2f", $amount );
 521 }
 522
 523 =item unrefunded
 524
 525 Returns the amount of this payment that has not been refuned; which is
 526 paid minus all  refund applications (see L<FS::cust_pay_refund>).
 527
 528 =cut
 529
 530 sub unrefunded {
 531   my $self = shift;
 532   my $amount = $self->paid;
 533   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 534   sprintf("%.2f", $amount );
 535 }
 536
 537
 538 =item cust_main
 539
 540 Returns the parent customer object (see L<FS::cust_main>).
 541
 542 =cut
 543
 544 sub cust_main {
 545   my $self = shift;
 546   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 547 }
 548
 549 =back
 550
 551 =head1 BUGS
 552
 553 Delete and replace methods.
 554
 555 =head1 SEE ALSO
 556
 557 L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>, schema.html from the
 558 base documentation.
 559
 560 =cut
 561
 562 1;
 563