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