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       $setup_prog =~ /^(.*)$/ #presumably trusted
 612         or die "Illegal setup for package ". $cust_pkg->pkgnum. ": $setup_prog";
 613       $setup_prog = $1;
 614       my $cpt = new Safe;
 615       #$cpt->permit(); #what is necessary?
 616       $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
 617       $setup = $cpt->reval($setup_prog);
 618       unless ( defined($setup) ) {
 619         warn "Error reval-ing part_pkg->setup pkgpart ",
 620              $part_pkg->pkgpart, ": $@";
 621       } else {
 622         $cust_pkg->setfield('setup',$time);
 623         $cust_pkg_mod_flag=1;
 624       }
 625     }
 626
 627     #bill recurring fee
 628     my $recur = 0;
 629     my $sdate;
 630     if ( $part_pkg->getfield('freq') > 0 &&
 631          ! $cust_pkg->getfield('susp') &&
 632          ( $cust_pkg->getfield('bill') || 0 ) < $time
 633     ) {
 634       my $recur_prog = $part_pkg->getfield('recur');
 635       $recur_prog =~ /^(.*)$/ #presumably trusted
 636         or die "Illegal recur for package ". $cust_pkg->pkgnum. ": $recur_prog";
 637       $recur_prog = $1;
 638       my $cpt = new Safe;
 639       #$cpt->permit(); #what is necessary?
 640       $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
 641       $recur = $cpt->reval($recur_prog);
 642       unless ( defined($recur) ) {
 643         warn "Error reval-ing part_pkg->recur pkgpart ",
 644              $part_pkg->pkgpart, ": $@";
 645       } else {
 646         #change this bit to use Date::Manip? CAREFUL with timezones (see
 647         # mailing list archive)
 648         #$sdate=$cust_pkg->bill || time;
 649         #$sdate=$cust_pkg->bill || $time;
 650         $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
 651         my ($sec,$min,$hour,$mday,$mon,$year) =
 652           (localtime($sdate) )[0,1,2,3,4,5];
 653         $mon += $part_pkg->getfield('freq');
 654         until ( $mon < 12 ) { $mon -= 12; $year++; }
 655         $cust_pkg->setfield('bill',
 656           timelocal($sec,$min,$hour,$mday,$mon,$year));
 657         $cust_pkg_mod_flag = 1;
 658       }
 659     }
 660
 661     warn "setup is undefined" unless defined($setup);
 662     warn "recur is undefined" unless defined($recur);
 663     warn "cust_pkg bill is undefined" unless defined($cust_pkg->bill);
 664
 665     if ( $cust_pkg_mod_flag ) {
 666       $error=$cust_pkg->replace($old_cust_pkg);
 667       if ( $error ) { #just in case
 668         warn "Error modifying pkgnum ", $cust_pkg->pkgnum, ": $error";
 669       } else {
 670         $setup = sprintf( "%.2f", $setup );
 671         $recur = sprintf( "%.2f", $recur );
 672         my $cust_bill_pkg = new FS::cust_bill_pkg ({
 673           'pkgnum' => $cust_pkg->pkgnum,
 674           'setup'  => $setup,
 675           'recur'  => $recur,
 676           'sdate'  => $sdate,
 677           'edate'  => $cust_pkg->bill,
 678         });
 679         push @cust_bill_pkg, $cust_bill_pkg;
 680         $total_setup += $setup;
 681         $total_recur += $recur;
 682       }
 683     }
 684
 685   }
 686
 687   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
 688
 689   unless ( @cust_bill_pkg ) {
 690     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 691     return '';
 692   }
 693
 694   unless ( $self->getfield('tax') =~ /Y/i
 695            || $self->getfield('payby') eq 'COMP'
 696   ) {
 697     my $cust_main_county = qsearchs('cust_main_county',{
 698         'state'   => $self->state,
 699         'county'  => $self->county,
 700         'country' => $self->country,
 701     } );
 702     my $tax = sprintf( "%.2f",
 703       $charged * ( $cust_main_county->getfield('tax') / 100 )
 704     );
 705     $charged = sprintf( "%.2f", $charged+$tax );
 706
 707     my $cust_bill_pkg = new FS::cust_bill_pkg ({
 708       'pkgnum' => 0,
 709       'setup'  => $tax,
 710       'recur'  => 0,
 711       'sdate'  => '',
 712       'edate'  => '',
 713     });
 714     push @cust_bill_pkg, $cust_bill_pkg;
 715   }
 716
 717   my $cust_bill = new FS::cust_bill ( {
 718     'custnum' => $self->getfield('custnum'),
 719     '_date' => $time,
 720     'charged' => $charged,
 721   } );
 722   $error = $cust_bill->insert;
 723   if ( $error ) {
 724     $dbh->rollback if $oldAutoCommit;
 725     return "$error for customer #". $self->custnum;
 726   }
 727
 728   my $invnum = $cust_bill->invnum;
 729   my $cust_bill_pkg;
 730   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
 731     $cust_bill_pkg->setfield( 'invnum', $invnum );
 732     $error = $cust_bill_pkg->insert;
 733     #shouldn't happen, but how else tohandle this?
 734     if ( $error ) {
 735       $dbh->rollback if $oldAutoCommit;
 736       return "$error for customer #". $self->custnum;
 737     }
 738   }
 739
 740   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 741   ''; #no error
 742 }
 743
 744 =item collect OPTIONS
 745
 746 (Attempt to) collect money for this customer's outstanding invoices (see
 747 L<FS::cust_bill>).  Usually used after the bill method.
 748
 749 Depending on the value of `payby', this may print an invoice (`BILL'), charge
 750 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
 751
 752 If there is an error, returns the error, otherwise returns false.
 753
 754 Currently available options are:
 755
 756 invoice_time - Use this time when deciding when to print invoices and
 757 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>
 758 for conversion functions.
 759
 760 batch_card - Set this true to batch cards (see L<cust_pay_batch>).  By
 761 default, cards are processed immediately, which will generate an error if
 762 CyberCash is not installed.
 763
 764 report_badcard - Set this true if you want bad card transactions to
 765 return an error.  By default, they don't.
 766
 767 =cut
 768
 769 sub collect {
 770   my( $self, %options ) = @_;
 771   my $invoice_time = $options{'invoice_time'} || time;
 772
 773   #put below somehow?
 774   local $SIG{HUP} = 'IGNORE';
 775   local $SIG{INT} = 'IGNORE';
 776   local $SIG{QUIT} = 'IGNORE';
 777   local $SIG{TERM} = 'IGNORE';
 778   local $SIG{TSTP} = 'IGNORE';
 779   local $SIG{PIPE} = 'IGNORE';
 780
 781   my $oldAutoCommit = $FS::UID::AutoCommit;
 782   local $FS::UID::AutoCommit = 0;
 783   my $dbh = dbh;
 784
 785   my $total_owed = $self->balance;
 786   warn "collect: total owed $total_owed " if $Debug;
 787   unless ( $total_owed > 0 ) { #redundant?????
 788     $dbh->rollback if $oldAutoCommit;
 789     return '';
 790   }
 791
 792   foreach my $cust_bill (
 793     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
 794   ) {
 795
 796     #this has to be before next's
 797     my $amount = sprintf( "%.2f", $total_owed < $cust_bill->owed
 798                                   ? $total_owed
 799                                   : $cust_bill->owed
 800     );
 801     $total_owed = sprintf( "%.2f", $total_owed - $amount );
 802
 803     next unless $cust_bill->owed > 0;
 804
 805     next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
 806
 807     warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, total_owed $total_owed)" if $Debug;
 808
 809     next unless $amount > 0;
 810
 811     if ( $self->payby eq 'BILL' ) {
 812
 813       #30 days 2592000
 814       my $since = $invoice_time - ( $cust_bill->_date || 0 );
 815       #warn "$invoice_time ", $cust_bill->_date, " $since";
 816       if ( $since >= 0 #don't print future invoices
 817            && ( $cust_bill->printed * 2592000 ) <= $since
 818       ) {
 819
 820         #my @print_text = $cust_bill->print_text; #( date )
 821         my @invoicing_list = $self->invoicing_list;
 822         if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
 823           $ENV{SMTPHOSTS} = $smtpmachine;
 824           $ENV{MAILADDRESS} = $invoice_from;
 825           my $header = new Mail::Header ( [
 826             "From: $invoice_from",
 827             "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
 828             "Sender: $invoice_from",
 829             "Reply-To: $invoice_from",
 830             "Date: ". time2str("%a, %d %b %Y %X %z", time),
 831             "Subject: Invoice",
 832           ] );
 833           my $message = new Mail::Internet (
 834             'Header' => $header,
 835             'Body' => [ $cust_bill->print_text ], #( date)
 836           );
 837           $message->smtpsend or die "Can't send invoice email!"; #die?  warn?
 838
 839         } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
 840           open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
 841           print LPR $cust_bill->print_text; #( date )
 842           close LPR
 843             or die $! ? "Error closing $lpr: $!"
 844                          : "Exit status $? from $lpr";
 845         }
 846
 847         my %hash = $cust_bill->hash;
 848         $hash{'printed'}++;
 849         my $new_cust_bill = new FS::cust_bill(\%hash);
 850         my $error = $new_cust_bill->replace($cust_bill);
 851         warn "Error updating $cust_bill->printed: $error" if $error;
 852
 853       }
 854
 855     } elsif ( $self->payby eq 'COMP' ) {
 856       my $cust_pay = new FS::cust_pay ( {
 857          'invnum' => $cust_bill->invnum,
 858          'paid' => $amount,
 859          '_date' => '',
 860          'payby' => 'COMP',
 861          'payinfo' => $self->payinfo,
 862          'paybatch' => ''
 863       } );
 864       my $error = $cust_pay->insert;
 865       if ( $error ) {
 866         $dbh->rollback if $oldAutoCommit;
 867         return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
 868       }
 869
 870
 871     } elsif ( $self->payby eq 'CARD' ) {
 872
 873       if ( $options{'batch_card'} ne 'yes' ) {
 874
 875         unless ( $processor ) {
 876           $dbh->rollback if $oldAutoCommit;
 877           return "Real time card processing not enabled!";
 878         }
 879
 880         if ( $processor =~ /^cybercash/ ) {
 881
 882           #fix exp. date for cybercash
 883           #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
 884           $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
 885           my $exp = "$2/$1";
 886
 887           my $paybatch = $cust_bill->invnum.
 888                          '-' . time2str("%y%m%d%H%M%S", time);
 889
 890           my $payname = $self->payname ||
 891                         $self->getfield('first'). ' '. $self->getfield('last');
 892
 893           my $address = $self->address1;
 894           $address .= ", ". $self->address2 if $self->address2;
 895
 896           my $country = 'USA' if $self->country eq 'US';
 897
 898           my @full_xaction = ( $xaction,
 899             'Order-ID'     => $paybatch,
 900             'Amount'       => "usd $amount",
 901             'Card-Number'  => $self->getfield('payinfo'),
 902             'Card-Name'    => $payname,
 903             'Card-Address' => $address,
 904             'Card-City'    => $self->getfield('city'),
 905             'Card-State'   => $self->getfield('state'),
 906             'Card-Zip'     => $self->getfield('zip'),
 907             'Card-Country' => $country,
 908             'Card-Exp'     => $exp,
 909           );
 910
 911           my %result;
 912           if ( $processor eq 'cybercash2' ) {
 913             $^W=0; #CCLib isn't -w safe, ugh!
 914             %result = &CCLib::sendmserver(@full_xaction);
 915             $^W=1;
 916           } elsif ( $processor eq 'cybercash3.2' ) {
 917             %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
 918           } else {
 919             $dbh->rollback if $oldAutoCommit;
 920             return "Unknown real-time processor $processor";
 921           }
 922
 923           #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
 924           #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
 925           if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
 926             my $cust_pay = new FS::cust_pay ( {
 927                'invnum'   => $cust_bill->invnum,
 928                'paid'     => $amount,
 929                '_date'     => '',
 930                'payby'    => 'CARD',
 931                'payinfo'  => $self->payinfo,
 932                'paybatch' => "$processor:$paybatch",
 933             } );
 934             my $error = $cust_pay->insert;
 935             if ( $error ) {
 936               # gah, even with transactions.
 937               $dbh->commit if $oldAutoCommit; #well.
 938               my $e = 'WARNING: Card debited but database not updated - '.
 939                       'error applying payment, invnum #' . $cust_bill->invnum.
 940                       " (CyberCash Order-ID $paybatch): $error";
 941               warn $e;
 942               return $e;
 943             }
 944           } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
 945                  || $options{'report_badcard'} ) {
 946              $dbh->commit if $oldAutoCommit;
 947              return 'Cybercash error, invnum #' .
 948                $cust_bill->invnum. ':'. $result{'MErrMsg'};
 949           } else {
 950             $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 951             return '';
 952           }
 953
 954         } else {
 955           $dbh->rollback if $oldAutoCommit;
 956           return "Unknown real-time processor $processor\n";
 957         }
 958
 959       } else { #batch card
 960
 961        my $cust_pay_batch = new FS::cust_pay_batch ( {
 962          'invnum'   => $cust_bill->getfield('invnum'),
 963          'custnum'  => $self->getfield('custnum'),
 964          'last'     => $self->getfield('last'),
 965          'first'    => $self->getfield('first'),
 966          'address1' => $self->getfield('address1'),
 967          'address2' => $self->getfield('address2'),
 968          'city'     => $self->getfield('city'),
 969          'state'    => $self->getfield('state'),
 970          'zip'      => $self->getfield('zip'),
 971          'country'  => $self->getfield('country'),
 972          'trancode' => 77,
 973          'cardnum'  => $self->getfield('payinfo'),
 974          'exp'      => $self->getfield('paydate'),
 975          'payname'  => $self->getfield('payname'),
 976          'amount'   => $amount,
 977        } );
 978        my $error = $cust_pay_batch->insert;
 979        if ( $error ) {
 980          $dbh->rollback if $oldAutoCommit;
 981          return "Error adding to cust_pay_batch: $error";
 982        }
 983
 984       }
 985
 986     } else {
 987       $dbh->rollback if $oldAutoCommit;
 988       return "Unknown payment type ". $self->payby;
 989     }
 990
 991   }
 992   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 993   '';
 994
 995 }
 996
 997 =item total_owed
 998
 999 Returns the total owed for this customer on all invoices
1000 (see L<FS::cust_bill>).
1001
1002 =cut
1003
1004 sub total_owed {
1005   my $self = shift;
1006   my $total_bill = 0;
1007   foreach my $cust_bill ( qsearch('cust_bill', {
1008     'custnum' => $self->custnum,
1009   } ) ) {
1010     $total_bill += $cust_bill->owed;
1011   }
1012   sprintf( "%.2f", $total_bill );
1013 }
1014
1015 =item total_credited
1016
1017 Returns the total credits (see L<FS::cust_credit>) for this customer.
1018
1019 =cut
1020
1021 sub total_credited {
1022   my $self = shift;
1023   my $total_credit = 0;
1024   foreach my $cust_credit ( qsearch('cust_credit', {
1025     'custnum' => $self->custnum,
1026   } ) ) {
1027     $total_credit += $cust_credit->credited;
1028   }
1029   sprintf( "%.2f", $total_credit );
1030 }
1031
1032 =item balance
1033
1034 Returns the balance for this customer (total owed minus total credited).
1035
1036 =cut
1037
1038 sub balance {
1039   my $self = shift;
1040   sprintf( "%.2f", $self->total_owed - $self->total_credited );
1041 }
1042
1043 =item invoicing_list [ ARRAYREF ]
1044
1045 If an arguement is given, sets these email addresses as invoice recipients
1046 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
1047 (except as warnings), so use check_invoicing_list first.
1048
1049 Returns a list of email addresses (with svcnum entries expanded).
1050
1051 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
1052 check it without disturbing anything by passing nothing.
1053
1054 This interface may change in the future.
1055
1056 =cut
1057
1058 sub invoicing_list {
1059   my( $self, $arrayref ) = @_;
1060   if ( $arrayref ) {
1061     my @cust_main_invoice;
1062     if ( $self->custnum ) {
1063       @cust_main_invoice =
1064         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1065     } else {
1066       @cust_main_invoice = ();
1067     }
1068     foreach my $cust_main_invoice ( @cust_main_invoice ) {
1069       #warn $cust_main_invoice->destnum;
1070       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1071         #warn $cust_main_invoice->destnum;
1072         my $error = $cust_main_invoice->delete;
1073         warn $error if $error;
1074       }
1075     }
1076     if ( $self->custnum ) {
1077       @cust_main_invoice =
1078         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1079     } else {
1080       @cust_main_invoice = ();
1081     }
1082     foreach my $address ( @{$arrayref} ) {
1083       unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1084         my $cust_main_invoice = new FS::cust_main_invoice ( {
1085           'custnum' => $self->custnum,
1086           'dest'    => $address,
1087         } );
1088         my $error = $cust_main_invoice->insert;
1089         warn $error if $error;
1090       }
1091     }
1092   }
1093   if ( $self->custnum ) {
1094     map { $_->address }
1095       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1096   } else {
1097     ();
1098   }
1099 }
1100
1101 =item check_invoicing_list ARRAYREF
1102
1103 Checks these arguements as valid input for the invoicing_list method.  If there
1104 is an error, returns the error, otherwise returns false.
1105
1106 =cut
1107
1108 sub check_invoicing_list {
1109   my( $self, $arrayref ) = @_;
1110   foreach my $address ( @{$arrayref} ) {
1111     my $cust_main_invoice = new FS::cust_main_invoice ( {
1112       'custnum' => $self->custnum,
1113       'dest'    => $address,
1114     } );
1115     my $error = $self->custnum
1116                 ? $cust_main_invoice->check
1117                 : $cust_main_invoice->checkdest
1118     ;
1119     return $error if $error;
1120   }
1121   '';
1122 }
1123
1124 =back
1125
1126 =head1 VERSION
1127
1128 $Id: cust_main.pm,v 1.14 2001-06-03 10:51:54 ivan Exp $
1129
1130 =head1 BUGS
1131
1132 The delete method.
1133
1134 The delete method should possibly take an FS::cust_main object reference
1135 instead of a scalar customer number.
1136
1137 Bill and collect options should probably be passed as references instead of a
1138 list.
1139
1140 CyberCash v2 forces us to define some variables in package main.
1141
1142 There should probably be a configuration file with a list of allowed credit
1143 card types.
1144
1145 CyberCash is the only processor.
1146
1147 No multiple currency support (probably a larger project than just this module).
1148
1149 =head1 SEE ALSO
1150
1151 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1152 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1153 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1154 L<FS::UID>, schema.html from the base documentation.
1155
1156 =cut
1157
1158 1;
1159
1160