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