site_perl/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 );
  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 );
  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
  31 @ISA = qw( FS::Record );
  32
  33 #ask FS::UID to run this stuff for us later
  34 $FS::UID::callback{'FS::cust_main'} = sub {
  35   $conf = new FS::Conf;
  36   $lpr = $conf->config('lpr');
  37   $invoice_from = $conf->config('invoice_from');
  38   $smtpmachine = $conf->config('smtpmachine');
  39
  40   if ( $conf->exists('cybercash3.2') ) {
  41     require CCMckLib3_2;
  42       #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2);
  43     require CCMckDirectLib3_2;
  44       #qw(SendCC2_1Server);
  45     require CCMckErrno3_2;
  46       #qw(MCKGetErrorMessage $E_NoErr);
  47     import CCMckErrno3_2 qw($E_NoErr);
  48
  49     my $merchant_conf;
  50     ($merchant_conf,$xaction)= $conf->config('cybercash3.2');
  51     my $status = &CCMckLib3_2::InitConfig($merchant_conf);
  52     if ( $status != $E_NoErr ) {
  53       warn "CCMckLib3_2::InitConfig error:\n";
  54       foreach my $key (keys %CCMckLib3_2::Config) {
  55         warn "  $key => $CCMckLib3_2::Config{$key}\n"
  56       }
  57       my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status);
  58       die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
  59     }
  60     $processor='cybercash3.2';
  61   } elsif ( $conf->exists('cybercash2') ) {
  62     require CCLib;
  63       #qw(sendmserver);
  64     ( $main::paymentserverhost,
  65       $main::paymentserverport,
  66       $main::paymentserversecret,
  67       $xaction,
  68     ) = $conf->config('cybercash2');
  69     $processor='cybercash2';
  70   }
  71 };
  72
  73 =head1 NAME
  74
  75 FS::cust_main - Object methods for cust_main records
  76
  77 =head1 SYNOPSIS
  78
  79   use FS::cust_main;
  80
  81   $record = new FS::cust_main \%hash;
  82   $record = new FS::cust_main { 'column' => 'value' };
  83
  84   $error = $record->insert;
  85
  86   $error = $new_record->replace($old_record);
  87
  88   $error = $record->delete;
  89
  90   $error = $record->check;
  91
  92   @cust_pkg = $record->all_pkgs;
  93
  94   @cust_pkg = $record->ncancelled_pkgs;
  95
  96   $error = $record->bill;
  97   $error = $record->bill %options;
  98   $error = $record->bill 'time' => $time;
  99
 100   $error = $record->collect;
 101   $error = $record->collect %options;
 102   $error = $record->collect 'invoice_time'   => $time,
 103                             'batch_card'     => 'yes',
 104                             'report_badcard' => 'yes',
 105                           ;
 106
 107 =head1 DESCRIPTION
 108
 109 An FS::cust_main object represents a customer.  FS::cust_main inherits from
 110 FS::Record.  The following fields are currently supported:
 111
 112 =over 4
 113
 114 =item custnum - primary key (assigned automatically for new customers)
 115
 116 =item agentnum - agent (see L<FS::agent>)
 117
 118 =item refnum - referral (see L<FS::part_referral>)
 119
 120 =item first - name
 121
 122 =item last - name
 123
 124 =item ss - social security number (optional)
 125
 126 =item company - (optional)
 127
 128 =item address1
 129
 130 =item address2 - (optional)
 131
 132 =item city
 133
 134 =item county - (optional, see L<FS::cust_main_county>)
 135
 136 =item state - (see L<FS::cust_main_county>)
 137
 138 =item zip
 139
 140 =item country - (see L<FS::cust_main_county>)
 141
 142 =item daytime - phone (optional)
 143
 144 =item night - phone (optional)
 145
 146 =item payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free)
 147
 148 =item payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username)
 149
 150 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 151
 152 =item payname - name on card or billing name
 153
 154 =item tax - tax exempt, empty or `Y'
 155
 156 =item otaker - order taker (assigned automatically, see L<FS::UID>)
 157
 158 =back
 159
 160 =head1 METHODS
 161
 162 =over 4
 163
 164 =item new HASHREF
 165
 166 Creates a new customer.  To add the customer to the database, see L<"insert">.
 167
 168 Note that this stores the hash reference, not a distinct copy of the hash it
 169 points to.  You can ask the object for a copy with the I<hash> method.
 170
 171 =cut
 172
 173 sub table { 'cust_main'; }
 174
 175 =item insert
 176
 177 Adds this customer to the database.  If there is an error, returns the error,
 178 otherwise returns false.
 179
 180 =item delete NEW_CUSTNUM
 181
 182 This deletes the customer.  If there is an error, returns the error, otherwise
 183 returns false.
 184
 185 This will completely remove all traces of the customer record.  This is not
 186 what you want when a customer cancels service; for that, cancel all of the
 187 customer's packages (see L<FS::cust_pkg/cancel>).
 188
 189 If the customer has any packages, you need to pass a new (valid) customer
 190 number for those packages to be transferred to.
 191
 192 You can't delete a customer with invoices (see L<FS::cust_bill>),
 193 or credits (see L<FS::cust_credit>).
 194
 195 =cut
 196
 197 sub delete {
 198   my $self = shift;
 199
 200   if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
 201     return "Can't delete a customer with invoices";
 202   }
 203   if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
 204     return "Can't delete a customer with credits";
 205   }
 206
 207   local $SIG{HUP} = 'IGNORE';
 208   local $SIG{INT} = 'IGNORE';
 209   local $SIG{QUIT} = 'IGNORE';
 210   local $SIG{TERM} = 'IGNORE';
 211   local $SIG{TSTP} = 'IGNORE';
 212   local $SIG{PIPE} = 'IGNORE';
 213
 214   my @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } );
 215   if ( @cust_pkg ) {
 216     my $new_custnum = shift;
 217     return "Invalid new customer number: $new_custnum"
 218       unless qsearchs( 'cust_main', { 'custnum' => $new_custnum } );
 219     foreach my $cust_pkg ( @cust_pkg ) {
 220       my %hash = $cust_pkg->hash;
 221       $hash{'custnum'} = $new_custnum;
 222       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
 223       my $error = $new_cust_pkg->replace($cust_pkg);
 224       return $error if $error;
 225     }
 226   }
 227   foreach my $cust_main_invoice (
 228     qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
 229   ) {
 230     my $error = $cust_main_invoice->delete;
 231     return $error if $error;
 232   }
 233
 234   $self->SUPER::delete;
 235 }
 236
 237 =item replace OLD_RECORD
 238
 239 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 240 returns the error, otherwise returns false.
 241
 242 =item check
 243
 244 Checks all fields to make sure this is a valid customer record.  If there is
 245 an error, returns the error, otherwise returns false.  Called by the insert
 246 and repalce methods.
 247
 248 =cut
 249
 250 sub check {
 251   my $self = shift;
 252
 253   my $error =
 254     $self->ut_numbern('custnum')
 255     || $self->ut_number('agentnum')
 256     || $self->ut_number('refnum')
 257     || $self->ut_textn('company')
 258     || $self->ut_text('address1')
 259     || $self->ut_textn('address2')
 260     || $self->ut_text('city')
 261     || $self->ut_textn('county')
 262     || $self->ut_textn('state')
 263     || $self->ut_phonen('daytime')
 264     || $self->ut_phonen('night')
 265     || $self->ut_phonen('fax')
 266   ;
 267   return $error if $error;
 268
 269   return "Unknown agent"
 270     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
 271
 272   return "Unknown referral"
 273     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
 274
 275   $self->getfield('last') =~ /^([\w \,\.\-\']+)$/
 276     or return "Illegal last name: ". $self->getfield('last');
 277   $self->setfield('last',$1);
 278
 279   $self->first =~ /^([\w \,\.\-\']+)$/
 280     or return "Illegal first name: ". $self->first;
 281   $self->first($1);
 282
 283   if ( $self->ss eq '' ) {
 284     $self->ss('');
 285   } else {
 286     my $ss = $self->ss;
 287     $ss =~ s/\D//g;
 288     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
 289       or return "Illegal social security number: ". $self->ss;
 290     $self->ss("$1-$2-$3");
 291   }
 292
 293   $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country;
 294   $self->country($1);
 295   unless ( qsearchs('cust_main_county', {
 296     'country' => $self->country,
 297     'state'   => '',
 298    } ) ) {
 299     return "Unknown state/county/country: ".
 300       $self->state. "/". $self->county. "/". $self->country
 301       unless qsearchs('cust_main_county',{
 302         'state'   => $self->state,
 303         'county'  => $self->county,
 304         'country' => $self->country,
 305       } );
 306   }
 307
 308   $self->zip =~ /^\s*(\w[\w\-\s]{3,8}\w)\s*$/
 309     or return "Illegal zip: ". $self->zip;
 310   $self->zip($1);
 311
 312   $self->payby =~ /^(CARD|BILL|COMP)$/
 313     or return "Illegal payby: ". $self->payby;
 314   $self->payby($1);
 315
 316   if ( $self->payby eq 'CARD' ) {
 317
 318     my $payinfo = $self->payinfo;
 319     $payinfo =~ s/\D//g;
 320     $payinfo =~ /^(\d{13,16})$/
 321       or return "Illegal credit card number: ". $self->payinfo;
 322     $payinfo = $1;
 323     $self->payinfo($payinfo);
 324     validate($payinfo)
 325       or return "Illegal credit card number: ". $self->payinfo;
 326     return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
 327
 328   } elsif ( $self->payby eq 'BILL' ) {
 329
 330     $error = $self->ut_textn('payinfo');
 331     return "Illegal P.O. number: ". $self->payinfo if $error;
 332
 333   } elsif ( $self->payby eq 'COMP' ) {
 334
 335     $error = $self->ut_textn('payinfo');
 336     return "Illegal comp account issuer: ". $self->payinfo if $error;
 337
 338   }
 339
 340   if ( $self->paydate eq '' ) {
 341     return "Expriation date required" unless $self->payby eq 'BILL';
 342     $self->paydate('');
 343   } else {
 344     $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
 345       or return "Illegal expiration date: ". $self->paydate;
 346     if ( length($2) == 4 ) {
 347       $self->paydate("$2-$1-01");
 348     } elsif ( $2 > 97 ) { #should pry change to check for "this year"
 349       $self->paydate("19$2-$1-01");
 350     } else {
 351       $self->paydate("20$2-$1-01");
 352     }
 353   }
 354
 355   if ( $self->payname eq '' ) {
 356     $self->payname( $self->first. " ". $self->getfield('last') );
 357   } else {
 358     $self->payname =~ /^([\w \,\.\-\']+)$/
 359       or return "Illegal billing name: ". $self->payname;
 360     $self->payname($1);
 361   }
 362
 363   $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
 364   $self->tax($1);
 365
 366   $self->otaker(getotaker);
 367
 368   ''; #no error
 369 }
 370
 371 =item all_pkgs
 372
 373 Returns all packages (see L<FS::cust_pkg>) for this customer.
 374
 375 =cut
 376
 377 sub all_pkgs {
 378   my $self = shift;
 379   qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
 380 }
 381
 382 =item ncancelled_pkgs
 383
 384 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
 385
 386 =cut
 387
 388 sub ncancelled_pkgs {
 389   my $self = shift;
 390   qsearch( 'cust_pkg', {
 391     'custnum' => $self->custnum,
 392     'cancel'  => '',
 393   });
 394 }
 395
 396 =item bill OPTIONS
 397
 398 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
 399 conjunction with the collect method.
 400
 401 The only currently available option is `time', which bills the customer as if
 402 it were that time.  It is specified as a UNIX timestamp; see
 403 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
 404 functions.
 405
 406 If there is an error, returns the error, otherwise returns false.
 407
 408 =cut
 409
 410 sub bill {
 411   my( $self, %options ) = @_;
 412   my $time = $options{'time'} || time;
 413
 414   my $error;
 415
 416   #put below somehow?
 417   local $SIG{HUP} = 'IGNORE';
 418   local $SIG{INT} = 'IGNORE';
 419   local $SIG{QUIT} = 'IGNORE';
 420   local $SIG{TERM} = 'IGNORE';
 421   local $SIG{TSTP} = 'IGNORE';
 422   local $SIG{PIPE} = 'IGNORE';
 423
 424   # find the packages which are due for billing, find out how much they are
 425   # & generate invoice database.
 426
 427   my( $total_setup, $total_recur ) = ( 0, 0 );
 428   my @cust_bill_pkg;
 429
 430   foreach my $cust_pkg (
 431     qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
 432   ) {
 433
 434     next if $cust_pkg->getfield('cancel');
 435
 436     #? to avoid use of uninitialized value errors... ?
 437     $cust_pkg->setfield('bill', '')
 438       unless defined($cust_pkg->bill);
 439
 440     my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
 441
 442     #so we don't modify cust_pkg record unnecessarily
 443     my $cust_pkg_mod_flag = 0;
 444     my %hash = $cust_pkg->hash;
 445     my $old_cust_pkg = new FS::cust_pkg \%hash;
 446
 447     # bill setup
 448     my $setup = 0;
 449     unless ( $cust_pkg->setup ) {
 450       my $setup_prog = $part_pkg->getfield('setup');
 451       my $cpt = new Safe;
 452       #$cpt->permit(); #what is necessary?
 453       $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
 454       $setup = $cpt->reval($setup_prog);
 455       unless ( defined($setup) ) {
 456         warn "Error reval-ing part_pkg->setup pkgpart ",
 457              $part_pkg->pkgpart, ": $@";
 458       } else {
 459         $cust_pkg->setfield('setup',$time);
 460         $cust_pkg_mod_flag=1;
 461       }
 462     }
 463
 464     #bill recurring fee
 465     my $recur = 0;
 466     my $sdate;
 467     if ( $part_pkg->getfield('freq') > 0 &&
 468          ! $cust_pkg->getfield('susp') &&
 469          ( $cust_pkg->getfield('bill') || 0 ) < $time
 470     ) {
 471       my $recur_prog = $part_pkg->getfield('recur');
 472       my $cpt = new Safe;
 473       #$cpt->permit(); #what is necessary?
 474       $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
 475       $recur = $cpt->reval($recur_prog);
 476       unless ( defined($recur) ) {
 477         warn "Error reval-ing part_pkg->recur pkgpart ",
 478              $part_pkg->pkgpart, ": $@";
 479       } else {
 480         #change this bit to use Date::Manip?
 481         #$sdate=$cust_pkg->bill || time;
 482         #$sdate=$cust_pkg->bill || $time;
 483         $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
 484         my ($sec,$min,$hour,$mday,$mon,$year) =
 485           (localtime($sdate) )[0,1,2,3,4,5];
 486         $mon += $part_pkg->getfield('freq');
 487         until ( $mon < 12 ) { $mon -= 12; $year++; }
 488         $cust_pkg->setfield('bill',
 489           timelocal($sec,$min,$hour,$mday,$mon,$year));
 490         $cust_pkg_mod_flag = 1;
 491       }
 492     }
 493
 494     warn "setup is undefinded" unless defined($setup);
 495     warn "recur is undefinded" unless defined($recur);
 496     warn "cust_pkg bill is undefinded" unless defined($cust_pkg->bill);
 497
 498     if ( $cust_pkg_mod_flag ) {
 499       $error=$cust_pkg->replace($old_cust_pkg);
 500       if ( $error ) { #just in case
 501         warn "Error modifying pkgnum ", $cust_pkg->pkgnum, ": $error";
 502       } else {
 503         $setup = sprintf( "%.2f", $setup );
 504         $recur = sprintf( "%.2f", $recur );
 505         my $cust_bill_pkg = new FS::cust_bill_pkg ({
 506           'pkgnum' => $cust_pkg->pkgnum,
 507           'setup'  => $setup,
 508           'recur'  => $recur,
 509           'sdate'  => $sdate,
 510           'edate'  => $cust_pkg->bill,
 511         });
 512         push @cust_bill_pkg, $cust_bill_pkg;
 513         $total_setup += $setup;
 514         $total_recur += $recur;
 515       }
 516     }
 517
 518   }
 519
 520   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
 521
 522   return '' if scalar(@cust_bill_pkg) == 0;
 523
 524   unless ( $self->getfield('tax') =~ /Y/i
 525            || $self->getfield('payby') eq 'COMP'
 526   ) {
 527     my $cust_main_county = qsearchs('cust_main_county',{
 528         'state'   => $self->state,
 529         'county'  => $self->county,
 530         'country' => $self->country,
 531     } );
 532     my $tax = sprintf( "%.2f",
 533       $charged * ( $cust_main_county->getfield('tax') / 100 )
 534     );
 535     $charged = sprintf( "%.2f", $charged+$tax );
 536
 537     my $cust_bill_pkg = new FS::cust_bill_pkg ({
 538       'pkgnum' => 0,
 539       'setup'  => $tax,
 540       'recur'  => 0,
 541       'sdate'  => '',
 542       'edate'  => '',
 543     });
 544     push @cust_bill_pkg, $cust_bill_pkg;
 545   }
 546
 547   my $cust_bill = new FS::cust_bill ( {
 548     'custnum' => $self->getfield('custnum'),
 549     '_date' => $time,
 550     'charged' => $charged,
 551   } );
 552   $error = $cust_bill->insert;
 553   #shouldn't happen, but how else to handle this? (wrap me in eval, to catch
 554   # fatal errors)
 555   die "Error creating cust_bill record: $error!\n",
 556       "Check updated but unbilled packages for customer", $self->custnum, "\n"
 557     if $error;
 558
 559   my $invnum = $cust_bill->invnum;
 560   my $cust_bill_pkg;
 561   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
 562     $cust_bill_pkg->setfield( 'invnum', $invnum );
 563     $error = $cust_bill_pkg->insert;
 564     #shouldn't happen, but how else tohandle this?
 565     die "Error creating cust_bill_pkg record: $error!\n",
 566         "Check incomplete invoice ", $invnum, "\n"
 567       if $error;
 568   }
 569
 570   ''; #no error
 571 }
 572
 573 =item collect OPTIONS
 574
 575 (Attempt to) collect money for this customer's outstanding invoices (see
 576 L<FS::cust_bill>).  Usually used after the bill method.
 577
 578 Depending on the value of `payby', this may print an invoice (`BILL'), charge
 579 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
 580
 581 If there is an error, returns the error, otherwise returns false.
 582
 583 Currently available options are:
 584
 585 invoice_time - Use this time when deciding when to print invoices and
 586 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>
 587 for conversion functions.
 588
 589 batch_card - Set this true to batch cards (see L<cust_pay_batch>).  By
 590 default, cards are processed immediately, which will generate an error if
 591 CyberCash is not installed.
 592
 593 report_badcard - Set this true if you want bad card transactions to
 594 return an error.  By default, they don't.
 595
 596 =cut
 597
 598 sub collect {
 599   my( $self, %options ) = @_;
 600   my $invoice_time = $options{'invoice_time'} || time;
 601
 602   my $total_owed = $self->balance;
 603   return '' unless $total_owed > 0; #redundant?????
 604
 605   #put below somehow?
 606   local $SIG{HUP} = 'IGNORE';
 607   local $SIG{INT} = 'IGNORE';
 608   local $SIG{QUIT} = 'IGNORE';
 609   local $SIG{TERM} = 'IGNORE';
 610   local $SIG{TSTP} = 'IGNORE';
 611   local $SIG{PIPE} = 'IGNORE';
 612
 613   foreach my $cust_bill (
 614     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
 615   ) {
 616
 617     #this has to be before next's
 618     my $amount = sprintf( "%.2f", $total_owed < $cust_bill->owed
 619                                   ? $total_owed
 620                                   : $cust_bill->owed
 621     );
 622     $total_owed = sprintf( "%.2f", $total_owed - $amount );
 623
 624     next unless $cust_bill->owed > 0;
 625
 626     next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
 627
 628     #warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, total_owed $total_owed)";
 629
 630     next unless $amount > 0;
 631
 632     if ( $self->payby eq 'BILL' ) {
 633
 634       #30 days 2592000
 635       my $since = $invoice_time - ( $cust_bill->_date || 0 );
 636       #warn "$invoice_time ", $cust_bill->_date, " $since";
 637       if ( $since >= 0 #don't print future invoices
 638            && ( $cust_bill->printed * 2592000 ) <= $since
 639       ) {
 640
 641         #my @print_text = $cust_bill->print_text; #( date )
 642         my @invoicing_list = $self->invoicing_list;
 643         if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
 644           $ENV{SMTPHOSTS} = $smtpmachine;
 645           $ENV{MAILADDRESS} = $invoice_from;
 646           my $header = new Mail::Header ( [
 647             "From: $invoice_from",
 648             "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
 649             "Sender: $invoice_from",
 650             "Reply-To: $invoice_from",
 651             "Date: ". time2str("%a, %d %b %Y %X %z", time),
 652             "Subject: Invoice",
 653           ] );
 654           my $message = new Mail::Internet (
 655             'Header' => $header,
 656             'Body' => [ $cust_bill->print_text ], #( date)
 657           );
 658           $message->smtpsend or die "Can't send invoice email!"; #die?  warn?
 659
 660         } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
 661           open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
 662           print LPR $cust_bill->print_text; #( date )
 663           close LPR
 664             or die $! ? "Error closing $lpr: $!"
 665                          : "Exit status $? from $lpr";
 666         }
 667
 668         my %hash = $cust_bill->hash;
 669         $hash{'printed'}++;
 670         my $new_cust_bill = new FS::cust_bill(\%hash);
 671         my $error = $new_cust_bill->replace($cust_bill);
 672         warn "Error updating $cust_bill->printed: $error" if $error;
 673
 674       }
 675
 676     } elsif ( $self->payby eq 'COMP' ) {
 677       my $cust_pay = new FS::cust_pay ( {
 678          'invnum' => $cust_bill->invnum,
 679          'paid' => $amount,
 680          '_date' => '',
 681          'payby' => 'COMP',
 682          'payinfo' => $self->payinfo,
 683          'paybatch' => ''
 684       } );
 685       my $error = $cust_pay->insert;
 686       return 'Error COMPing invnum #' . $cust_bill->invnum .
 687              ':' . $error if $error;
 688
 689     } elsif ( $self->payby eq 'CARD' ) {
 690
 691       if ( $options{'batch_card'} ne 'yes' ) {
 692
 693         return "Real time card processing not enabled!" unless $processor;
 694
 695         if ( $processor =~ /^cybercash/ ) {
 696
 697           #fix exp. date for cybercash
 698           #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
 699           $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
 700           my $exp = "$2/$1";
 701
 702           my $paybatch = $cust_bill->invnum.
 703                          '-' . time2str("%y%m%d%H%M%S", time);
 704
 705           my $payname = $self->payname ||
 706                         $self->getfield('first'). ' '. $self->getfield('last');
 707
 708           my $address = $self->address1;
 709           $address .= ", ". $self->address2 if $self->address2;
 710
 711           my $country = 'USA' if $self->country eq 'US';
 712
 713           my @full_xaction = ( $xaction,
 714             'Order-ID'     => $paybatch,
 715             'Amount'       => "usd $amount",
 716             'Card-Number'  => $self->getfield('payinfo'),
 717             'Card-Name'    => $payname,
 718             'Card-Address' => $address,
 719             'Card-City'    => $self->getfield('city'),
 720             'Card-State'   => $self->getfield('state'),
 721             'Card-Zip'     => $self->getfield('zip'),
 722             'Card-Country' => $country,
 723             'Card-Exp'     => $exp,
 724           );
 725
 726           my %result;
 727           if ( $processor eq 'cybercash2' ) {
 728             $^W=0; #CCLib isn't -w safe, ugh!
 729             %result = &CCLib::sendmserver(@full_xaction);
 730             $^W=1;
 731           } elsif ( $processor eq 'cybercash3.2' ) {
 732             %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
 733           } else {
 734             return "Unkonwn real-time processor $processor\n";
 735           }
 736
 737           #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
 738           #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
 739           if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
 740             my $cust_pay = new FS::cust_pay ( {
 741                'invnum'   => $cust_bill->invnum,
 742                'paid'     => $amount,
 743                '_date'     => '',
 744                'payby'    => 'CARD',
 745                'payinfo'  => $self->payinfo,
 746                'paybatch' => "$processor:$paybatch",
 747             } );
 748             my $error = $cust_pay->insert;
 749             return 'Error applying payment, invnum #' .
 750               $cust_bill->invnum. ':'. $error if $error;
 751           } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
 752                  || $options{'report_badcard'} ) {
 753              return 'Cybercash error, invnum #' .
 754                $cust_bill->invnum. ':'. $result{'MErrMsg'};
 755           } else {
 756             return '';
 757           }
 758
 759         } else {
 760           return "Unkonwn real-time processor $processor\n";
 761         }
 762
 763       } else { #batch card
 764
 765        my $cust_pay_batch = new FS::cust_pay_batch ( {
 766          'invnum'   => $cust_bill->getfield('invnum'),
 767          'custnum'  => $self->getfield('custnum'),
 768          'last'     => $self->getfield('last'),
 769          'first'    => $self->getfield('first'),
 770          'address1' => $self->getfield('address1'),
 771          'address2' => $self->getfield('address2'),
 772          'city'     => $self->getfield('city'),
 773          'state'    => $self->getfield('state'),
 774          'zip'      => $self->getfield('zip'),
 775          'country'  => $self->getfield('country'),
 776          'trancode' => 77,
 777          'cardnum'  => $self->getfield('payinfo'),
 778          'exp'      => $self->getfield('paydate'),
 779          'payname'  => $self->getfield('payname'),
 780          'amount'   => $amount,
 781        } );
 782        my $error = $cust_pay_batch->insert;
 783        return "Error adding to cust_pay_batch: $error" if $error;
 784
 785       }
 786
 787     } else {
 788       return "Unknown payment type ". $self->payby;
 789     }
 790
 791
 792
 793
 794
 795   }
 796   '';
 797
 798 }
 799
 800 =item total_owed
 801
 802 Returns the total owed for this customer on all invoices
 803 (see L<FS::cust_bill>).
 804
 805 =cut
 806
 807 sub total_owed {
 808   my $self = shift;
 809   my $total_bill = 0;
 810   foreach my $cust_bill ( qsearch('cust_bill', {
 811     'custnum' => $self->custnum,
 812   } ) ) {
 813     $total_bill += $cust_bill->owed;
 814   }
 815   sprintf( "%.2f", $total_bill );
 816 }
 817
 818 =item total_credited
 819
 820 Returns the total credits (see L<FS::cust_credit>) for this customer.
 821
 822 =cut
 823
 824 sub total_credited {
 825   my $self = shift;
 826   my $total_credit = 0;
 827   foreach my $cust_credit ( qsearch('cust_credit', {
 828     'custnum' => $self->custnum,
 829   } ) ) {
 830     $total_credit += $cust_credit->credited;
 831   }
 832   sprintf( "%.2f", $total_credit );
 833 }
 834
 835 =item balance
 836
 837 Returns the balance for this customer (total owed minus total credited).
 838
 839 =cut
 840
 841 sub balance {
 842   my $self = shift;
 843   sprintf( "%.2f", $self->total_owed - $self->total_credited );
 844 }
 845
 846 =item invoicing_list [ ARRAYREF ]
 847
 848 If an arguement is given, sets these email addresses as invoice recipients
 849 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
 850 (except as warnings), so use check_invoicing_list first.
 851
 852 Returns a list of email addresses (with svcnum entries expanded).
 853
 854 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
 855 check it without disturbing anything by passing nothing.
 856
 857 This interface may change in the future.
 858
 859 =cut
 860
 861 sub invoicing_list {
 862   my( $self, $arrayref ) = @_;
 863   if ( $arrayref ) {
 864     my @cust_main_invoice;
 865     if ( $self->custnum ) {
 866       @cust_main_invoice =
 867         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
 868     } else {
 869       @cust_main_invoice = ();
 870     }
 871     foreach my $cust_main_invoice ( @cust_main_invoice ) {
 872       #warn $cust_main_invoice->destnum;
 873       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
 874         #warn $cust_main_invoice->destnum;
 875         my $error = $cust_main_invoice->delete;
 876         warn $error if $error;
 877       }
 878     }
 879     if ( $self->custnum ) {
 880       @cust_main_invoice =
 881         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
 882     } else {
 883       @cust_main_invoice = ();
 884     }
 885     foreach my $address ( @{$arrayref} ) {
 886       unless ( grep { $address eq $_->address } @cust_main_invoice ) {
 887         my $cust_main_invoice = new FS::cust_main_invoice ( {
 888           'custnum' => $self->custnum,
 889           'dest'    => $address,
 890         } );
 891         my $error = $cust_main_invoice->insert;
 892         warn $error if $error;
 893       }
 894     }
 895   }
 896   if ( $self->custnum ) {
 897     map { $_->address }
 898       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
 899   } else {
 900     ();
 901   }
 902 }
 903
 904 =item check_invoicing_list ARRAYREF
 905
 906 Checks these arguements as valid input for the invoicing_list method.  If there
 907 is an error, returns the error, otherwise returns false.
 908
 909 =cut
 910
 911 sub check_invoicing_list {
 912   my( $self, $arrayref ) = @_;
 913   foreach my $address ( @{$arrayref} ) {
 914     my $cust_main_invoice = new FS::cust_main_invoice ( {
 915       'custnum' => $self->custnum,
 916       'dest'    => $address,
 917     } );
 918     my $error = $self->custnum
 919                 ? $cust_main_invoice->check
 920                 : $cust_main_invoice->checkdest
 921     ;
 922     return $error if $error;
 923   }
 924   '';
 925 }
 926
 927 =back
 928
 929 =head1 VERSION
 930
 931 $Id: cust_main.pm,v 1.23 1999-07-17 02:24:14 ivan Exp $
 932
 933 =head1 BUGS
 934
 935 The delete method.
 936
 937 The delete method should possibly take an FS::cust_main object reference
 938 instead of a scalar customer number.
 939
 940 Bill and collect options should probably be passed as references instead of a
 941 list.
 942
 943 CyberCash v2 forces us to define some variables in package main.
 944
 945 There should probably be a configuration file with a list of allowed credit
 946 card types.
 947
 948 CyberCash is the only processor.
 949
 950 No multiple currency support (probably a larger project than just this module).
 951
 952 =head1 SEE ALSO
 953
 954 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
 955 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
 956 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
 957 L<FS::UID>, schema.html from the base documentation.
 958
 959 =head1 HISTORY
 960
 961 ivan@voicenet.com 97-jul-28
 962
 963 Changed to standard Business::CreditCard
 964 no more TableUtil
 965 EXPORT_OK FS::Record's hfields
 966 removed unique calls and locking (not needed here now)
 967 wrapped the (now) optional fields in if statements in sub check (notyetdone!)
 968 ivan@sisd.com 97-nov-12
 969
 970 updated paydate with SQL-type date info ivan@sisd.com 98-mar-5
 971
 972 Added export of datasrc from UID.pm for Pg6.3
 973 changed 'day' to 'daytime' because Pg6.3 reserves the day word
 974         bmccane@maxbaud.net     98-apr-3
 975
 976 in ->create, s/svc_acct/cust_main/, now it should actually eliminate the
 977 warnings it was meant to ivan@sisd.com 98-jul-16
 978
 979 don't require a phone number and allow '/' in company names
 980 ivan@sisd.com 98-jul-18
 981
 982 use ut_ and rewrite &check, &*_pkgs ivan@sisd.com 98-sep-5
 983
 984 pod, merge with FS::Bill (about time!), total_owed, total_credited and balance
 985 methods, cleaned collect method, source modifications no longer necessary to
 986 enable cybercash, cybercash v3 support, don't need to import
 987 FS::UID::{datasrc,checkruid} ivan@sisd.com 98-sep-19-21
 988
 989 $Log: cust_main.pm,v $
 990 Revision 1.23  1999-07-17 02:24:14  ivan
 991 bug noticed by Steve Gertz <sglist@hollywood.mwis.net>
 992
 993 Revision 1.22  1999/04/15 16:44:36  ivan
 994 delete customers
 995
 996 Revision 1.21  1999/04/14 07:47:53  ivan
 997 i18n fixes
 998
 999 Revision 1.20  1999/04/10 08:35:14  ivan
1000 say what the unknown state/county/country are!
1001
1002 Revision 1.19  1999/04/10 07:38:06  ivan
1003 _all_ check stuff with illegal data return the bad data too, to help debugging
1004
1005 Revision 1.18  1999/04/10 06:54:11  ivan
1006 ditto
1007
1008 Revision 1.17  1999/04/10 05:27:38  ivan
1009 display an illegal payby, to assist importing
1010
1011 Revision 1.16  1999/04/07 14:32:19  ivan
1012 more &invoicing_list logic to skip searches when there is no custnum
1013
1014 Revision 1.15  1999/04/07 13:41:54  ivan
1015 in &invoicing_list, don't search if there's no custnum yet
1016
1017 Revision 1.14  1999/03/29 12:06:15  ivan
1018 buglet in email invoices fixed
1019
1020 Revision 1.13  1999/02/28 20:09:03  ivan
1021 allow spaces in zip codes, for (at least) canada.  pointed out by
1022 Clayton Gray <clgray@bcgroup.net>
1023
1024 Revision 1.12  1999/02/27 21:24:22  ivan
1025 parse paydate correctly for cybercash
1026
1027 Revision 1.11  1999/02/23 08:09:27  ivan
1028 beginnings of one-screen new customer entry and some other miscellania
1029
1030 Revision 1.10  1999/01/25 12:26:09  ivan
1031 yet more mod_perl stuff
1032
1033 Revision 1.9  1999/01/18 09:22:41  ivan
1034 changes to track email addresses for email invoicing
1035
1036 Revision 1.8  1998/12/29 11:59:39  ivan
1037 mostly properly OO, some work still to be done with svc_ stuff
1038
1039 Revision 1.7  1998/12/16 09:58:52  ivan
1040 library support for editing email invoice destinations (not in sub collect yet)
1041
1042 Revision 1.6  1998/11/18 09:01:42  ivan
1043 i18n! i18n!
1044
1045 Revision 1.5  1998/11/15 11:23:14  ivan
1046 use FS::table_name for all searches to eliminate warnings,
1047 emit state/county when they don't match
1048
1049 Revision 1.4  1998/11/15 05:30:48  ivan
1050 bugfix for new config layout
1051
1052 Revision 1.3  1998/11/13 09:56:54  ivan
1053 change configuration file layout to support multiple distinct databases (with
1054 own set of config files, export, etc.)
1055
1056 Revision 1.2  1998/11/07 10:24:25  ivan
1057 don't use depriciated FS::Bill and FS::Invoice, other miscellania
1058
1059
1060 =cut
1061
1062 1;
1063
1064