FS/FS/cust_main.pm

   1 #this is so kludgy i'd be embarassed if it wasn't cybercash's fault
   2 package main;
   3 use vars qw($paymentserversecret $paymentserverport $paymentserverhost);
   4
   5 package FS::cust_main;
   6
   7 use strict;
   8 use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from
   9              $smtpmachine $Debug );
  10 use Safe;
  11 use Carp;
  12 use Time::Local;
  13 use Date::Format;
  14 #use Date::Manip;
  15 use Mail::Internet;
  16 use Mail::Header;
  17 use Business::CreditCard;
  18 use FS::UID qw( getotaker dbh );
  19 use FS::Record qw( qsearchs qsearch );
  20 use FS::cust_pkg;
  21 use FS::cust_bill;
  22 use FS::cust_bill_pkg;
  23 use FS::cust_pay;
  24 use FS::cust_credit;
  25 use FS::cust_pay_batch;
  26 use FS::part_referral;
  27 use FS::cust_main_county;
  28 use FS::agent;
  29 use FS::cust_main_invoice;
  30 use FS::prepay_credit;
  31
  32 @ISA = qw( FS::Record );
  33
  34 $Debug = 0;
  35 #$Debug = 1;
  36
  37 #ask FS::UID to run this stuff for us later
  38 $FS::UID::callback{'FS::cust_main'} = sub {
  39   $conf = new FS::Conf;
  40   $lpr = $conf->config('lpr');
  41   $invoice_from = $conf->config('invoice_from');
  42   $smtpmachine = $conf->config('smtpmachine');
  43
  44   if ( $conf->exists('cybercash3.2') ) {
  45     require CCMckLib3_2;
  46       #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2);
  47     require CCMckDirectLib3_2;
  48       #qw(SendCC2_1Server);
  49     require CCMckErrno3_2;
  50       #qw(MCKGetErrorMessage $E_NoErr);
  51     import CCMckErrno3_2 qw($E_NoErr);
  52
  53     my $merchant_conf;
  54     ($merchant_conf,$xaction)= $conf->config('cybercash3.2');
  55     my $status = &CCMckLib3_2::InitConfig($merchant_conf);
  56     if ( $status != $E_NoErr ) {
  57       warn "CCMckLib3_2::InitConfig error:\n";
  58       foreach my $key (keys %CCMckLib3_2::Config) {
  59         warn "  $key => $CCMckLib3_2::Config{$key}\n"
  60       }
  61       my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status);
  62       die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
  63     }
  64     $processor='cybercash3.2';
  65   } elsif ( $conf->exists('cybercash2') ) {
  66     require CCLib;
  67       #qw(sendmserver);
  68     ( $main::paymentserverhost,
  69       $main::paymentserverport,
  70       $main::paymentserversecret,
  71       $xaction,
  72     ) = $conf->config('cybercash2');
  73     $processor='cybercash2';
  74   }
  75 };
  76
  77 =head1 NAME
  78
  79 FS::cust_main - Object methods for cust_main records
  80
  81 =head1 SYNOPSIS
  82
  83   use FS::cust_main;
  84
  85   $record = new FS::cust_main \%hash;
  86   $record = new FS::cust_main { 'column' => 'value' };
  87
  88   $error = $record->insert;
  89
  90   $error = $new_record->replace($old_record);
  91
  92   $error = $record->delete;
  93
  94   $error = $record->check;
  95
  96   @cust_pkg = $record->all_pkgs;
  97
  98   @cust_pkg = $record->ncancelled_pkgs;
  99
 100   $error = $record->bill;
 101   $error = $record->bill %options;
 102   $error = $record->bill 'time' => $time;
 103
 104   $error = $record->collect;
 105   $error = $record->collect %options;
 106   $error = $record->collect 'invoice_time'   => $time,
 107                             'batch_card'     => 'yes',
 108                             'report_badcard' => 'yes',
 109                           ;
 110
 111 =head1 DESCRIPTION
 112
 113 An FS::cust_main object represents a customer.  FS::cust_main inherits from
 114 FS::Record.  The following fields are currently supported:
 115
 116 =over 4
 117
 118 =item custnum - primary key (assigned automatically for new customers)
 119
 120 =item agentnum - agent (see L<FS::agent>)
 121
 122 =item refnum - referral (see L<FS::part_referral>)
 123
 124 =item first - name
 125
 126 =item last - name
 127
 128 =item ss - social security number (optional)
 129
 130 =item company - (optional)
 131
 132 =item address1
 133
 134 =item address2 - (optional)
 135
 136 =item city
 137
 138 =item county - (optional, see L<FS::cust_main_county>)
 139
 140 =item state - (see L<FS::cust_main_county>)
 141
 142 =item zip
 143
 144 =item country - (see L<FS::cust_main_county>)
 145
 146 =item daytime - phone (optional)
 147
 148 =item night - phone (optional)
 149
 150 =item fax - phone (optional)
 151
 152 =item payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
 153
 154 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
 155
 156 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 157
 158 =item payname - name on card or billing name
 159
 160 =item tax - tax exempt, empty or `Y'
 161
 162 =item otaker - order taker (assigned automatically, see L<FS::UID>)
 163
 164 =back
 165
 166 =head1 METHODS
 167
 168 =over 4
 169
 170 =item new HASHREF
 171
 172 Creates a new customer.  To add the customer to the database, see L<"insert">.
 173
 174 Note that this stores the hash reference, not a distinct copy of the hash it
 175 points to.  You can ask the object for a copy with the I<hash> method.
 176
 177 =cut
 178
 179 sub table { 'cust_main'; }
 180
 181 =item insert
 182
 183 Adds this customer to the database.  If there is an error, returns the error,
 184 otherwise returns false.
 185
 186 There is a special insert mode in which you pass a data structure to the insert
 187 method containing FS::cust_pkg and FS::svc_I<tablename> objects.  When
 188 running under a transactional database, all records are inserted atomicly, or
 189 the transaction is rolled back.  There should be a better explanation of this,
 190 but until then, here's an example:
 191
 192   use Tie::RefHash;
 193   tie %hash, 'Tie::RefHash'; #this part is important
 194   %hash = (
 195     $cust_pkg => [ $svc_acct ],
 196     ...
 197   );
 198   $cust_main->insert( \%hash );
 199
 200 =cut
 201
 202 sub insert {
 203   my $self = shift;
 204   my @param = @_;
 205
 206   local $SIG{HUP} = 'IGNORE';
 207   local $SIG{INT} = 'IGNORE';
 208   local $SIG{QUIT} = 'IGNORE';
 209   local $SIG{TERM} = 'IGNORE';
 210   local $SIG{TSTP} = 'IGNORE';
 211   local $SIG{PIPE} = 'IGNORE';
 212
 213   my $oldAutoCommit = $FS::UID::AutoCommit;
 214   local $FS::UID::AutoCommit = 0;
 215   my $dbh = dbh;
 216
 217   my $amount = 0;
 218   my $seconds = 0;
 219   if ( $self->payby eq 'PREPAY' ) {
 220     $self->payby('BILL');
 221     my $prepay_credit = qsearchs(
 222       'prepay_credit',
 223       { 'identifier' => $self->payinfo },
 224       '',
 225       'FOR UPDATE'
 226     );
 227     warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
 228       unless $prepay_credit;
 229     $amount = $prepay_credit->amount;
 230     $seconds = $prepay_credit->seconds;
 231     my $error = $prepay_credit->delete;
 232     if ( $error ) {
 233       $dbh->rollback if $oldAutoCommit;
 234       return $error;
 235     }
 236   }
 237
 238   my $error = $self->SUPER::insert;
 239   if ( $error ) {
 240     $dbh->rollback if $oldAutoCommit;
 241     return $error;
 242   }
 243
 244   if ( @param ) {
 245     my $cust_pkgs = shift @param;
 246     foreach my $cust_pkg ( keys %$cust_pkgs ) {
 247       $cust_pkg->custnum( $self->custnum );
 248       $error = $cust_pkg->insert;
 249       if ( $error ) {
 250         $dbh->rollback if $oldAutoCommit;
 251         return $error;
 252       }
 253       foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
 254         $svc_something->pkgnum( $cust_pkg->pkgnum );
 255         if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
 256           $svc_something->seconds( $svc_something->seconds + $seconds );
 257           $seconds = 0;
 258         }
 259         $error = $svc_something->insert;
 260         if ( $error ) {
 261           $dbh->rollback if $oldAutoCommit;
 262           return $error;
 263         }
 264       }
 265     }
 266   }
 267
 268   if ( $seconds ) {
 269     $dbh->rollback if $oldAutoCommit;
 270     return "No svc_acct record to apply pre-paid time";
 271   }
 272
 273   if ( $amount ) {
 274     my $cust_credit = new FS::cust_credit {
 275       'custnum' => $self->custnum,
 276       'amount'  => $amount,
 277     };
 278     $error = $cust_credit->insert;
 279     if ( $error ) {
 280       $dbh->rollback if $oldAutoCommit;
 281       return $error;
 282     }
 283   }
 284
 285   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 286   '';
 287
 288 }
 289
 290 =item delete NEW_CUSTNUM
 291
 292 This deletes the customer.  If there is an error, returns the error, otherwise
 293 returns false.
 294
 295 This will completely remove all traces of the customer record.  This is not
 296 what you want when a customer cancels service; for that, cancel all of the
 297 customer's packages (see L<FS::cust_pkg/cancel>).
 298
 299 If the customer has any packages, you need to pass a new (valid) customer
 300 number for those packages to be transferred to.
 301
 302 You can't delete a customer with invoices (see L<FS::cust_bill>),
 303 or credits (see L<FS::cust_credit>).
 304
 305 =cut
 306
 307 sub delete {
 308   my $self = shift;
 309
 310   local $SIG{HUP} = 'IGNORE';
 311   local $SIG{INT} = 'IGNORE';
 312   local $SIG{QUIT} = 'IGNORE';
 313   local $SIG{TERM} = 'IGNORE';
 314   local $SIG{TSTP} = 'IGNORE';
 315   local $SIG{PIPE} = 'IGNORE';
 316
 317   my $oldAutoCommit = $FS::UID::AutoCommit;
 318   local $FS::UID::AutoCommit = 0;
 319   my $dbh = dbh;
 320
 321   if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
 322     $dbh->rollback if $oldAutoCommit;
 323     return "Can't delete a customer with invoices";
 324   }
 325   if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
 326     $dbh->rollback if $oldAutoCommit;
 327     return "Can't delete a customer with credits";
 328   }
 329
 330   my @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } );
 331   if ( @cust_pkg ) {
 332     my $new_custnum = shift;
 333     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
 334       $dbh->rollback if $oldAutoCommit;
 335       return "Invalid new customer number: $new_custnum";
 336     }
 337     foreach my $cust_pkg ( @cust_pkg ) {
 338       my %hash = $cust_pkg->hash;
 339       $hash{'custnum'} = $new_custnum;
 340       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
 341       my $error = $new_cust_pkg->replace($cust_pkg);
 342       if ( $error ) {
 343         $dbh->rollback if $oldAutoCommit;
 344         return $error;
 345       }
 346     }
 347   }
 348   foreach my $cust_main_invoice (
 349     qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
 350   ) {
 351     my $error = $cust_main_invoice->delete;
 352     if ( $error ) {
 353       $dbh->rollback if $oldAutoCommit;
 354       return $error;
 355     }
 356   }
 357
 358   my $error = $self->SUPER::delete;
 359   if ( $error ) {
 360     $dbh->rollback if $oldAutoCommit;
 361     return $error;
 362   }
 363
 364   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 365   '';
 366
 367 }
 368
 369 =item replace OLD_RECORD
 370
 371 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 372 returns the error, otherwise returns false.
 373
 374 =item check
 375
 376 Checks all fields to make sure this is a valid customer record.  If there is
 377 an error, returns the error, otherwise returns false.  Called by the insert
 378 and repalce methods.
 379
 380 =cut
 381
 382 sub check {
 383   my $self = shift;
 384
 385   my $error =
 386     $self->ut_numbern('custnum')
 387     || $self->ut_number('agentnum')
 388     || $self->ut_number('refnum')
 389     || $self->ut_textn('company')
 390     || $self->ut_text('address1')
 391     || $self->ut_textn('address2')
 392     || $self->ut_text('city')
 393     || $self->ut_textn('county')
 394     || $self->ut_textn('state')
 395   ;
 396   #barf.  need message catalogs.  i18n.  etc.
 397   $error .= "Please select a referral."
 398     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
 399   return $error if $error;
 400
 401   return "Unknown agent"
 402     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
 403
 404   return "Unknown referral"
 405     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
 406
 407   $self->getfield('last') =~ /^([\w \,\.\-\']+)$/
 408     or return "Illegal last name: ". $self->getfield('last');
 409   $self->setfield('last',$1);
 410
 411   $self->first =~ /^([\w \,\.\-\']+)$/
 412     or return "Illegal first name: ". $self->first;
 413   $self->first($1);
 414
 415   if ( $self->ss eq '' ) {
 416     $self->ss('');
 417   } else {
 418     my $ss = $self->ss;
 419     $ss =~ s/\D//g;
 420     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
 421       or return "Illegal social security number: ". $self->ss;
 422     $self->ss("$1-$2-$3");
 423   }
 424
 425   $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country;
 426   $self->country($1);
 427   unless ( qsearchs('cust_main_county', {
 428     'country' => $self->country,
 429     'state'   => '',
 430    } ) ) {
 431     return "Unknown state/county/country: ".
 432       $self->state. "/". $self->county. "/". $self->country
 433       unless qsearchs('cust_main_county',{
 434         'state'   => $self->state,
 435         'county'  => $self->county,
 436         'country' => $self->country,
 437       } );
 438   }
 439
 440   $error =
 441     $self->ut_phonen('daytime', $self->country)
 442     || $self->ut_phonen('night', $self->country)
 443     || $self->ut_phonen('fax', $self->country)
 444   ;
 445   return $error if $error;
 446
 447   $self->zip =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
 448     or return "Illegal zip: ". $self->zip;
 449   $self->zip($1);
 450
 451   $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
 452     or return "Illegal payby: ". $self->payby;
 453   $self->payby($1);
 454
 455   if ( $self->payby eq 'CARD' ) {
 456
 457     my $payinfo = $self->payinfo;
 458     $payinfo =~ s/\D//g;
 459     $payinfo =~ /^(\d{13,16})$/
 460       or return "Illegal credit card number: ". $self->payinfo;
 461     $payinfo = $1;
 462     $self->payinfo($payinfo);
 463     validate($payinfo)
 464       or return "Illegal credit card number: ". $self->payinfo;
 465     return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
 466
 467   } elsif ( $self->payby eq 'BILL' ) {
 468
 469     $error = $self->ut_textn('payinfo');
 470     return "Illegal P.O. number: ". $self->payinfo if $error;
 471
 472   } elsif ( $self->payby eq 'COMP' ) {
 473
 474     $error = $self->ut_textn('payinfo');
 475     return "Illegal comp account issuer: ". $self->payinfo if $error;
 476
 477   } elsif ( $self->payby eq 'PREPAY' ) {
 478
 479     my $payinfo = $self->payinfo;
 480     $payinfo =~ s/\W//g; #anything else would just confuse things
 481     $self->payinfo($payinfo);
 482     $error = $self->ut_alpha('payinfo');
 483     return "Illegal prepayment identifier: ". $self->payinfo if $error;
 484     return "Unknown prepayment identifier"
 485       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
 486
 487   }
 488
 489   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
 490     return "Expriation date required"
 491       unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
 492     $self->paydate('');
 493   } else {
 494     $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
 495       or return "Illegal expiration date: ". $self->paydate;
 496     if ( length($2) == 4 ) {
 497       $self->paydate("$2-$1-01");
 498     } elsif ( $2 > 97 ) { #should pry change to check for "this year"
 499       $self->paydate("19$2-$1-01");
 500     } else {
 501       $self->paydate("20$2-$1-01");
 502     }
 503   }
 504
 505   if ( $self->payname eq '' ) {
 506     $self->payname( $self->first. " ". $self->getfield('last') );
 507   } else {
 508     $self->payname =~ /^([\w \,\.\-\']+)$/
 509       or return "Illegal billing name: ". $self->payname;
 510     $self->payname($1);
 511   }
 512
 513   $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
 514   $self->tax($1);
 515
 516   $self->otaker(getotaker);
 517
 518   ''; #no error
 519 }
 520
 521 =item all_pkgs
 522
 523 Returns all packages (see L<FS::cust_pkg>) for this customer.
 524
 525 =cut
 526
 527 sub all_pkgs {
 528   my $self = shift;
 529   qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
 530 }
 531
 532 =item ncancelled_pkgs
 533
 534 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
 535
 536 =cut
 537
 538 sub ncancelled_pkgs {
 539   my $self = shift;
 540   @{ [ # force list context
 541     qsearch( 'cust_pkg', {
 542       'custnum' => $self->custnum,
 543       'cancel'  => '',
 544     }),
 545     qsearch( 'cust_pkg', {
 546       'custnum' => $self->custnum,
 547       'cancel'  => 0,
 548     }),
 549   ] };
 550 }
 551
 552 =item bill OPTIONS
 553
 554 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
 555 conjunction with the collect method.
 556
 557 The only currently available option is `time', which bills the customer as if
 558 it were that time.  It is specified as a UNIX timestamp; see
 559 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
 560 functions.
 561
 562 If there is an error, returns the error, otherwise returns false.
 563
 564 =cut
 565
 566 sub bill {
 567   my( $self, %options ) = @_;
 568   my $time = $options{'time'} || time;
 569
 570   my $error;
 571
 572   #put below somehow?
 573   local $SIG{HUP} = 'IGNORE';
 574   local $SIG{INT} = 'IGNORE';
 575   local $SIG{QUIT} = 'IGNORE';
 576   local $SIG{TERM} = 'IGNORE';
 577   local $SIG{TSTP} = 'IGNORE';
 578   local $SIG{PIPE} = 'IGNORE';
 579
 580   my $oldAutoCommit = $FS::UID::AutoCommit;
 581   local $FS::UID::AutoCommit = 0;
 582   my $dbh = dbh;
 583
 584   # find the packages which are due for billing, find out how much they are
 585   # & generate invoice database.
 586
 587   my( $total_setup, $total_recur ) = ( 0, 0 );
 588   my @cust_bill_pkg;
 589
 590   foreach my $cust_pkg (
 591     qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
 592   ) {
 593
 594     next if $cust_pkg->getfield('cancel');
 595
 596     #? to avoid use of uninitialized value errors... ?
 597     $cust_pkg->setfield('bill', '')
 598       unless defined($cust_pkg->bill);
 599
 600     my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
 601
 602     #so we don't modify cust_pkg record unnecessarily
 603     my $cust_pkg_mod_flag = 0;
 604     my %hash = $cust_pkg->hash;
 605     my $old_cust_pkg = new FS::cust_pkg \%hash;
 606
 607     # bill setup
 608     my $setup = 0;
 609     unless ( $cust_pkg->setup ) {
 610       my $setup_prog = $part_pkg->getfield('setup');
 611       my $cpt = new Safe;
 612       #$cpt->permit(); #what is necessary?
 613       $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
 614       $setup = $cpt->reval($setup_prog);
 615       unless ( defined($setup) ) {
 616         warn "Error reval-ing part_pkg->setup pkgpart ",
 617              $part_pkg->pkgpart, ": $@";
 618       } else {
 619         $cust_pkg->setfield('setup',$time);
 620         $cust_pkg_mod_flag=1;
 621       }
 622     }
 623
 624     #bill recurring fee
 625     my $recur = 0;
 626     my $sdate;
 627     if ( $part_pkg->getfield('freq') > 0 &&
 628          ! $cust_pkg->getfield('susp') &&
 629          ( $cust_pkg->getfield('bill') || 0 ) < $time
 630     ) {
 631       my $recur_prog = $part_pkg->getfield('recur');
 632       my $cpt = new Safe;
 633       #$cpt->permit(); #what is necessary?
 634       $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
 635       $recur = $cpt->reval($recur_prog);
 636       unless ( defined($recur) ) {
 637         warn "Error reval-ing part_pkg->recur pkgpart ",
 638              $part_pkg->pkgpart, ": $@";
 639       } else {
 640         #change this bit to use Date::Manip? CAREFUL with timezones (see
 641         # mailing list archive)
 642         #$sdate=$cust_pkg->bill || time;
 643         #$sdate=$cust_pkg->bill || $time;
 644         $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
 645         my ($sec,$min,$hour,$mday,$mon,$year) =
 646           (localtime($sdate) )[0,1,2,3,4,5];
 647         $mon += $part_pkg->getfield('freq');
 648         until ( $mon < 12 ) { $mon -= 12; $year++; }
 649         $cust_pkg->setfield('bill',
 650           timelocal($sec,$min,$hour,$mday,$mon,$year));
 651         $cust_pkg_mod_flag = 1;
 652       }
 653     }
 654
 655     warn "setup is undefined" unless defined($setup);
 656     warn "recur is undefined" unless defined($recur);
 657     warn "cust_pkg bill is undefined" unless defined($cust_pkg->bill);
 658
 659     if ( $cust_pkg_mod_flag ) {
 660       $error=$cust_pkg->replace($old_cust_pkg);
 661       if ( $error ) { #just in case
 662         warn "Error modifying pkgnum ", $cust_pkg->pkgnum, ": $error";
 663       } else {
 664         $setup = sprintf( "%.2f", $setup );
 665         $recur = sprintf( "%.2f", $recur );
 666         my $cust_bill_pkg = new FS::cust_bill_pkg ({
 667           'pkgnum' => $cust_pkg->pkgnum,
 668           'setup'  => $setup,
 669           'recur'  => $recur,
 670           'sdate'  => $sdate,
 671           'edate'  => $cust_pkg->bill,
 672         });
 673         push @cust_bill_pkg, $cust_bill_pkg;
 674         $total_setup += $setup;
 675         $total_recur += $recur;
 676       }
 677     }
 678
 679   }
 680
 681   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
 682
 683   unless ( @cust_bill_pkg ) {
 684     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 685     return '';
 686   }
 687
 688   unless ( $self->getfield('tax') =~ /Y/i
 689            || $self->getfield('payby') eq 'COMP'
 690   ) {
 691     my $cust_main_county = qsearchs('cust_main_county',{
 692         'state'   => $self->state,
 693         'county'  => $self->county,
 694         'country' => $self->country,
 695     } );
 696     my $tax = sprintf( "%.2f",
 697       $charged * ( $cust_main_county->getfield('tax') / 100 )
 698     );
 699     $charged = sprintf( "%.2f", $charged+$tax );
 700
 701     my $cust_bill_pkg = new FS::cust_bill_pkg ({
 702       'pkgnum' => 0,
 703       'setup'  => $tax,
 704       'recur'  => 0,
 705       'sdate'  => '',
 706       'edate'  => '',
 707     });
 708     push @cust_bill_pkg, $cust_bill_pkg;
 709   }
 710
 711   my $cust_bill = new FS::cust_bill ( {
 712     'custnum' => $self->getfield('custnum'),
 713     '_date' => $time,
 714     'charged' => $charged,
 715   } );
 716   $error = $cust_bill->insert;
 717   if ( $error ) {
 718     $dbh->rollback if $oldAutoCommit;
 719     return "$error for customer #". $self->custnum;
 720   }
 721
 722   my $invnum = $cust_bill->invnum;
 723   my $cust_bill_pkg;
 724   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
 725     $cust_bill_pkg->setfield( 'invnum', $invnum );
 726     $error = $cust_bill_pkg->insert;
 727     #shouldn't happen, but how else tohandle this?
 728     if ( $error ) {
 729       $dbh->rollback if $oldAutoCommit;
 730       return "$error for customer #". $self->custnum;
 731     }
 732   }
 733
 734   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 735   ''; #no error
 736 }
 737
 738 =item collect OPTIONS
 739
 740 (Attempt to) collect money for this customer's outstanding invoices (see
 741 L<FS::cust_bill>).  Usually used after the bill method.
 742
 743 Depending on the value of `payby', this may print an invoice (`BILL'), charge
 744 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
 745
 746 If there is an error, returns the error, otherwise returns false.
 747
 748 Currently available options are:
 749
 750 invoice_time - Use this time when deciding when to print invoices and
 751 late notices on those invoices.  The default is now.  It is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse>
 752 for conversion functions.
 753
 754 batch_card - Set this true to batch cards (see L<cust_pay_batch>).  By
 755 default, cards are processed immediately, which will generate an error if
 756 CyberCash is not installed.
 757
 758 report_badcard - Set this true if you want bad card transactions to
 759 return an error.  By default, they don't.
 760
 761 =cut
 762
 763 sub collect {
 764   my( $self, %options ) = @_;
 765   my $invoice_time = $options{'invoice_time'} || time;
 766
 767   #put below somehow?
 768   local $SIG{HUP} = 'IGNORE';
 769   local $SIG{INT} = 'IGNORE';
 770   local $SIG{QUIT} = 'IGNORE';
 771   local $SIG{TERM} = 'IGNORE';
 772   local $SIG{TSTP} = 'IGNORE';
 773   local $SIG{PIPE} = 'IGNORE';
 774
 775   my $oldAutoCommit = $FS::UID::AutoCommit;
 776   local $FS::UID::AutoCommit = 0;
 777   my $dbh = dbh;
 778
 779   my $total_owed = $self->balance;
 780   warn "collect: total owed $total_owed " if $Debug;
 781   unless ( $total_owed > 0 ) { #redundant?????
 782     $dbh->rollback if $oldAutoCommit;
 783     return '';
 784   }
 785
 786   foreach my $cust_bill (
 787     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
 788   ) {
 789
 790     #this has to be before next's
 791     my $amount = sprintf( "%.2f", $total_owed < $cust_bill->owed
 792                                   ? $total_owed
 793                                   : $cust_bill->owed
 794     );
 795     $total_owed = sprintf( "%.2f", $total_owed - $amount );
 796
 797     next unless $cust_bill->owed > 0;
 798
 799     next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
 800
 801     warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, total_owed $total_owed)" if $Debug;
 802
 803     next unless $amount > 0;
 804
 805     if ( $self->payby eq 'BILL' ) {
 806
 807       #30 days 2592000
 808       my $since = $invoice_time - ( $cust_bill->_date || 0 );
 809       #warn "$invoice_time ", $cust_bill->_date, " $since";
 810       if ( $since >= 0 #don't print future invoices
 811            && ( $cust_bill->printed * 2592000 ) <= $since
 812       ) {
 813
 814         #my @print_text = $cust_bill->print_text; #( date )
 815         my @invoicing_list = $self->invoicing_list;
 816         if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
 817           $ENV{SMTPHOSTS} = $smtpmachine;
 818           $ENV{MAILADDRESS} = $invoice_from;
 819           my $header = new Mail::Header ( [
 820             "From: $invoice_from",
 821             "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
 822             "Sender: $invoice_from",
 823             "Reply-To: $invoice_from",
 824             "Date: ". time2str("%a, %d %b %Y %X %z", time),
 825             "Subject: Invoice",
 826           ] );
 827           my $message = new Mail::Internet (
 828             'Header' => $header,
 829             'Body' => [ $cust_bill->print_text ], #( date)
 830           );
 831           $message->smtpsend or die "Can't send invoice email!"; #die?  warn?
 832
 833         } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
 834           open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
 835           print LPR $cust_bill->print_text; #( date )
 836           close LPR
 837             or die $! ? "Error closing $lpr: $!"
 838                          : "Exit status $? from $lpr";
 839         }
 840
 841         my %hash = $cust_bill->hash;
 842         $hash{'printed'}++;
 843         my $new_cust_bill = new FS::cust_bill(\%hash);
 844         my $error = $new_cust_bill->replace($cust_bill);
 845         warn "Error updating $cust_bill->printed: $error" if $error;
 846
 847       }
 848
 849     } elsif ( $self->payby eq 'COMP' ) {
 850       my $cust_pay = new FS::cust_pay ( {
 851          'invnum' => $cust_bill->invnum,
 852          'paid' => $amount,
 853          '_date' => '',
 854          'payby' => 'COMP',
 855          'payinfo' => $self->payinfo,
 856          'paybatch' => ''
 857       } );
 858       my $error = $cust_pay->insert;
 859       if ( $error ) {
 860         $dbh->rollback if $oldAutoCommit;
 861         return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
 862       }
 863
 864
 865     } elsif ( $self->payby eq 'CARD' ) {
 866
 867       if ( $options{'batch_card'} ne 'yes' ) {
 868
 869         unless ( $processor ) {
 870           $dbh->rollback if $oldAutoCommit;
 871           return "Real time card processing not enabled!";
 872         }
 873
 874         if ( $processor =~ /^cybercash/ ) {
 875
 876           #fix exp. date for cybercash
 877           #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
 878           $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
 879           my $exp = "$2/$1";
 880
 881           my $paybatch = $cust_bill->invnum.
 882                          '-' . time2str("%y%m%d%H%M%S", time);
 883
 884           my $payname = $self->payname ||
 885                         $self->getfield('first'). ' '. $self->getfield('last');
 886
 887           my $address = $self->address1;
 888           $address .= ", ". $self->address2 if $self->address2;
 889
 890           my $country = 'USA' if $self->country eq 'US';
 891
 892           my @full_xaction = ( $xaction,
 893             'Order-ID'     => $paybatch,
 894             'Amount'       => "usd $amount",
 895             'Card-Number'  => $self->getfield('payinfo'),
 896             'Card-Name'    => $payname,
 897             'Card-Address' => $address,
 898             'Card-City'    => $self->getfield('city'),
 899             'Card-State'   => $self->getfield('state'),
 900             'Card-Zip'     => $self->getfield('zip'),
 901             'Card-Country' => $country,
 902             'Card-Exp'     => $exp,
 903           );
 904
 905           my %result;
 906           if ( $processor eq 'cybercash2' ) {
 907             $^W=0; #CCLib isn't -w safe, ugh!
 908             %result = &CCLib::sendmserver(@full_xaction);
 909             $^W=1;
 910           } elsif ( $processor eq 'cybercash3.2' ) {
 911             %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
 912           } else {
 913             $dbh->rollback if $oldAutoCommit;
 914             return "Unknown real-time processor $processor";
 915           }
 916
 917           #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
 918           #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
 919           if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
 920             my $cust_pay = new FS::cust_pay ( {
 921                'invnum'   => $cust_bill->invnum,
 922                'paid'     => $amount,
 923                '_date'     => '',
 924                'payby'    => 'CARD',
 925                'payinfo'  => $self->payinfo,
 926                'paybatch' => "$processor:$paybatch",
 927             } );
 928             my $error = $cust_pay->insert;
 929             if ( $error ) {
 930               # gah, even with transactions.
 931               $dbh->commit if $oldAutoCommit; #well.
 932               my $e = 'WARNING: Card debited but database not updated - '.
 933                       'error applying payment, invnum #' . $cust_bill->invnum.
 934                       " (CyberCash Order-ID $paybatch): $error";
 935               warn $e;
 936               return $e;
 937             }
 938           } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
 939                  || $options{'report_badcard'} ) {
 940              $dbh->commit if $oldAutoCommit;
 941              return 'Cybercash error, invnum #' .
 942                $cust_bill->invnum. ':'. $result{'MErrMsg'};
 943           } else {
 944             $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 945             return '';
 946           }
 947
 948         } else {
 949           $dbh->rollback if $oldAutoCommit;
 950           return "Unknown real-time processor $processor\n";
 951         }
 952
 953       } else { #batch card
 954
 955        my $cust_pay_batch = new FS::cust_pay_batch ( {
 956          'invnum'   => $cust_bill->getfield('invnum'),
 957          'custnum'  => $self->getfield('custnum'),
 958          'last'     => $self->getfield('last'),
 959          'first'    => $self->getfield('first'),
 960          'address1' => $self->getfield('address1'),
 961          'address2' => $self->getfield('address2'),
 962          'city'     => $self->getfield('city'),
 963          'state'    => $self->getfield('state'),
 964          'zip'      => $self->getfield('zip'),
 965          'country'  => $self->getfield('country'),
 966          'trancode' => 77,
 967          'cardnum'  => $self->getfield('payinfo'),
 968          'exp'      => $self->getfield('paydate'),
 969          'payname'  => $self->getfield('payname'),
 970          'amount'   => $amount,
 971        } );
 972        my $error = $cust_pay_batch->insert;
 973        if ( $error ) {
 974          $dbh->rollback if $oldAutoCommit;
 975          return "Error adding to cust_pay_batch: $error";
 976        }
 977
 978       }
 979
 980     } else {
 981       $dbh->rollback if $oldAutoCommit;
 982       return "Unknown payment type ". $self->payby;
 983     }
 984
 985   }
 986   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 987   '';
 988
 989 }
 990
 991 =item total_owed
 992
 993 Returns the total owed for this customer on all invoices
 994 (see L<FS::cust_bill>).
 995
 996 =cut
 997
 998 sub total_owed {
 999   my $self = shift;
1000   my $total_bill = 0;
1001   foreach my $cust_bill ( qsearch('cust_bill', {
1002     'custnum' => $self->custnum,
1003   } ) ) {
1004     $total_bill += $cust_bill->owed;
1005   }
1006   sprintf( "%.2f", $total_bill );
1007 }
1008
1009 =item total_credited
1010
1011 Returns the total credits (see L<FS::cust_credit>) for this customer.
1012
1013 =cut
1014
1015 sub total_credited {
1016   my $self = shift;
1017   my $total_credit = 0;
1018   foreach my $cust_credit ( qsearch('cust_credit', {
1019     'custnum' => $self->custnum,
1020   } ) ) {
1021     $total_credit += $cust_credit->credited;
1022   }
1023   sprintf( "%.2f", $total_credit );
1024 }
1025
1026 =item balance
1027
1028 Returns the balance for this customer (total owed minus total credited).
1029
1030 =cut
1031
1032 sub balance {
1033   my $self = shift;
1034   sprintf( "%.2f", $self->total_owed - $self->total_credited );
1035 }
1036
1037 =item invoicing_list [ ARRAYREF ]
1038
1039 If an arguement is given, sets these email addresses as invoice recipients
1040 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
1041 (except as warnings), so use check_invoicing_list first.
1042
1043 Returns a list of email addresses (with svcnum entries expanded).
1044
1045 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
1046 check it without disturbing anything by passing nothing.
1047
1048 This interface may change in the future.
1049
1050 =cut
1051
1052 sub invoicing_list {
1053   my( $self, $arrayref ) = @_;
1054   if ( $arrayref ) {
1055     my @cust_main_invoice;
1056     if ( $self->custnum ) {
1057       @cust_main_invoice =
1058         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1059     } else {
1060       @cust_main_invoice = ();
1061     }
1062     foreach my $cust_main_invoice ( @cust_main_invoice ) {
1063       #warn $cust_main_invoice->destnum;
1064       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1065         #warn $cust_main_invoice->destnum;
1066         my $error = $cust_main_invoice->delete;
1067         warn $error if $error;
1068       }
1069     }
1070     if ( $self->custnum ) {
1071       @cust_main_invoice =
1072         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1073     } else {
1074       @cust_main_invoice = ();
1075     }
1076     foreach my $address ( @{$arrayref} ) {
1077       unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1078         my $cust_main_invoice = new FS::cust_main_invoice ( {
1079           'custnum' => $self->custnum,
1080           'dest'    => $address,
1081         } );
1082         my $error = $cust_main_invoice->insert;
1083         warn $error if $error;
1084       }
1085     }
1086   }
1087   if ( $self->custnum ) {
1088     map { $_->address }
1089       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1090   } else {
1091     ();
1092   }
1093 }
1094
1095 =item check_invoicing_list ARRAYREF
1096
1097 Checks these arguements as valid input for the invoicing_list method.  If there
1098 is an error, returns the error, otherwise returns false.
1099
1100 =cut
1101
1102 sub check_invoicing_list {
1103   my( $self, $arrayref ) = @_;
1104   foreach my $address ( @{$arrayref} ) {
1105     my $cust_main_invoice = new FS::cust_main_invoice ( {
1106       'custnum' => $self->custnum,
1107       'dest'    => $address,
1108     } );
1109     my $error = $self->custnum
1110                 ? $cust_main_invoice->check
1111                 : $cust_main_invoice->checkdest
1112     ;
1113     return $error if $error;
1114   }
1115   '';
1116 }
1117
1118 =back
1119
1120 =head1 VERSION
1121
1122 $Id: cust_main.pm,v 1.13 2001-05-07 02:07:38 ivan Exp $
1123
1124 =head1 BUGS
1125
1126 The delete method.
1127
1128 The delete method should possibly take an FS::cust_main object reference
1129 instead of a scalar customer number.
1130
1131 Bill and collect options should probably be passed as references instead of a
1132 list.
1133
1134 CyberCash v2 forces us to define some variables in package main.
1135
1136 There should probably be a configuration file with a list of allowed credit
1137 card types.
1138
1139 CyberCash is the only processor.
1140
1141 No multiple currency support (probably a larger project than just this module).
1142
1143 =head1 SEE ALSO
1144
1145 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1146 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1147 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1148 L<FS::UID>, schema.html from the base documentation.
1149
1150 =cut
1151
1152 1;
1153
1154