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