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