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