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