FS/FS/cust_main.pm

   1 package FS::cust_main;
   2
   3 use strict;
   4 use vars qw( @ISA $conf $Debug $import );
   5 use Safe;
   6 use Carp;
   7 BEGIN {
   8   eval "use Time::Local;";
   9   die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
  10     if $] < 5.006 && !defined($Time::Local::VERSION);
  11   eval "use Time::Local qw(timelocal timelocal_nocheck);";
  12 }
  13 use Date::Format;
  14 #use Date::Manip;
  15 use Business::CreditCard;
  16 use FS::UID qw( getotaker dbh );
  17 use FS::Record qw( qsearchs qsearch dbdef );
  18 use FS::cust_pkg;
  19 use FS::cust_bill;
  20 use FS::cust_bill_pkg;
  21 use FS::cust_pay;
  22 use FS::cust_credit;
  23 use FS::part_referral;
  24 use FS::cust_main_county;
  25 use FS::agent;
  26 use FS::cust_main_invoice;
  27 use FS::cust_credit_bill;
  28 use FS::cust_bill_pay;
  29 use FS::prepay_credit;
  30 use FS::queue;
  31 use FS::part_pkg;
  32 use FS::part_bill_event;
  33 use FS::cust_bill_event;
  34 use FS::cust_tax_exempt;
  35 use FS::type_pkgs;
  36 use FS::Msgcat qw(gettext);
  37
  38 @ISA = qw( FS::Record );
  39
  40 $Debug = 0;
  41 #$Debug = 1;
  42
  43 $import = 0;
  44
  45 #ask FS::UID to run this stuff for us later
  46 $FS::UID::callback{'FS::cust_main'} = sub {
  47   $conf = new FS::Conf;
  48   #yes, need it for stuff below (prolly should be cached)
  49 };
  50
  51 sub _cache {
  52   my $self = shift;
  53   my ( $hashref, $cache ) = @_;
  54   if ( exists $hashref->{'pkgnum'} ) {
  55 #    #@{ $self->{'_pkgnum'} } = ();
  56     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
  57     $self->{'_pkgnum'} = $subcache;
  58     #push @{ $self->{'_pkgnum'} },
  59     FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
  60   }
  61 }
  62
  63 =head1 NAME
  64
  65 FS::cust_main - Object methods for cust_main records
  66
  67 =head1 SYNOPSIS
  68
  69   use FS::cust_main;
  70
  71   $record = new FS::cust_main \%hash;
  72   $record = new FS::cust_main { 'column' => 'value' };
  73
  74   $error = $record->insert;
  75
  76   $error = $new_record->replace($old_record);
  77
  78   $error = $record->delete;
  79
  80   $error = $record->check;
  81
  82   @cust_pkg = $record->all_pkgs;
  83
  84   @cust_pkg = $record->ncancelled_pkgs;
  85
  86   @cust_pkg = $record->suspended_pkgs;
  87
  88   $error = $record->bill;
  89   $error = $record->bill %options;
  90   $error = $record->bill 'time' => $time;
  91
  92   $error = $record->collect;
  93   $error = $record->collect %options;
  94   $error = $record->collect 'invoice_time'   => $time,
  95                             'batch_card'     => 'yes',
  96                             'report_badcard' => 'yes',
  97                           ;
  98
  99 =head1 DESCRIPTION
 100
 101 An FS::cust_main object represents a customer.  FS::cust_main inherits from
 102 FS::Record.  The following fields are currently supported:
 103
 104 =over 4
 105
 106 =item custnum - primary key (assigned automatically for new customers)
 107
 108 =item agentnum - agent (see L<FS::agent>)
 109
 110 =item refnum - Advertising source (see L<FS::part_referral>)
 111
 112 =item first - name
 113
 114 =item last - name
 115
 116 =item ss - social security number (optional)
 117
 118 =item company - (optional)
 119
 120 =item address1
 121
 122 =item address2 - (optional)
 123
 124 =item city
 125
 126 =item county - (optional, see L<FS::cust_main_county>)
 127
 128 =item state - (see L<FS::cust_main_county>)
 129
 130 =item zip
 131
 132 =item country - (see L<FS::cust_main_county>)
 133
 134 =item daytime - phone (optional)
 135
 136 =item night - phone (optional)
 137
 138 =item fax - phone (optional)
 139
 140 =item ship_first - name
 141
 142 =item ship_last - name
 143
 144 =item ship_company - (optional)
 145
 146 =item ship_address1
 147
 148 =item ship_address2 - (optional)
 149
 150 =item ship_city
 151
 152 =item ship_county - (optional, see L<FS::cust_main_county>)
 153
 154 =item ship_state - (see L<FS::cust_main_county>)
 155
 156 =item ship_zip
 157
 158 =item ship_country - (see L<FS::cust_main_county>)
 159
 160 =item ship_daytime - phone (optional)
 161
 162 =item ship_night - phone (optional)
 163
 164 =item ship_fax - phone (optional)
 165
 166 =item payby - `CARD' (credit cards), `CHEK' (electronic check), `LECB' (Phone bill billing), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
 167
 168 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
 169
 170 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 171
 172 =item payname - name on card or billing name
 173
 174 =item tax - tax exempt, empty or `Y'
 175
 176 =item otaker - order taker (assigned automatically, see L<FS::UID>)
 177
 178 =item comments - comments (optional)
 179
 180 =back
 181
 182 =head1 METHODS
 183
 184 =over 4
 185
 186 =item new HASHREF
 187
 188 Creates a new customer.  To add the customer to the database, see L<"insert">.
 189
 190 Note that this stores the hash reference, not a distinct copy of the hash it
 191 points to.  You can ask the object for a copy with the I<hash> method.
 192
 193 =cut
 194
 195 sub table { 'cust_main'; }
 196
 197 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
 198
 199 Adds this customer to the database.  If there is an error, returns the error,
 200 otherwise returns false.
 201
 202 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
 203 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
 204 are inserted atomicly, or the transaction is rolled back.  Passing an empty
 205 hash reference is equivalent to not supplying this parameter.  There should be
 206 a better explanation of this, but until then, here's an example:
 207
 208   use Tie::RefHash;
 209   tie %hash, 'Tie::RefHash'; #this part is important
 210   %hash = (
 211     $cust_pkg => [ $svc_acct ],
 212     ...
 213   );
 214   $cust_main->insert( \%hash );
 215
 216 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 217 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 218 expected and rollback the entire transaction; it is not necessary to call
 219 check_invoicing_list first.  The invoicing_list is set after the records in the
 220 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
 221 invoicing_list destination to the newly-created svc_acct.  Here's an example:
 222
 223   $cust_main->insert( {}, [ $email, 'POST' ] );
 224
 225 Currently available options are: I<noexport>
 226
 227 If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
 228 (You can schedule them later with the B<reexport> method.)
 229
 230 =cut
 231
 232 sub insert {
 233   my $self = shift;
 234   my $cust_pkgs = @_ ? shift : {};
 235   my $invoicing_list = @_ ? shift : '';
 236   my %options = @_;
 237
 238   local $SIG{HUP} = 'IGNORE';
 239   local $SIG{INT} = 'IGNORE';
 240   local $SIG{QUIT} = 'IGNORE';
 241   local $SIG{TERM} = 'IGNORE';
 242   local $SIG{TSTP} = 'IGNORE';
 243   local $SIG{PIPE} = 'IGNORE';
 244
 245   my $oldAutoCommit = $FS::UID::AutoCommit;
 246   local $FS::UID::AutoCommit = 0;
 247   my $dbh = dbh;
 248
 249   my $amount = 0;
 250   my $seconds = 0;
 251   if ( $self->payby eq 'PREPAY' ) {
 252     $self->payby('BILL');
 253     my $prepay_credit = qsearchs(
 254       'prepay_credit',
 255       { 'identifier' => $self->payinfo },
 256       '',
 257       'FOR UPDATE'
 258     );
 259     warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
 260       unless $prepay_credit;
 261     $amount = $prepay_credit->amount;
 262     $seconds = $prepay_credit->seconds;
 263     my $error = $prepay_credit->delete;
 264     if ( $error ) {
 265       $dbh->rollback if $oldAutoCommit;
 266       return "removing prepay_credit (transaction rolled back): $error";
 267     }
 268   }
 269
 270   my $error = $self->SUPER::insert;
 271   if ( $error ) {
 272     $dbh->rollback if $oldAutoCommit;
 273     #return "inserting cust_main record (transaction rolled back): $error";
 274     return $error;
 275   }
 276
 277   # invoicing list
 278   if ( $invoicing_list ) {
 279     $error = $self->check_invoicing_list( $invoicing_list );
 280     if ( $error ) {
 281       $dbh->rollback if $oldAutoCommit;
 282       return "checking invoicing_list (transaction rolled back): $error";
 283     }
 284     $self->invoicing_list( $invoicing_list );
 285   }
 286
 287   # packages
 288   local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
 289   foreach my $cust_pkg ( keys %$cust_pkgs ) {
 290     $cust_pkg->custnum( $self->custnum );
 291     $error = $cust_pkg->insert;
 292     if ( $error ) {
 293       $dbh->rollback if $oldAutoCommit;
 294       return "inserting cust_pkg (transaction rolled back): $error";
 295     }
 296     foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
 297       $svc_something->pkgnum( $cust_pkg->pkgnum );
 298       if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
 299         $svc_something->seconds( $svc_something->seconds + $seconds );
 300         $seconds = 0;
 301       }
 302       $error = $svc_something->insert;
 303       if ( $error ) {
 304         $dbh->rollback if $oldAutoCommit;
 305         #return "inserting svc_ (transaction rolled back): $error";
 306         return $error;
 307       }
 308     }
 309   }
 310
 311   if ( $seconds ) {
 312     $dbh->rollback if $oldAutoCommit;
 313     return "No svc_acct record to apply pre-paid time";
 314   }
 315
 316   if ( $amount ) {
 317     my $cust_credit = new FS::cust_credit {
 318       'custnum' => $self->custnum,
 319       'amount'  => $amount,
 320     };
 321     $error = $cust_credit->insert;
 322     if ( $error ) {
 323       $dbh->rollback if $oldAutoCommit;
 324       return "inserting credit (transaction rolled back): $error";
 325     }
 326   }
 327
 328   $error = $self->queue_fuzzyfiles_update;
 329   if ( $error ) {
 330     $dbh->rollback if $oldAutoCommit;
 331     return "updating fuzzy search cache: $error";
 332   }
 333
 334   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 335   '';
 336
 337 }
 338
 339 =item delete NEW_CUSTNUM
 340
 341 This deletes the customer.  If there is an error, returns the error, otherwise
 342 returns false.
 343
 344 This will completely remove all traces of the customer record.  This is not
 345 what you want when a customer cancels service; for that, cancel all of the
 346 customer's packages (see L</cancel>).
 347
 348 If the customer has any uncancelled packages, you need to pass a new (valid)
 349 customer number for those packages to be transferred to.  Cancelled packages
 350 will be deleted.  Did I mention that this is NOT what you want when a customer
 351 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
 352
 353 You can't delete a customer with invoices (see L<FS::cust_bill>),
 354 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
 355 refunds (see L<FS::cust_refund>).
 356
 357 =cut
 358
 359 sub delete {
 360   my $self = shift;
 361
 362   local $SIG{HUP} = 'IGNORE';
 363   local $SIG{INT} = 'IGNORE';
 364   local $SIG{QUIT} = 'IGNORE';
 365   local $SIG{TERM} = 'IGNORE';
 366   local $SIG{TSTP} = 'IGNORE';
 367   local $SIG{PIPE} = 'IGNORE';
 368
 369   my $oldAutoCommit = $FS::UID::AutoCommit;
 370   local $FS::UID::AutoCommit = 0;
 371   my $dbh = dbh;
 372
 373   if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
 374     $dbh->rollback if $oldAutoCommit;
 375     return "Can't delete a customer with invoices";
 376   }
 377   if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
 378     $dbh->rollback if $oldAutoCommit;
 379     return "Can't delete a customer with credits";
 380   }
 381   if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
 382     $dbh->rollback if $oldAutoCommit;
 383     return "Can't delete a customer with payments";
 384   }
 385   if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
 386     $dbh->rollback if $oldAutoCommit;
 387     return "Can't delete a customer with refunds";
 388   }
 389
 390   my @cust_pkg = $self->ncancelled_pkgs;
 391   if ( @cust_pkg ) {
 392     my $new_custnum = shift;
 393     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
 394       $dbh->rollback if $oldAutoCommit;
 395       return "Invalid new customer number: $new_custnum";
 396     }
 397     foreach my $cust_pkg ( @cust_pkg ) {
 398       my %hash = $cust_pkg->hash;
 399       $hash{'custnum'} = $new_custnum;
 400       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
 401       my $error = $new_cust_pkg->replace($cust_pkg);
 402       if ( $error ) {
 403         $dbh->rollback if $oldAutoCommit;
 404         return $error;
 405       }
 406     }
 407   }
 408   my @cancelled_cust_pkg = $self->all_pkgs;
 409   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
 410     my $error = $cust_pkg->delete;
 411     if ( $error ) {
 412       $dbh->rollback if $oldAutoCommit;
 413       return $error;
 414     }
 415   }
 416
 417   foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
 418     qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
 419   ) {
 420     my $error = $cust_main_invoice->delete;
 421     if ( $error ) {
 422       $dbh->rollback if $oldAutoCommit;
 423       return $error;
 424     }
 425   }
 426
 427   my $error = $self->SUPER::delete;
 428   if ( $error ) {
 429     $dbh->rollback if $oldAutoCommit;
 430     return $error;
 431   }
 432
 433   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 434   '';
 435
 436 }
 437
 438 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
 439
 440 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 441 returns the error, otherwise returns false.
 442
 443 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 444 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 445 expected and rollback the entire transaction; it is not necessary to call
 446 check_invoicing_list first.  Here's an example:
 447
 448   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
 449
 450 =cut
 451
 452 sub replace {
 453   my $self = shift;
 454   my $old = shift;
 455   my @param = @_;
 456
 457   local $SIG{HUP} = 'IGNORE';
 458   local $SIG{INT} = 'IGNORE';
 459   local $SIG{QUIT} = 'IGNORE';
 460   local $SIG{TERM} = 'IGNORE';
 461   local $SIG{TSTP} = 'IGNORE';
 462   local $SIG{PIPE} = 'IGNORE';
 463
 464   if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
 465        && $conf->config('users-allow_comp')                  ) {
 466     return "You are not permitted to create complimentary accounts."
 467       unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
 468   }
 469
 470   my $oldAutoCommit = $FS::UID::AutoCommit;
 471   local $FS::UID::AutoCommit = 0;
 472   my $dbh = dbh;
 473
 474   my $error = $self->SUPER::replace($old);
 475
 476   if ( $error ) {
 477     $dbh->rollback if $oldAutoCommit;
 478     return $error;
 479   }
 480
 481   if ( @param ) { # INVOICING_LIST_ARYREF
 482     my $invoicing_list = shift @param;
 483     $error = $self->check_invoicing_list( $invoicing_list );
 484     if ( $error ) {
 485       $dbh->rollback if $oldAutoCommit;
 486       return $error;
 487     }
 488     $self->invoicing_list( $invoicing_list );
 489   }
 490
 491   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
 492        grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
 493     # card/check/lec info has changed, want to retry realtime_ invoice events
 494     my $error = $self->retry_realtime;
 495     if ( $error ) {
 496       $dbh->rollback if $oldAutoCommit;
 497       return $error;
 498     }
 499   }
 500
 501   $error = $self->queue_fuzzyfiles_update;
 502   if ( $error ) {
 503     $dbh->rollback if $oldAutoCommit;
 504     return "updating fuzzy search cache: $error";
 505   }
 506
 507   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 508   '';
 509
 510 }
 511
 512 =item queue_fuzzyfiles_update
 513
 514 Used by insert & replace to update the fuzzy search cache
 515
 516 =cut
 517
 518 sub queue_fuzzyfiles_update {
 519   my $self = shift;
 520
 521   local $SIG{HUP} = 'IGNORE';
 522   local $SIG{INT} = 'IGNORE';
 523   local $SIG{QUIT} = 'IGNORE';
 524   local $SIG{TERM} = 'IGNORE';
 525   local $SIG{TSTP} = 'IGNORE';
 526   local $SIG{PIPE} = 'IGNORE';
 527
 528   my $oldAutoCommit = $FS::UID::AutoCommit;
 529   local $FS::UID::AutoCommit = 0;
 530   my $dbh = dbh;
 531
 532   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
 533   my $error = $queue->insert($self->getfield('last'), $self->company);
 534   if ( $error ) {
 535     $dbh->rollback if $oldAutoCommit;
 536     return "queueing job (transaction rolled back): $error";
 537   }
 538
 539   if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
 540     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
 541     $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
 542     if ( $error ) {
 543       $dbh->rollback if $oldAutoCommit;
 544       return "queueing job (transaction rolled back): $error";
 545     }
 546   }
 547
 548   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 549   '';
 550
 551 }
 552
 553 =item check
 554
 555 Checks all fields to make sure this is a valid customer record.  If there is
 556 an error, returns the error, otherwise returns false.  Called by the insert
 557 and repalce methods.
 558
 559 =cut
 560
 561 sub check {
 562   my $self = shift;
 563
 564   #warn "BEFORE: \n". $self->_dump;
 565
 566   my $error =
 567     $self->ut_numbern('custnum')
 568     || $self->ut_number('agentnum')
 569     || $self->ut_number('refnum')
 570     || $self->ut_name('last')
 571     || $self->ut_name('first')
 572     || $self->ut_textn('company')
 573     || $self->ut_text('address1')
 574     || $self->ut_textn('address2')
 575     || $self->ut_text('city')
 576     || $self->ut_textn('county')
 577     || $self->ut_textn('state')
 578     || $self->ut_country('country')
 579     || $self->ut_anything('comments')
 580     || $self->ut_numbern('referral_custnum')
 581   ;
 582   #barf.  need message catalogs.  i18n.  etc.
 583   $error .= "Please select an advertising source."
 584     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
 585   return $error if $error;
 586
 587   return "Unknown agent"
 588     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
 589
 590   return "Unknown refnum"
 591     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
 592
 593   return "Unknown referring custnum ". $self->referral_custnum
 594     unless ! $self->referral_custnum
 595            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
 596
 597   if ( $self->ss eq '' ) {
 598     $self->ss('');
 599   } else {
 600     my $ss = $self->ss;
 601     $ss =~ s/\D//g;
 602     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
 603       or return "Illegal social security number: ". $self->ss;
 604     $self->ss("$1-$2-$3");
 605   }
 606
 607
 608 # bad idea to disable, causes billing to fail because of no tax rates later
 609 #  unless ( $import ) {
 610     unless ( qsearch('cust_main_county', {
 611       'country' => $self->country,
 612       'state'   => '',
 613      } ) ) {
 614       return "Unknown state/county/country: ".
 615         $self->state. "/". $self->county. "/". $self->country
 616         unless qsearch('cust_main_county',{
 617           'state'   => $self->state,
 618           'county'  => $self->county,
 619           'country' => $self->country,
 620         } );
 621     }
 622 #  }
 623
 624   $error =
 625     $self->ut_phonen('daytime', $self->country)
 626     || $self->ut_phonen('night', $self->country)
 627     || $self->ut_phonen('fax', $self->country)
 628     || $self->ut_zip('zip', $self->country)
 629   ;
 630   return $error if $error;
 631
 632   my @addfields = qw(
 633     last first company address1 address2 city county state zip
 634     country daytime night fax
 635   );
 636
 637   if ( defined $self->dbdef_table->column('ship_last') ) {
 638     if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
 639                        @addfields )
 640          && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
 641        )
 642     {
 643       my $error =
 644         $self->ut_name('ship_last')
 645         || $self->ut_name('ship_first')
 646         || $self->ut_textn('ship_company')
 647         || $self->ut_text('ship_address1')
 648         || $self->ut_textn('ship_address2')
 649         || $self->ut_text('ship_city')
 650         || $self->ut_textn('ship_county')
 651         || $self->ut_textn('ship_state')
 652         || $self->ut_country('ship_country')
 653       ;
 654       return $error if $error;
 655
 656       #false laziness with above
 657       unless ( qsearchs('cust_main_county', {
 658         'country' => $self->ship_country,
 659         'state'   => '',
 660        } ) ) {
 661         return "Unknown ship_state/ship_county/ship_country: ".
 662           $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
 663           unless qsearchs('cust_main_county',{
 664             'state'   => $self->ship_state,
 665             'county'  => $self->ship_county,
 666             'country' => $self->ship_country,
 667           } );
 668       }
 669       #eofalse
 670
 671       $error =
 672         $self->ut_phonen('ship_daytime', $self->ship_country)
 673         || $self->ut_phonen('ship_night', $self->ship_country)
 674         || $self->ut_phonen('ship_fax', $self->ship_country)
 675         || $self->ut_zip('ship_zip', $self->ship_country)
 676       ;
 677       return $error if $error;
 678
 679     } else { # ship_ info eq billing info, so don't store dup info in database
 680       $self->setfield("ship_$_", '')
 681         foreach qw( last first company address1 address2 city county state zip
 682                     country daytime night fax );
 683     }
 684   }
 685
 686   $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP|PREPAY)$/
 687     or return "Illegal payby: ". $self->payby;
 688   $self->payby($1);
 689
 690   if ( $self->payby eq 'CARD' ) {
 691
 692     my $payinfo = $self->payinfo;
 693     $payinfo =~ s/\D//g;
 694     $payinfo =~ /^(\d{13,16})$/
 695       or return gettext('invalid_card'); # . ": ". $self->payinfo;
 696     $payinfo = $1;
 697     $self->payinfo($payinfo);
 698     validate($payinfo)
 699       or return gettext('invalid_card'); # . ": ". $self->payinfo;
 700     return gettext('unknown_card_type')
 701       if cardtype($self->payinfo) eq "Unknown";
 702     if ( defined $self->dbdef_table->column('paycvv') ) {
 703       if ( length($self->paycvv) ) {
 704         if ( cardtype($self->payinfo) eq 'American Express card' ) {
 705           $self->paycvv =~ /^(\d{4})$/
 706             or return "CVV2 (CID) for American Express cards is four digits.";
 707           $self->paycvv($1);
 708         } else {
 709           $self->paycvv =~ /^(\d{3})$/
 710             or return "CVV2 (CVC2/CID) is three digits.";
 711           $self->paycvv($1);
 712         }
 713       } else {
 714         $self->paycvv('');
 715       }
 716     }
 717
 718   } elsif ( $self->payby eq 'CHEK' ) {
 719
 720     my $payinfo = $self->payinfo;
 721     $payinfo =~ s/[^\d\@]//g;
 722     $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
 723     $payinfo = "$1\@$2";
 724     $self->payinfo($payinfo);
 725     $self->paycvv('') if $self->dbdef_table->column('paycvv');
 726
 727   } elsif ( $self->payby eq 'LECB' ) {
 728
 729     my $payinfo = $self->payinfo;
 730     $payinfo =~ s/\D//g;
 731     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
 732     $payinfo = $1;
 733     $self->payinfo($payinfo);
 734     $self->paycvv('') if $self->dbdef_table->column('paycvv');
 735
 736   } elsif ( $self->payby eq 'BILL' ) {
 737
 738     $error = $self->ut_textn('payinfo');
 739     return "Illegal P.O. number: ". $self->payinfo if $error;
 740     $self->paycvv('') if $self->dbdef_table->column('paycvv');
 741
 742   } elsif ( $self->payby eq 'COMP' ) {
 743
 744     if ( !$self->custnum && $conf->config('users-allow_comp') ) {
 745       return "You are not permitted to create complimentary accounts."
 746         unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
 747     }
 748
 749     $error = $self->ut_textn('payinfo');
 750     return "Illegal comp account issuer: ". $self->payinfo if $error;
 751     $self->paycvv('') if $self->dbdef_table->column('paycvv');
 752
 753   } elsif ( $self->payby eq 'PREPAY' ) {
 754
 755     my $payinfo = $self->payinfo;
 756     $payinfo =~ s/\W//g; #anything else would just confuse things
 757     $self->payinfo($payinfo);
 758     $error = $self->ut_alpha('payinfo');
 759     return "Illegal prepayment identifier: ". $self->payinfo if $error;
 760     return "Unknown prepayment identifier"
 761       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
 762     $self->paycvv('') if $self->dbdef_table->column('paycvv');
 763
 764   }
 765
 766   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
 767     return "Expriation date required"
 768       unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
 769     $self->paydate('');
 770   } else {
 771     $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
 772       or return "Illegal expiration date: ". $self->paydate;
 773     my $y = length($2) == 4 ? $2 : "20$2";
 774     $self->paydate("$y-$1-01");
 775     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
 776     return gettext('expired_card')
 777       if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
 778   }
 779
 780   if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
 781        ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) {
 782     $self->payname( $self->first. " ". $self->getfield('last') );
 783   } else {
 784     $self->payname =~ /^([\w \,\.\-\']+)$/
 785       or return gettext('illegal_name'). " payname: ". $self->payname;
 786     $self->payname($1);
 787   }
 788
 789   $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
 790   $self->tax($1);
 791
 792   $self->otaker(getotaker);
 793
 794   #warn "AFTER: \n". $self->_dump;
 795
 796   ''; #no error
 797 }
 798
 799 =item all_pkgs
 800
 801 Returns all packages (see L<FS::cust_pkg>) for this customer.
 802
 803 =cut
 804
 805 sub all_pkgs {
 806   my $self = shift;
 807   if ( $self->{'_pkgnum'} ) {
 808     values %{ $self->{'_pkgnum'}->cache };
 809   } else {
 810     qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
 811   }
 812 }
 813
 814 =item ncancelled_pkgs
 815
 816 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
 817
 818 =cut
 819
 820 sub ncancelled_pkgs {
 821   my $self = shift;
 822   if ( $self->{'_pkgnum'} ) {
 823     grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
 824   } else {
 825     @{ [ # force list context
 826       qsearch( 'cust_pkg', {
 827         'custnum' => $self->custnum,
 828         'cancel'  => '',
 829       }),
 830       qsearch( 'cust_pkg', {
 831         'custnum' => $self->custnum,
 832         'cancel'  => 0,
 833       }),
 834     ] };
 835   }
 836 }
 837
 838 =item suspended_pkgs
 839
 840 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
 841
 842 =cut
 843
 844 sub suspended_pkgs {
 845   my $self = shift;
 846   grep { $_->susp } $self->ncancelled_pkgs;
 847 }
 848
 849 =item unflagged_suspended_pkgs
 850
 851 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
 852 customer (thouse packages without the `manual_flag' set).
 853
 854 =cut
 855
 856 sub unflagged_suspended_pkgs {
 857   my $self = shift;
 858   return $self->suspended_pkgs
 859     unless dbdef->table('cust_pkg')->column('manual_flag');
 860   grep { ! $_->manual_flag } $self->suspended_pkgs;
 861 }
 862
 863 =item unsuspended_pkgs
 864
 865 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
 866 this customer.
 867
 868 =cut
 869
 870 sub unsuspended_pkgs {
 871   my $self = shift;
 872   grep { ! $_->susp } $self->ncancelled_pkgs;
 873 }
 874
 875 =item unsuspend
 876
 877 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
 878 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
 879 on success or a list of errors.
 880
 881 =cut
 882
 883 sub unsuspend {
 884   my $self = shift;
 885   grep { $_->unsuspend } $self->suspended_pkgs;
 886 }
 887
 888 =item suspend
 889
 890 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
 891 Always returns a list: an empty list on success or a list of errors.
 892
 893 =cut
 894
 895 sub suspend {
 896   my $self = shift;
 897   grep { $_->suspend } $self->unsuspended_pkgs;
 898 }
 899
 900 =item cancel [ OPTION => VALUE ... ]
 901
 902 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
 903
 904 Available options are: I<quiet>
 905
 906 I<quiet> can be set true to supress email cancellation notices.
 907
 908 Always returns a list: an empty list on success or a list of errors.
 909
 910 =cut
 911
 912 sub cancel {
 913   my $self = shift;
 914   grep { $_->cancel(@_) } $self->ncancelled_pkgs;
 915 }
 916
 917 =item agent
 918
 919 Returns the agent (see L<FS::agent>) for this customer.
 920
 921 =cut
 922
 923 sub agent {
 924   my $self = shift;
 925   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
 926 }
 927
 928 =item bill OPTIONS
 929
 930 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
 931 conjunction with the collect method.
 932
 933 Options are passed as name-value pairs.
 934
 935 Currently available options are:
 936
 937 resetup - if set true, re-charges setup fees.
 938
 939 time - bills the customer as if it were that time.  Specified as a UNIX
 940 timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and
 941 L<Date::Parse> for conversion functions.  For example:
 942
 943  use Date::Parse;
 944  ...
 945  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
 946
 947
 948 If there is an error, returns the error, otherwise returns false.
 949
 950 =cut
 951
 952 sub bill {
 953   my( $self, %options ) = @_;
 954   my $time = $options{'time'} || time;
 955
 956   my $error;
 957
 958   #put below somehow?
 959   local $SIG{HUP} = 'IGNORE';
 960   local $SIG{INT} = 'IGNORE';
 961   local $SIG{QUIT} = 'IGNORE';
 962   local $SIG{TERM} = 'IGNORE';
 963   local $SIG{TSTP} = 'IGNORE';
 964   local $SIG{PIPE} = 'IGNORE';
 965
 966   my $oldAutoCommit = $FS::UID::AutoCommit;
 967   local $FS::UID::AutoCommit = 0;
 968   my $dbh = dbh;
 969
 970   # find the packages which are due for billing, find out how much they are
 971   # & generate invoice database.
 972
 973   my( $total_setup, $total_recur ) = ( 0, 0 );
 974   #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
 975   my @cust_bill_pkg = ();
 976   #my $tax = 0;##
 977   #my $taxable_charged = 0;##
 978   #my $charged = 0;##
 979
 980   my %tax;
 981
 982   foreach my $cust_pkg (
 983     qsearch('cust_pkg', { 'custnum' => $self->custnum } )
 984   ) {
 985
 986     #NO!! next if $cust_pkg->cancel;
 987     next if $cust_pkg->getfield('cancel');
 988
 989     #? to avoid use of uninitialized value errors... ?
 990     $cust_pkg->setfield('bill', '')
 991       unless defined($cust_pkg->bill);
 992
 993     my $part_pkg = $cust_pkg->part_pkg;
 994
 995     #so we don't modify cust_pkg record unnecessarily
 996     my $cust_pkg_mod_flag = 0;
 997     my %hash = $cust_pkg->hash;
 998     my $old_cust_pkg = new FS::cust_pkg \%hash;
 999
1000     # bill setup
1001     my $setup = 0;
1002     if ( !$cust_pkg->setup || $options{'resetup'} ) {
1003       my $setup_prog = $part_pkg->getfield('setup');
1004       $setup_prog =~ /^(.*)$/ or do {
1005         $dbh->rollback if $oldAutoCommit;
1006         return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
1007                ": $setup_prog";
1008       };
1009       $setup_prog = $1;
1010       $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1011
1012         #my $cpt = new Safe;
1013         ##$cpt->permit(); #what is necessary?
1014         #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1015         #$setup = $cpt->reval($setup_prog);
1016       $setup = eval $setup_prog;
1017       unless ( defined($setup) ) {
1018         $dbh->rollback if $oldAutoCommit;
1019         return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1020                "(expression $setup_prog): $@";
1021       }
1022       $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1023       $cust_pkg_mod_flag=1;
1024     }
1025
1026     #bill recurring fee
1027     my $recur = 0;
1028     my $sdate;
1029     if ( $part_pkg->getfield('freq') ne '0' &&
1030          ! $cust_pkg->getfield('susp') &&
1031          ( $cust_pkg->getfield('bill') || 0 ) <= $time
1032     ) {
1033       my $recur_prog = $part_pkg->getfield('recur');
1034       $recur_prog =~ /^(.*)$/ or do {
1035         $dbh->rollback if $oldAutoCommit;
1036         return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1037                ": $recur_prog";
1038       };
1039       $recur_prog = $1;
1040       $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1041
1042       # shared with $recur_prog
1043       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1044
1045         #my $cpt = new Safe;
1046         ##$cpt->permit(); #what is necessary?
1047         #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1048         #$recur = $cpt->reval($recur_prog);
1049       $recur = eval $recur_prog;
1050       unless ( defined($recur) ) {
1051         $dbh->rollback if $oldAutoCommit;
1052         return "Error eval-ing part_pkg->recur pkgpart ".  $part_pkg->pkgpart.
1053                "(expression $recur_prog): $@";
1054       }
1055       #change this bit to use Date::Manip? CAREFUL with timezones (see
1056       # mailing list archive)
1057       my ($sec,$min,$hour,$mday,$mon,$year) =
1058         (localtime($sdate) )[0,1,2,3,4,5];
1059
1060       #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1061       # only for figuring next bill date, nothing else, so, reset $sdate again
1062       # here
1063       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1064       $cust_pkg->last_bill($sdate)
1065         if $cust_pkg->dbdef_table->column('last_bill');
1066
1067       if ( $part_pkg->freq =~ /^\d+$/ ) {
1068         $mon += $part_pkg->freq;
1069         until ( $mon < 12 ) { $mon -= 12; $year++; }
1070       } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1071         my $weeks = $1;
1072         $mday += $weeks * 7;
1073       } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1074         my $days = $1;
1075         $mday += $days;
1076       } else {
1077         $dbh->rollback if $oldAutoCommit;
1078         return "unparsable frequency: ". $part_pkg->freq;
1079       }
1080       $cust_pkg->setfield('bill',
1081         timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1082       $cust_pkg_mod_flag = 1;
1083     }
1084
1085     warn "\$setup is undefined" unless defined($setup);
1086     warn "\$recur is undefined" unless defined($recur);
1087     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1088
1089     if ( $cust_pkg_mod_flag ) {
1090       $error=$cust_pkg->replace($old_cust_pkg);
1091       if ( $error ) { #just in case
1092         $dbh->rollback if $oldAutoCommit;
1093         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1094       }
1095       $setup = sprintf( "%.2f", $setup );
1096       $recur = sprintf( "%.2f", $recur );
1097       if ( $setup < 0 ) {
1098         $dbh->rollback if $oldAutoCommit;
1099         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1100       }
1101       if ( $recur < 0 ) {
1102         $dbh->rollback if $oldAutoCommit;
1103         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1104       }
1105       if ( $setup > 0 || $recur > 0 ) {
1106         my $cust_bill_pkg = new FS::cust_bill_pkg ({
1107           'pkgnum' => $cust_pkg->pkgnum,
1108           'setup'  => $setup,
1109           'recur'  => $recur,
1110           'sdate'  => $sdate,
1111           'edate'  => $cust_pkg->bill,
1112         });
1113         push @cust_bill_pkg, $cust_bill_pkg;
1114         $total_setup += $setup;
1115         $total_recur += $recur;
1116
1117         unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1118
1119           my @taxes = qsearch( 'cust_main_county', {
1120                                  'state'    => $self->state,
1121                                  'county'   => $self->county,
1122                                  'country'  => $self->country,
1123                                  'taxclass' => $part_pkg->taxclass,
1124                                                                       } );
1125           unless ( @taxes ) {
1126             @taxes =  qsearch( 'cust_main_county', {
1127                                   'state'    => $self->state,
1128                                   'county'   => $self->county,
1129                                   'country'  => $self->country,
1130                                   'taxclass' => '',
1131                                                                       } );
1132           }
1133
1134           # maybe eliminate this entirely, along with all the 0% records
1135           unless ( @taxes ) {
1136             $dbh->rollback if $oldAutoCommit;
1137             return
1138               "fatal: can't find tax rate for state/county/country/taxclass ".
1139               join('/', ( map $self->$_(), qw(state county country) ),
1140                         $part_pkg->taxclass ).  "\n";
1141           }
1142
1143           foreach my $tax ( @taxes ) {
1144
1145             my $taxable_charged = 0;
1146             $taxable_charged += $setup
1147               unless $part_pkg->setuptax =~ /^Y$/i
1148                   || $tax->setuptax =~ /^Y$/i;
1149             $taxable_charged += $recur
1150               unless $part_pkg->recurtax =~ /^Y$/i
1151                   || $tax->recurtax =~ /^Y$/i;
1152             next unless $taxable_charged;
1153
1154             if ( $tax->exempt_amount > 0 ) {
1155               my ($mon,$year) = (localtime($sdate) )[4,5];
1156               $mon++;
1157               my $freq = $part_pkg->freq || 1;
1158               if ( $freq !~ /(\d+)$/ ) {
1159                 $dbh->rollback if $oldAutoCommit;
1160                 return "daily/weekly package definitions not (yet?)".
1161                        " compatible with monthly tax exemptions";
1162               }
1163               my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1164               foreach my $which_month ( 1 .. $freq ) {
1165                 my %hash = (
1166                   'custnum' => $self->custnum,
1167                   'taxnum'  => $tax->taxnum,
1168                   'year'    => 1900+$year,
1169                   'month'   => $mon++,
1170                 );
1171                 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1172                 until ( $mon < 13 ) { $mon -= 12; $year++; }
1173                 my $cust_tax_exempt =
1174                   qsearchs('cust_tax_exempt', \%hash)
1175                   || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1176                 my $remaining_exemption = sprintf("%.2f",
1177                   $tax->exempt_amount - $cust_tax_exempt->amount );
1178                 if ( $remaining_exemption > 0 ) {
1179                   my $addl = $remaining_exemption > $taxable_per_month
1180                     ? $taxable_per_month
1181                     : $remaining_exemption;
1182                   $taxable_charged -= $addl;
1183                   my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1184                     $cust_tax_exempt->hash,
1185                     'amount' =>
1186                       sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1187                   } );
1188                   $error = $new_cust_tax_exempt->exemptnum
1189                     ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1190                     : $new_cust_tax_exempt->insert;
1191                   if ( $error ) {
1192                     $dbh->rollback if $oldAutoCommit;
1193                     return "fatal: can't update cust_tax_exempt: $error";
1194                   }
1195
1196                 } # if $remaining_exemption > 0
1197
1198               } #foreach $which_month
1199
1200             } #if $tax->exempt_amount
1201
1202             $taxable_charged = sprintf( "%.2f", $taxable_charged);
1203
1204             #$tax += $taxable_charged * $cust_main_county->tax / 100
1205             $tax{ $tax->taxname || 'Tax' } +=
1206               $taxable_charged * $tax->tax / 100
1207
1208           } #foreach my $tax ( @taxes )
1209
1210         } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1211
1212       } #if $setup > 0 || $recur > 0
1213
1214     } #if $cust_pkg_mod_flag
1215
1216   } #foreach my $cust_pkg
1217
1218   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1219 #  my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1220
1221   unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1222     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1223     return '';
1224   }
1225
1226 #  unless ( $self->tax =~ /Y/i
1227 #           || $self->payby eq 'COMP'
1228 #           || $taxable_charged == 0 ) {
1229 #    my $cust_main_county = qsearchs('cust_main_county',{
1230 #        'state'   => $self->state,
1231 #        'county'  => $self->county,
1232 #        'country' => $self->country,
1233 #    } ) or die "fatal: can't find tax rate for state/county/country ".
1234 #               $self->state. "/". $self->county. "/". $self->country. "\n";
1235 #    my $tax = sprintf( "%.2f",
1236 #      $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1237 #    );
1238
1239   if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1240
1241     foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1242       my $tax = sprintf("%.2f", $tax{$taxname} );
1243       $charged = sprintf( "%.2f", $charged+$tax );
1244
1245       my $cust_bill_pkg = new FS::cust_bill_pkg ({
1246         'pkgnum'   => 0,
1247         'setup'    => $tax,
1248         'recur'    => 0,
1249         'sdate'    => '',
1250         'edate'    => '',
1251         'itemdesc' => $taxname,
1252       });
1253       push @cust_bill_pkg, $cust_bill_pkg;
1254     }
1255
1256   } else { #1.4 schema
1257
1258     my $tax = 0;
1259     foreach ( values %tax ) { $tax += $_ };
1260     $tax = sprintf("%.2f", $tax);
1261     if ( $tax > 0 ) {
1262       $charged = sprintf( "%.2f", $charged+$tax );
1263
1264       my $cust_bill_pkg = new FS::cust_bill_pkg ({
1265         'pkgnum' => 0,
1266         'setup'  => $tax,
1267         'recur'  => 0,
1268         'sdate'  => '',
1269         'edate'  => '',
1270       });
1271       push @cust_bill_pkg, $cust_bill_pkg;
1272     }
1273
1274   }
1275
1276   my $cust_bill = new FS::cust_bill ( {
1277     'custnum' => $self->custnum,
1278     '_date'   => $time,
1279     'charged' => $charged,
1280   } );
1281   $error = $cust_bill->insert;
1282   if ( $error ) {
1283     $dbh->rollback if $oldAutoCommit;
1284     return "can't create invoice for customer #". $self->custnum. ": $error";
1285   }
1286
1287   my $invnum = $cust_bill->invnum;
1288   my $cust_bill_pkg;
1289   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1290     #warn $invnum;
1291     $cust_bill_pkg->invnum($invnum);
1292     $error = $cust_bill_pkg->insert;
1293     if ( $error ) {
1294       $dbh->rollback if $oldAutoCommit;
1295       return "can't create invoice line item for customer #". $self->custnum.
1296              ": $error";
1297     }
1298   }
1299
1300   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1301   ''; #no error
1302 }
1303
1304 =item reexport
1305
1306 document me.  Re-schedules all exports by calling the B<reexport> method
1307 of all associated packages (see L<FS::cust_pkg>).  If there is an error,
1308 returns the error; otherwise returns false.
1309
1310 =cut
1311
1312 sub reexport {
1313   my $self = shift;
1314
1315   local $SIG{HUP} = 'IGNORE';
1316   local $SIG{INT} = 'IGNORE';
1317   local $SIG{QUIT} = 'IGNORE';
1318   local $SIG{TERM} = 'IGNORE';
1319   local $SIG{TSTP} = 'IGNORE';
1320   local $SIG{PIPE} = 'IGNORE';
1321
1322   my $oldAutoCommit = $FS::UID::AutoCommit;
1323   local $FS::UID::AutoCommit = 0;
1324   my $dbh = dbh;
1325
1326   foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1327     my $error = $cust_pkg->reexport;
1328     if ( $error ) {
1329       $dbh->rollback if $oldAutoCommit;
1330       return $error;
1331     }
1332   }
1333
1334   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1335   '';
1336
1337 }
1338
1339 =item collect OPTIONS
1340
1341 (Attempt to) collect money for this customer's outstanding invoices (see
1342 L<FS::cust_bill>).  Usually used after the bill method.
1343
1344 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1345 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1346
1347 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1348 and the invoice events web interface.
1349
1350 If there is an error, returns the error, otherwise returns false.
1351
1352 Options are passed as name-value pairs.
1353
1354 Currently available options are:
1355
1356 invoice_time - Use this time when deciding when to print invoices and
1357 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>
1358 for conversion functions.
1359
1360 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1361 events.
1362
1363 retry_card - Deprecated alias for 'retry'
1364
1365 batch_card - This option is deprecated.  See the invoice events web interface
1366 to control whether cards are batched or run against a realtime gateway.
1367
1368 report_badcard - This option is deprecated.
1369
1370 force_print - This option is deprecated; see the invoice events web interface.
1371
1372 quiet - set true to surpress email card/ACH decline notices.
1373
1374 =cut
1375
1376 sub collect {
1377   my( $self, %options ) = @_;
1378   my $invoice_time = $options{'invoice_time'} || time;
1379
1380   #put below somehow?
1381   local $SIG{HUP} = 'IGNORE';
1382   local $SIG{INT} = 'IGNORE';
1383   local $SIG{QUIT} = 'IGNORE';
1384   local $SIG{TERM} = 'IGNORE';
1385   local $SIG{TSTP} = 'IGNORE';
1386   local $SIG{PIPE} = 'IGNORE';
1387
1388   my $oldAutoCommit = $FS::UID::AutoCommit;
1389   local $FS::UID::AutoCommit = 0;
1390   my $dbh = dbh;
1391
1392   my $balance = $self->balance;
1393   warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1394   unless ( $balance > 0 ) { #redundant?????
1395     $dbh->rollback if $oldAutoCommit; #hmm
1396     return '';
1397   }
1398
1399   if ( exists($options{'retry_card'}) ) {
1400     carp 'retry_card option passed to collect is deprecated; use retry';
1401     $options{'retry'} ||= $options{'retry_card'};
1402   }
1403   if ( exists($options{'retry'}) && $options{'retry'} ) {
1404     my $error = $self->retry_realtime;
1405     if ( $error ) {
1406       $dbh->rollback if $oldAutoCommit;
1407       return $error;
1408     }
1409   }
1410
1411   foreach my $cust_bill ( $self->cust_bill ) {
1412
1413     #this has to be before next's
1414     my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1415                                   ? $balance
1416                                   : $cust_bill->owed
1417     );
1418     $balance = sprintf( "%.2f", $balance - $amount );
1419
1420     next unless $cust_bill->owed > 0;
1421
1422     # don't try to charge for the same invoice if it's already in a batch
1423     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1424
1425     warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1426
1427     next unless $amount > 0;
1428
1429
1430     foreach my $part_bill_event (
1431       sort {    $a->seconds   <=> $b->seconds
1432              || $a->weight    <=> $b->weight
1433              || $a->eventpart <=> $b->eventpart }
1434         grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1435                && ! qsearchs( 'cust_bill_event', {
1436                                 'invnum'    => $cust_bill->invnum,
1437                                 'eventpart' => $_->eventpart,
1438                                 'status'    => 'done',
1439                                                                    } )
1440              }
1441           qsearch('part_bill_event', { 'payby'    => $self->payby,
1442                                        'disabled' => '',           } )
1443     ) {
1444
1445       last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1446
1447       warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1448         if $Debug;
1449       my $cust_main = $self; #for callback
1450
1451       my $error;
1452       {
1453         #supress "used only once" warning
1454         $FS::cust_bill::realtime_bop_decline_quiet += 0;
1455         local $FS::cust_bill::realtime_bop_decline_quiet = 1
1456           if $options{'quiet'};
1457         $error = eval $part_bill_event->eventcode;
1458       }
1459
1460       my $status = '';
1461       my $statustext = '';
1462       if ( $@ ) {
1463         $status = 'failed';
1464         $statustext = $@;
1465       } elsif ( $error ) {
1466         $status = 'done';
1467         $statustext = $error;
1468       } else {
1469         $status = 'done'
1470       }
1471
1472       #add cust_bill_event
1473       my $cust_bill_event = new FS::cust_bill_event {
1474         'invnum'     => $cust_bill->invnum,
1475         'eventpart'  => $part_bill_event->eventpart,
1476         #'_date'      => $invoice_time,
1477         '_date'      => time,
1478         'status'     => $status,
1479         'statustext' => $statustext,
1480       };
1481       $error = $cust_bill_event->insert;
1482       if ( $error ) {
1483         #$dbh->rollback if $oldAutoCommit;
1484         #return "error: $error";
1485
1486         # gah, even with transactions.
1487         $dbh->commit if $oldAutoCommit; #well.
1488         my $e = 'WARNING: Event run but database not updated - '.
1489                 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1490                 ', eventpart '. $part_bill_event->eventpart.
1491                 ": $error";
1492         warn $e;
1493         return $e;
1494       }
1495
1496
1497     }
1498
1499   }
1500
1501   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1502   '';
1503
1504 }
1505
1506 =item retry_realtime
1507
1508 Schedules realtime credit card / electronic check / LEC billing events for
1509 for retry.  Useful if card information has changed or manual retry is desired.
1510 The 'collect' method must be called to actually retry the transaction.
1511
1512 Implementation details: For each of this customer's open invoices, changes
1513 the status of the first "done" (with statustext error) realtime processing
1514 event to "failed".
1515
1516 =cut
1517
1518 sub retry_realtime {
1519   my $self = shift;
1520
1521   local $SIG{HUP} = 'IGNORE';
1522   local $SIG{INT} = 'IGNORE';
1523   local $SIG{QUIT} = 'IGNORE';
1524   local $SIG{TERM} = 'IGNORE';
1525   local $SIG{TSTP} = 'IGNORE';
1526   local $SIG{PIPE} = 'IGNORE';
1527
1528   my $oldAutoCommit = $FS::UID::AutoCommit;
1529   local $FS::UID::AutoCommit = 0;
1530   my $dbh = dbh;
1531
1532   foreach my $cust_bill (
1533     grep { $_->cust_bill_event }
1534       $self->open_cust_bill
1535   ) {
1536     my @cust_bill_event =
1537       sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1538         grep {
1539                #$_->part_bill_event->plan eq 'realtime-card'
1540                $_->part_bill_event->eventcode =~
1541                    /\$cust_bill\->realtime_(card|ach|lec)/
1542                  && $_->status eq 'done'
1543                  && $_->statustext
1544              }
1545           $cust_bill->cust_bill_event;
1546     next unless @cust_bill_event;
1547     my $error = $cust_bill_event[0]->retry;
1548     if ( $error ) {
1549       $dbh->rollback if $oldAutoCommit;
1550       return "error scheduling invoice event for retry: $error";
1551     }
1552
1553   }
1554
1555   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1556   '';
1557
1558 }
1559
1560 =item total_owed
1561
1562 Returns the total owed for this customer on all invoices
1563 (see L<FS::cust_bill/owed>).
1564
1565 =cut
1566
1567 sub total_owed {
1568   my $self = shift;
1569   $self->total_owed_date(2145859200); #12/31/2037
1570 }
1571
1572 =item total_owed_date TIME
1573
1574 Returns the total owed for this customer on all invoices with date earlier than
1575 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
1576 see L<Time::Local> and L<Date::Parse> for conversion functions.
1577
1578 =cut
1579
1580 sub total_owed_date {
1581   my $self = shift;
1582   my $time = shift;
1583   my $total_bill = 0;
1584   foreach my $cust_bill (
1585     grep { $_->_date <= $time }
1586       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1587   ) {
1588     $total_bill += $cust_bill->owed;
1589   }
1590   sprintf( "%.2f", $total_bill );
1591 }
1592
1593 =item apply_credits
1594
1595 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1596 to outstanding invoice balances in chronological order and returns the value
1597 of any remaining unapplied credits available for refund
1598 (see L<FS::cust_refund>).
1599
1600 =cut
1601
1602 sub apply_credits {
1603   my $self = shift;
1604
1605   return 0 unless $self->total_credited;
1606
1607   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1608       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1609
1610   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1611       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1612
1613   my $credit;
1614
1615   foreach my $cust_bill ( @invoices ) {
1616     my $amount;
1617
1618     if ( !defined($credit) || $credit->credited == 0) {
1619       $credit = pop @credits or last;
1620     }
1621
1622     if ($cust_bill->owed >= $credit->credited) {
1623       $amount=$credit->credited;
1624     }else{
1625       $amount=$cust_bill->owed;
1626     }
1627
1628     my $cust_credit_bill = new FS::cust_credit_bill ( {
1629       'crednum' => $credit->crednum,
1630       'invnum'  => $cust_bill->invnum,
1631       'amount'  => $amount,
1632     } );
1633     my $error = $cust_credit_bill->insert;
1634     die $error if $error;
1635
1636     redo if ($cust_bill->owed > 0);
1637
1638   }
1639
1640   return $self->total_credited;
1641 }
1642
1643 =item apply_payments
1644
1645 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1646 to outstanding invoice balances in chronological order.
1647
1648  #and returns the value of any remaining unapplied payments.
1649
1650 =cut
1651
1652 sub apply_payments {
1653   my $self = shift;
1654
1655   #return 0 unless
1656
1657   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1658       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1659
1660   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1661       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1662
1663   my $payment;
1664
1665   foreach my $cust_bill ( @invoices ) {
1666     my $amount;
1667
1668     if ( !defined($payment) || $payment->unapplied == 0 ) {
1669       $payment = pop @payments or last;
1670     }
1671
1672     if ( $cust_bill->owed >= $payment->unapplied ) {
1673       $amount = $payment->unapplied;
1674     } else {
1675       $amount = $cust_bill->owed;
1676     }
1677
1678     my $cust_bill_pay = new FS::cust_bill_pay ( {
1679       'paynum' => $payment->paynum,
1680       'invnum' => $cust_bill->invnum,
1681       'amount' => $amount,
1682     } );
1683     my $error = $cust_bill_pay->insert;
1684     die $error if $error;
1685
1686     redo if ( $cust_bill->owed > 0);
1687
1688   }
1689
1690   return $self->total_unapplied_payments;
1691 }
1692
1693 =item total_credited
1694
1695 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1696 customer.  See L<FS::cust_credit/credited>.
1697
1698 =cut
1699
1700 sub total_credited {
1701   my $self = shift;
1702   my $total_credit = 0;
1703   foreach my $cust_credit ( qsearch('cust_credit', {
1704     'custnum' => $self->custnum,
1705   } ) ) {
1706     $total_credit += $cust_credit->credited;
1707   }
1708   sprintf( "%.2f", $total_credit );
1709 }
1710
1711 =item total_unapplied_payments
1712
1713 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1714 See L<FS::cust_pay/unapplied>.
1715
1716 =cut
1717
1718 sub total_unapplied_payments {
1719   my $self = shift;
1720   my $total_unapplied = 0;
1721   foreach my $cust_pay ( qsearch('cust_pay', {
1722     'custnum' => $self->custnum,
1723   } ) ) {
1724     $total_unapplied += $cust_pay->unapplied;
1725   }
1726   sprintf( "%.2f", $total_unapplied );
1727 }
1728
1729 =item balance
1730
1731 Returns the balance for this customer (total_owed minus total_credited
1732 minus total_unapplied_payments).
1733
1734 =cut
1735
1736 sub balance {
1737   my $self = shift;
1738   sprintf( "%.2f",
1739     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1740   );
1741 }
1742
1743 =item balance_date TIME
1744
1745 Returns the balance for this customer, only considering invoices with date
1746 earlier than TIME (total_owed_date minus total_credited minus
1747 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
1748 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
1749 functions.
1750
1751 =cut
1752
1753 sub balance_date {
1754   my $self = shift;
1755   my $time = shift;
1756   sprintf( "%.2f",
1757     $self->total_owed_date($time)
1758       - $self->total_credited
1759       - $self->total_unapplied_payments
1760   );
1761 }
1762
1763 =item invoicing_list [ ARRAYREF ]
1764
1765 If an arguement is given, sets these email addresses as invoice recipients
1766 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
1767 (except as warnings), so use check_invoicing_list first.
1768
1769 Returns a list of email addresses (with svcnum entries expanded).
1770
1771 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
1772 check it without disturbing anything by passing nothing.
1773
1774 This interface may change in the future.
1775
1776 =cut
1777
1778 sub invoicing_list {
1779   my( $self, $arrayref ) = @_;
1780   if ( $arrayref ) {
1781     my @cust_main_invoice;
1782     if ( $self->custnum ) {
1783       @cust_main_invoice =
1784         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1785     } else {
1786       @cust_main_invoice = ();
1787     }
1788     foreach my $cust_main_invoice ( @cust_main_invoice ) {
1789       #warn $cust_main_invoice->destnum;
1790       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1791         #warn $cust_main_invoice->destnum;
1792         my $error = $cust_main_invoice->delete;
1793         warn $error if $error;
1794       }
1795     }
1796     if ( $self->custnum ) {
1797       @cust_main_invoice =
1798         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1799     } else {
1800       @cust_main_invoice = ();
1801     }
1802     my %seen = map { $_->address => 1 } @cust_main_invoice;
1803     foreach my $address ( @{$arrayref} ) {
1804       next if exists $seen{$address} && $seen{$address};
1805       $seen{$address} = 1;
1806       my $cust_main_invoice = new FS::cust_main_invoice ( {
1807         'custnum' => $self->custnum,
1808         'dest'    => $address,
1809       } );
1810       my $error = $cust_main_invoice->insert;
1811       warn $error if $error;
1812     }
1813   }
1814   if ( $self->custnum ) {
1815     map { $_->address }
1816       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1817   } else {
1818     ();
1819   }
1820 }
1821
1822 =item check_invoicing_list ARRAYREF
1823
1824 Checks these arguements as valid input for the invoicing_list method.  If there
1825 is an error, returns the error, otherwise returns false.
1826
1827 =cut
1828
1829 sub check_invoicing_list {
1830   my( $self, $arrayref ) = @_;
1831   foreach my $address ( @{$arrayref} ) {
1832     my $cust_main_invoice = new FS::cust_main_invoice ( {
1833       'custnum' => $self->custnum,
1834       'dest'    => $address,
1835     } );
1836     my $error = $self->custnum
1837                 ? $cust_main_invoice->check
1838                 : $cust_main_invoice->checkdest
1839     ;
1840     return $error if $error;
1841   }
1842   '';
1843 }
1844
1845 =item set_default_invoicing_list
1846
1847 Sets the invoicing list to all accounts associated with this customer,
1848 overwriting any previous invoicing list.
1849
1850 =cut
1851
1852 sub set_default_invoicing_list {
1853   my $self = shift;
1854   $self->invoicing_list($self->all_emails);
1855 }
1856
1857 =item all_emails
1858
1859 Returns the email addresses of all accounts provisioned for this customer.
1860
1861 =cut
1862
1863 sub all_emails {
1864   my $self = shift;
1865   my %list;
1866   foreach my $cust_pkg ( $self->all_pkgs ) {
1867     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1868     my @svc_acct =
1869       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1870         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1871           @cust_svc;
1872     $list{$_}=1 foreach map { $_->email } @svc_acct;
1873   }
1874   keys %list;
1875 }
1876
1877 =item invoicing_list_addpost
1878
1879 Adds postal invoicing to this customer.  If this customer is already configured
1880 to receive postal invoices, does nothing.
1881
1882 =cut
1883
1884 sub invoicing_list_addpost {
1885   my $self = shift;
1886   return if grep { $_ eq 'POST' } $self->invoicing_list;
1887   my @invoicing_list = $self->invoicing_list;
1888   push @invoicing_list, 'POST';
1889   $self->invoicing_list(\@invoicing_list);
1890 }
1891
1892 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1893
1894 Returns an array of customers referred by this customer (referral_custnum set
1895 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
1896 customers referred by customers referred by this customer and so on, inclusive.
1897 The default behavior is DEPTH 1 (no recursion).
1898
1899 =cut
1900
1901 sub referral_cust_main {
1902   my $self = shift;
1903   my $depth = @_ ? shift : 1;
1904   my $exclude = @_ ? shift : {};
1905
1906   my @cust_main =
1907     map { $exclude->{$_->custnum}++; $_; }
1908       grep { ! $exclude->{ $_->custnum } }
1909         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1910
1911   if ( $depth > 1 ) {
1912     push @cust_main,
1913       map { $_->referral_cust_main($depth-1, $exclude) }
1914         @cust_main;
1915   }
1916
1917   @cust_main;
1918 }
1919
1920 =item referral_cust_main_ncancelled
1921
1922 Same as referral_cust_main, except only returns customers with uncancelled
1923 packages.
1924
1925 =cut
1926
1927 sub referral_cust_main_ncancelled {
1928   my $self = shift;
1929   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1930 }
1931
1932 =item referral_cust_pkg [ DEPTH ]
1933
1934 Like referral_cust_main, except returns a flat list of all unsuspended (and
1935 uncancelled) packages for each customer.  The number of items in this list may
1936 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1937
1938 =cut
1939
1940 sub referral_cust_pkg {
1941   my $self = shift;
1942   my $depth = @_ ? shift : 1;
1943
1944   map { $_->unsuspended_pkgs }
1945     grep { $_->unsuspended_pkgs }
1946       $self->referral_cust_main($depth);
1947 }
1948
1949 =item credit AMOUNT, REASON
1950
1951 Applies a credit to this customer.  If there is an error, returns the error,
1952 otherwise returns false.
1953
1954 =cut
1955
1956 sub credit {
1957   my( $self, $amount, $reason ) = @_;
1958   my $cust_credit = new FS::cust_credit {
1959     'custnum' => $self->custnum,
1960     'amount'  => $amount,
1961     'reason'  => $reason,
1962   };
1963   $cust_credit->insert;
1964 }
1965
1966 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
1967
1968 Creates a one-time charge for this customer.  If there is an error, returns
1969 the error, otherwise returns false.
1970
1971 =cut
1972
1973 sub charge {
1974   my ( $self, $amount ) = ( shift, shift );
1975   my $pkg      = @_ ? shift : 'One-time charge';
1976   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
1977   my $taxclass = @_ ? shift : '';
1978
1979   local $SIG{HUP} = 'IGNORE';
1980   local $SIG{INT} = 'IGNORE';
1981   local $SIG{QUIT} = 'IGNORE';
1982   local $SIG{TERM} = 'IGNORE';
1983   local $SIG{TSTP} = 'IGNORE';
1984   local $SIG{PIPE} = 'IGNORE';
1985
1986   my $oldAutoCommit = $FS::UID::AutoCommit;
1987   local $FS::UID::AutoCommit = 0;
1988   my $dbh = dbh;
1989
1990   my $part_pkg = new FS::part_pkg ( {
1991     'pkg'      => $pkg,
1992     'comment'  => $comment,
1993     'setup'    => $amount,
1994     'freq'     => 0,
1995     'recur'    => '0',
1996     'disabled' => 'Y',
1997     'taxclass' => $taxclass,
1998   } );
1999
2000   my $error = $part_pkg->insert;
2001   if ( $error ) {
2002     $dbh->rollback if $oldAutoCommit;
2003     return $error;
2004   }
2005
2006   my $pkgpart = $part_pkg->pkgpart;
2007   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2008   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2009     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2010     $error = $type_pkgs->insert;
2011     if ( $error ) {
2012       $dbh->rollback if $oldAutoCommit;
2013       return $error;
2014     }
2015   }
2016
2017   my $cust_pkg = new FS::cust_pkg ( {
2018     'custnum' => $self->custnum,
2019     'pkgpart' => $pkgpart,
2020   } );
2021
2022   $error = $cust_pkg->insert;
2023   if ( $error ) {
2024     $dbh->rollback if $oldAutoCommit;
2025     return $error;
2026   }
2027
2028   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2029   '';
2030
2031 }
2032
2033 =item cust_bill
2034
2035 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2036
2037 =cut
2038
2039 sub cust_bill {
2040   my $self = shift;
2041   sort { $a->_date <=> $b->_date }
2042     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2043 }
2044
2045 =item open_cust_bill
2046
2047 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2048 customer.
2049
2050 =cut
2051
2052 sub open_cust_bill {
2053   my $self = shift;
2054   grep { $_->owed > 0 } $self->cust_bill;
2055 }
2056
2057 =back
2058
2059 =head1 SUBROUTINES
2060
2061 =over 4
2062
2063 =item check_and_rebuild_fuzzyfiles
2064
2065 =cut
2066
2067 sub check_and_rebuild_fuzzyfiles {
2068   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2069   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2070     or &rebuild_fuzzyfiles;
2071 }
2072
2073 =item rebuild_fuzzyfiles
2074
2075 =cut
2076
2077 sub rebuild_fuzzyfiles {
2078
2079   use Fcntl qw(:flock);
2080
2081   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2082
2083   #last
2084
2085   open(LASTLOCK,">>$dir/cust_main.last")
2086     or die "can't open $dir/cust_main.last: $!";
2087   flock(LASTLOCK,LOCK_EX)
2088     or die "can't lock $dir/cust_main.last: $!";
2089
2090   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2091   push @all_last,
2092                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2093     if defined dbdef->table('cust_main')->column('ship_last');
2094
2095   open (LASTCACHE,">$dir/cust_main.last.tmp")
2096     or die "can't open $dir/cust_main.last.tmp: $!";
2097   print LASTCACHE join("\n", @all_last), "\n";
2098   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2099
2100   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2101   close LASTLOCK;
2102
2103   #company
2104
2105   open(COMPANYLOCK,">>$dir/cust_main.company")
2106     or die "can't open $dir/cust_main.company: $!";
2107   flock(COMPANYLOCK,LOCK_EX)
2108     or die "can't lock $dir/cust_main.company: $!";
2109
2110   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2111   push @all_company,
2112        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2113     if defined dbdef->table('cust_main')->column('ship_last');
2114
2115   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2116     or die "can't open $dir/cust_main.company.tmp: $!";
2117   print COMPANYCACHE join("\n", @all_company), "\n";
2118   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2119
2120   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2121   close COMPANYLOCK;
2122
2123 }
2124
2125 =item all_last
2126
2127 =cut
2128
2129 sub all_last {
2130   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2131   open(LASTCACHE,"<$dir/cust_main.last")
2132     or die "can't open $dir/cust_main.last: $!";
2133   my @array = map { chomp; $_; } <LASTCACHE>;
2134   close LASTCACHE;
2135   \@array;
2136 }
2137
2138 =item all_company
2139
2140 =cut
2141
2142 sub all_company {
2143   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2144   open(COMPANYCACHE,"<$dir/cust_main.company")
2145     or die "can't open $dir/cust_main.last: $!";
2146   my @array = map { chomp; $_; } <COMPANYCACHE>;
2147   close COMPANYCACHE;
2148   \@array;
2149 }
2150
2151 =item append_fuzzyfiles LASTNAME COMPANY
2152
2153 =cut
2154
2155 sub append_fuzzyfiles {
2156   my( $last, $company ) = @_;
2157
2158   &check_and_rebuild_fuzzyfiles;
2159
2160   use Fcntl qw(:flock);
2161
2162   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2163
2164   if ( $last ) {
2165
2166     open(LAST,">>$dir/cust_main.last")
2167       or die "can't open $dir/cust_main.last: $!";
2168     flock(LAST,LOCK_EX)
2169       or die "can't lock $dir/cust_main.last: $!";
2170
2171     print LAST "$last\n";
2172
2173     flock(LAST,LOCK_UN)
2174       or die "can't unlock $dir/cust_main.last: $!";
2175     close LAST;
2176   }
2177
2178   if ( $company ) {
2179
2180     open(COMPANY,">>$dir/cust_main.company")
2181       or die "can't open $dir/cust_main.company: $!";
2182     flock(COMPANY,LOCK_EX)
2183       or die "can't lock $dir/cust_main.company: $!";
2184
2185     print COMPANY "$company\n";
2186
2187     flock(COMPANY,LOCK_UN)
2188       or die "can't unlock $dir/cust_main.company: $!";
2189
2190     close COMPANY;
2191   }
2192
2193   1;
2194 }
2195
2196 =item batch_import
2197
2198 =cut
2199
2200 sub batch_import {
2201   my $param = shift;
2202   #warn join('-',keys %$param);
2203   my $fh = $param->{filehandle};
2204   my $agentnum = $param->{agentnum};
2205   my $refnum = $param->{refnum};
2206   my $pkgpart = $param->{pkgpart};
2207   my @fields = @{$param->{fields}};
2208
2209   eval "use Date::Parse;";
2210   die $@ if $@;
2211   eval "use Text::CSV_XS;";
2212   die $@ if $@;
2213
2214   my $csv = new Text::CSV_XS;
2215   #warn $csv;
2216   #warn $fh;
2217
2218   my $imported = 0;
2219   #my $columns;
2220
2221   local $SIG{HUP} = 'IGNORE';
2222   local $SIG{INT} = 'IGNORE';
2223   local $SIG{QUIT} = 'IGNORE';
2224   local $SIG{TERM} = 'IGNORE';
2225   local $SIG{TSTP} = 'IGNORE';
2226   local $SIG{PIPE} = 'IGNORE';
2227
2228   my $oldAutoCommit = $FS::UID::AutoCommit;
2229   local $FS::UID::AutoCommit = 0;
2230   my $dbh = dbh;
2231
2232   #while ( $columns = $csv->getline($fh) ) {
2233   my $line;
2234   while ( defined($line=<$fh>) ) {
2235
2236     $csv->parse($line) or do {
2237       $dbh->rollback if $oldAutoCommit;
2238       return "can't parse: ". $csv->error_input();
2239     };
2240
2241     my @columns = $csv->fields();
2242     #warn join('-',@columns);
2243
2244     my %cust_main = (
2245       agentnum => $agentnum,
2246       refnum   => $refnum,
2247       country  => 'US', #default
2248       payby    => 'BILL', #default
2249       paydate  => '12/2037', #default
2250     );
2251     my $billtime = time;
2252     my %cust_pkg = ( pkgpart => $pkgpart );
2253     foreach my $field ( @fields ) {
2254       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2255         #$cust_pkg{$1} = str2time( shift @$columns );
2256         if ( $1 eq 'setup' ) {
2257           $billtime = str2time(shift @columns);
2258         } else {
2259           $cust_pkg{$1} = str2time( shift @columns );
2260         }
2261       } else {
2262         #$cust_main{$field} = shift @$columns;
2263         $cust_main{$field} = shift @columns;
2264       }
2265     }
2266
2267     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2268     my $cust_main = new FS::cust_main ( \%cust_main );
2269     use Tie::RefHash;
2270     tie my %hash, 'Tie::RefHash'; #this part is important
2271     $hash{$cust_pkg} = [] if $pkgpart;
2272     my $error = $cust_main->insert( \%hash );
2273
2274     if ( $error ) {
2275       $dbh->rollback if $oldAutoCommit;
2276       return "can't insert customer for $line: $error";
2277     }
2278
2279     #false laziness w/bill.cgi
2280     $error = $cust_main->bill( 'time' => $billtime );
2281     if ( $error ) {
2282       $dbh->rollback if $oldAutoCommit;
2283       return "can't bill customer for $line: $error";
2284     }
2285
2286     $cust_main->apply_payments;
2287     $cust_main->apply_credits;
2288
2289     $error = $cust_main->collect();
2290     if ( $error ) {
2291       $dbh->rollback if $oldAutoCommit;
2292       return "can't collect customer for $line: $error";
2293     }
2294
2295     $imported++;
2296   }
2297
2298   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2299
2300   return "Empty file!" unless $imported;
2301
2302   ''; #no error
2303
2304 }
2305
2306 =item batch_charge
2307
2308 =cut
2309
2310 sub batch_charge {
2311   my $param = shift;
2312   #warn join('-',keys %$param);
2313   my $fh = $param->{filehandle};
2314   my @fields = @{$param->{fields}};
2315
2316   eval "use Date::Parse;";
2317   die $@ if $@;
2318   eval "use Text::CSV_XS;";
2319   die $@ if $@;
2320
2321   my $csv = new Text::CSV_XS;
2322   #warn $csv;
2323   #warn $fh;
2324
2325   my $imported = 0;
2326   #my $columns;
2327
2328   local $SIG{HUP} = 'IGNORE';
2329   local $SIG{INT} = 'IGNORE';
2330   local $SIG{QUIT} = 'IGNORE';
2331   local $SIG{TERM} = 'IGNORE';
2332   local $SIG{TSTP} = 'IGNORE';
2333   local $SIG{PIPE} = 'IGNORE';
2334
2335   my $oldAutoCommit = $FS::UID::AutoCommit;
2336   local $FS::UID::AutoCommit = 0;
2337   my $dbh = dbh;
2338
2339   #while ( $columns = $csv->getline($fh) ) {
2340   my $line;
2341   while ( defined($line=<$fh>) ) {
2342
2343     $csv->parse($line) or do {
2344       $dbh->rollback if $oldAutoCommit;
2345       return "can't parse: ". $csv->error_input();
2346     };
2347
2348     my @columns = $csv->fields();
2349     #warn join('-',@columns);
2350
2351     my %row = ();
2352     foreach my $field ( @fields ) {
2353       $row{$field} = shift @columns;
2354     }
2355
2356     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2357     unless ( $cust_main ) {
2358       $dbh->rollback if $oldAutoCommit;
2359       return "unknown custnum $row{'custnum'}";
2360     }
2361
2362     if ( $row{'amount'} > 0 ) {
2363       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2364       if ( $error ) {
2365         $dbh->rollback if $oldAutoCommit;
2366         return $error;
2367       }
2368       $imported++;
2369     } elsif ( $row{'amount'} < 0 ) {
2370       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2371                                       $row{'pkg'}                         );
2372       if ( $error ) {
2373         $dbh->rollback if $oldAutoCommit;
2374         return $error;
2375       }
2376       $imported++;
2377     } else {
2378       #hmm?
2379     }
2380
2381   }
2382
2383   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2384
2385   return "Empty file!" unless $imported;
2386
2387   ''; #no error
2388
2389 }
2390
2391 =back
2392
2393 =head1 BUGS
2394
2395 The delete method.
2396
2397 The delete method should possibly take an FS::cust_main object reference
2398 instead of a scalar customer number.
2399
2400 Bill and collect options should probably be passed as references instead of a
2401 list.
2402
2403 There should probably be a configuration file with a list of allowed credit
2404 card types.
2405
2406 No multiple currency support (probably a larger project than just this module).
2407
2408 =head1 SEE ALSO
2409
2410 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2411 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2412 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
2413
2414 =cut
2415
2416 1;
2417