FS/FS/cust_pay.pm

   1 package FS::cust_pay;
   2
   3 use strict;
   4 use vars qw( @ISA $conf $unsuspendauto );
   5 use Date::Format;
   6 use Business::CreditCard;
   7 use FS::UID qw( dbh );
   8 use FS::Record qw( dbh qsearch qsearchs dbh );
   9 use FS::Misc qw(send_email);
  10 use FS::cust_bill;
  11 use FS::cust_bill_pay;
  12 use FS::cust_pay_refund;
  13 use FS::cust_main;
  14
  15 @ISA = qw( FS::Record );
  16
  17 #ask FS::UID to run this stuff for us later
  18 FS::UID->install_callback( sub {
  19   $conf = new FS::Conf;
  20   $unsuspendauto = $conf->exists('unsuspendauto');
  21 } );
  22
  23 =head1 NAME
  24
  25 FS::cust_pay - Object methods for cust_pay objects
  26
  27 =head1 SYNOPSIS
  28
  29   use FS::cust_pay;
  30
  31   $record = new FS::cust_pay \%hash;
  32   $record = new FS::cust_pay { 'column' => 'value' };
  33
  34   $error = $record->insert;
  35
  36   $error = $new_record->replace($old_record);
  37
  38   $error = $record->delete;
  39
  40   $error = $record->check;
  41
  42 =head1 DESCRIPTION
  43
  44 An FS::cust_pay object represents a payment; the transfer of money from a
  45 customer.  FS::cust_pay inherits from FS::Record.  The following fields are
  46 currently supported:
  47
  48 =over 4
  49
  50 =item paynum - primary key (assigned automatically for new payments)
  51
  52 =item custnum - customer (see L<FS::cust_main>)
  53
  54 =item paid - Amount of this payment
  55
  56 =item _date - specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
  57 L<Time::Local> and L<Date::Parse> for conversion functions.
  58
  59 =item payby - `CARD' (credit cards), `CHEK' (electronic check/ACH),
  60 `LECB' (phone bill billing), `BILL' (billing), or `COMP' (free)
  61
  62 =item payinfo - card number, check #, or comp issuer (4-8 lowercase alphanumerics; think username), respectively
  63
  64 =item paybatch - text field for tracking card processing
  65
  66 =item closed - books closed flag, empty or `Y'
  67
  68 =back
  69
  70 =head1 METHODS
  71
  72 =over 4
  73
  74 =item new HASHREF
  75
  76 Creates a new payment.  To add the payment to the databse, see L<"insert">.
  77
  78 =cut
  79
  80 sub table { 'cust_pay'; }
  81
  82 =item insert
  83
  84 Adds this payment to the database.
  85
  86 For backwards-compatibility and convenience, if the additional field invnum
  87 is defined, an FS::cust_bill_pay record for the full amount of the payment
  88 will be created.  In this case, custnum is optional.
  89
  90 =cut
  91
  92 sub insert {
  93   my $self = shift;
  94
  95   local $SIG{HUP} = 'IGNORE';
  96   local $SIG{INT} = 'IGNORE';
  97   local $SIG{QUIT} = 'IGNORE';
  98   local $SIG{TERM} = 'IGNORE';
  99   local $SIG{TSTP} = 'IGNORE';
 100   local $SIG{PIPE} = 'IGNORE';
 101
 102   my $oldAutoCommit = $FS::UID::AutoCommit;
 103   local $FS::UID::AutoCommit = 0;
 104   my $dbh = dbh;
 105
 106   if ( $self->invnum ) {
 107     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
 108       or do {
 109         $dbh->rollback if $oldAutoCommit;
 110         return "Unknown cust_bill.invnum: ". $self->invnum;
 111       };
 112     $self->custnum($cust_bill->custnum );
 113   }
 114
 115   my $cust_main = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 116   my $old_balance = $cust_main->balance;
 117
 118   my $error = $self->check;
 119   return $error if $error;
 120
 121   $error = $self->SUPER::insert;
 122   if ( $error ) {
 123     $dbh->rollback if $oldAutoCommit;
 124     return "error inserting $self: $error";
 125   }
 126
 127   if ( $self->invnum ) {
 128     my $cust_bill_pay = new FS::cust_bill_pay {
 129       'invnum' => $self->invnum,
 130       'paynum' => $self->paynum,
 131       'amount' => $self->paid,
 132       '_date'  => $self->_date,
 133     };
 134     $error = $cust_bill_pay->insert;
 135     if ( $error ) {
 136       $dbh->rollback if $oldAutoCommit;
 137       return "error inserting $cust_bill_pay: $error";
 138     }
 139   }
 140
 141   if ( $self->paybatch =~ /^webui-/ ) {
 142     my @cust_pay = qsearch('cust_pay', {
 143       'custnum' => $self->custnum,
 144       'paybatch' => $self->paybatch,
 145     } );
 146     if ( scalar(@cust_pay) > 1 ) {
 147       $dbh->rollback if $oldAutoCommit;
 148       return "a payment with webui token ". $self->paybatch. " already exists";
 149     }
 150   }
 151
 152   #false laziness w/ cust_credit::insert
 153   if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
 154     my @errors = $cust_main->unsuspend;
 155     #return
 156     # side-fx with nested transactions?  upstack rolls back?
 157     warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
 158          join(' / ', @errors)
 159       if @errors;
 160   }
 161   #eslaf
 162
 163   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 164
 165   '';
 166
 167 }
 168
 169 sub upgrade_replace { #1.3.x->1.4.x
 170   my $self = shift;
 171
 172   local $SIG{HUP} = 'IGNORE';
 173   local $SIG{INT} = 'IGNORE';
 174   local $SIG{QUIT} = 'IGNORE';
 175   local $SIG{TERM} = 'IGNORE';
 176   local $SIG{TSTP} = 'IGNORE';
 177   local $SIG{PIPE} = 'IGNORE';
 178
 179   my $oldAutoCommit = $FS::UID::AutoCommit;
 180   local $FS::UID::AutoCommit = 0;
 181   my $dbh = dbh;
 182
 183   my $error = $self->check;
 184   return $error if $error;
 185
 186   my %new = $self->hash;
 187   my $new = FS::cust_pay->new(\%new);
 188
 189   if ( $self->invnum ) {
 190     my $cust_bill_pay = new FS::cust_bill_pay {
 191       'invnum' => $self->invnum,
 192       'paynum' => $self->paynum,
 193       'amount' => $self->paid,
 194       '_date'  => $self->_date,
 195     };
 196     $error = $cust_bill_pay->insert;
 197     if ( $error =~
 198            /total cust_bill_pay.amount and cust_credit_bill.amount .* for invnum .* greater than cust_bill.charged/ ) {
 199       #warn $error;
 200       my $cust_bill = qsearchs( 'cust_bill', { 'invnum' => $self->invnum } );
 201       $new->custnum($cust_bill->custnum);
 202     } elsif ( $error ) {
 203       $dbh->rollback if $oldAutoCommit;
 204       return $error;
 205     } else {
 206       $new->custnum($cust_bill_pay->cust_bill->custnum);
 207     }
 208   } else {
 209     die;
 210   }
 211
 212   $error = $new->SUPER::replace($self);
 213   if ( $error ) {
 214     $dbh->rollback if $oldAutoCommit;
 215     return $error;
 216   }
 217
 218   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 219
 220   '';
 221
 222
 223 }
 224
 225 =item delete
 226
 227 Deletes this payment and all associated applications (see L<FS::cust_bill_pay>),
 228 unless the closed flag is set.
 229
 230 =cut
 231
 232 sub delete {
 233   my $self = shift;
 234   return "Can't delete closed payment" if $self->closed =~ /^Y/i;
 235
 236   local $SIG{HUP} = 'IGNORE';
 237   local $SIG{INT} = 'IGNORE';
 238   local $SIG{QUIT} = 'IGNORE';
 239   local $SIG{TERM} = 'IGNORE';
 240   local $SIG{TSTP} = 'IGNORE';
 241   local $SIG{PIPE} = 'IGNORE';
 242
 243   my $oldAutoCommit = $FS::UID::AutoCommit;
 244   local $FS::UID::AutoCommit = 0;
 245   my $dbh = dbh;
 246
 247   foreach my $cust_bill_pay ( $self->cust_bill_pay ) {
 248     my $error = $cust_bill_pay->delete;
 249     if ( $error ) {
 250       $dbh->rollback if $oldAutoCommit;
 251       return $error;
 252     }
 253   }
 254
 255   my $error = $self->SUPER::delete(@_);
 256   if ( $error ) {
 257     $dbh->rollback if $oldAutoCommit;
 258     return $error;
 259   }
 260
 261   if ( $conf->config('deletepayments') ne '' ) {
 262
 263     my $cust_main = qsearchs('cust_main',{ 'custnum' => $self->custnum });
 264
 265     my $error = send_email(
 266       'from'    => $conf->config('invoice_from'), #??? well as good as any
 267       'to'      => $conf->config('deletepayments'),
 268       'subject' => 'FREESIDE NOTIFICATION: Payment deleted',
 269       'body'    => [
 270         "This is an automatic message from your Freeside installation\n",
 271         "informing you that the following payment has been deleted:\n",
 272         "\n",
 273         'paynum: '. $self->paynum. "\n",
 274         'custnum: '. $self->custnum.
 275           " (". $cust_main->last. ", ". $cust_main->first. ")\n",
 276         'paid: $'. sprintf("%.2f", $self->paid). "\n",
 277         'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n",
 278         'payby: '. $self->payby. "\n",
 279         'payinfo: '. $self->payinfo. "\n",
 280         'paybatch: '. $self->paybatch. "\n",
 281       ],
 282     );
 283
 284     if ( $error ) {
 285       $dbh->rollback if $oldAutoCommit;
 286       return "can't send payment deletion notification: $error";
 287     }
 288
 289   }
 290
 291   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 292
 293   '';
 294
 295 }
 296
 297 =item replace OLD_RECORD
 298
 299 Currently unimplemented (accounting reasons).
 300
 301 =cut
 302
 303 sub replace {
 304    return "Can't (yet?) modify cust_pay records!";
 305 }
 306
 307 =item check
 308
 309 Checks all fields to make sure this is a valid payment.  If there is an error,
 310 returns the error, otherwise returns false.  Called by the insert method.
 311
 312 =cut
 313
 314 sub check {
 315   my $self = shift;
 316
 317   my $error =
 318     $self->ut_numbern('paynum')
 319     || $self->ut_numbern('custnum')
 320     || $self->ut_money('paid')
 321     || $self->ut_numbern('_date')
 322     || $self->ut_textn('paybatch')
 323     || $self->ut_enum('closed', [ '', 'Y' ])
 324   ;
 325   return $error if $error;
 326
 327   return "paid must be > 0 " if $self->paid <= 0;
 328
 329   return "unknown cust_main.custnum: ". $self->custnum
 330     unless $self->invnum
 331            || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 332
 333   $self->_date(time) unless $self->_date;
 334
 335   $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP)$/ or return "Illegal payby";
 336   $self->payby($1);
 337
 338   #false laziness with cust_refund::check
 339   if ( $self->payby eq 'CARD' ) {
 340     my $payinfo = $self->payinfo;
 341     $payinfo =~ s/\D//g;
 342     $self->payinfo($payinfo);
 343     if ( $self->payinfo ) {
 344       $self->payinfo =~ /^(\d{13,16})$/
 345         or return "Illegal (mistyped?) credit card number (payinfo)";
 346       $self->payinfo($1);
 347       validate($self->payinfo) or return "Illegal credit card number";
 348       return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
 349     } else {
 350       $self->payinfo('N/A');
 351     }
 352
 353   } else {
 354     $error = $self->ut_textn('payinfo');
 355     return $error if $error;
 356   }
 357
 358   $self->SUPER::check;
 359 }
 360
 361 =item cust_bill_pay
 362
 363 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
 364 payment.
 365
 366 =cut
 367
 368 sub cust_bill_pay {
 369   my $self = shift;
 370   sort { $a->_date <=> $b->_date }
 371     qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
 372   ;
 373 }
 374
 375 =item cust_pay_refund
 376
 377 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
 378 payment.
 379
 380 =cut
 381
 382 sub cust_pay_refund {
 383   my $self = shift;
 384   sort { $a->_date <=> $b->_date }
 385     qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
 386   ;
 387 }
 388
 389
 390 =item unapplied
 391
 392 Returns the amount of this payment that is still unapplied; which is
 393 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
 394 applications (see L<FS::cust_pay_refund>).
 395
 396 =cut
 397
 398 sub unapplied {
 399   my $self = shift;
 400   my $amount = $self->paid;
 401   $amount -= $_->amount foreach ( $self->cust_bill_pay );
 402   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 403   sprintf("%.2f", $amount );
 404 }
 405
 406 =item cust_main
 407
 408 Returns the parent customer object (see L<FS::cust_main>).
 409
 410 =cut
 411
 412 sub cust_main {
 413   my $self = shift;
 414   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 415 }
 416
 417 =item payinfo_masked
 418
 419 Returns a "masked" payinfo field with all but the last four characters replaced
 420 by 'x'es.  Useful for displaying credit cards.
 421
 422 =cut
 423
 424 sub payinfo_masked {
 425   my $self = shift;
 426   my $payinfo = $self->payinfo;
 427   'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
 428 }
 429
 430 =back
 431
 432 =head1 BUGS
 433
 434 Delete and replace methods.  payinfo_masked false laziness with cust_main.pm
 435 and cust_refund.pm
 436
 437 =head1 SEE ALSO
 438
 439 L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>, schema.html from the
 440 base documentation.
 441
 442 =cut
 443
 444 1;
 445