FS/FS/cust_pay.pm

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