FS/FS/cust_main.pm

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