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
 703   } elsif ( $self->payby eq 'CHEK' ) {
 704
 705     my $payinfo = $self->payinfo;
 706     $payinfo =~ s/[^\d\@]//g;
 707     $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
 708     $payinfo = "$1\@$2";
 709     $self->payinfo($payinfo);
 710
 711   } elsif ( $self->payby eq 'LECB' ) {
 712
 713     my $payinfo = $self->payinfo;
 714     $payinfo =~ s/\D//g;
 715     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
 716     $payinfo = $1;
 717     $self->payinfo($payinfo);
 718
 719   } elsif ( $self->payby eq 'BILL' ) {
 720
 721     $error = $self->ut_textn('payinfo');
 722     return "Illegal P.O. number: ". $self->payinfo if $error;
 723
 724   } elsif ( $self->payby eq 'COMP' ) {
 725
 726     if ( !$self->custnum && $conf->config('users-allow_comp') ) {
 727       return "You are not permitted to create complimentary accounts."
 728         unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
 729     }
 730
 731     $error = $self->ut_textn('payinfo');
 732     return "Illegal comp account issuer: ". $self->payinfo if $error;
 733
 734   } elsif ( $self->payby eq 'PREPAY' ) {
 735
 736     my $payinfo = $self->payinfo;
 737     $payinfo =~ s/\W//g; #anything else would just confuse things
 738     $self->payinfo($payinfo);
 739     $error = $self->ut_alpha('payinfo');
 740     return "Illegal prepayment identifier: ". $self->payinfo if $error;
 741     return "Unknown prepayment identifier"
 742       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
 743
 744   }
 745
 746   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
 747     return "Expriation date required"
 748       unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
 749     $self->paydate('');
 750   } else {
 751     $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
 752       or return "Illegal expiration date: ". $self->paydate;
 753     my $y = length($2) == 4 ? $2 : "20$2";
 754     $self->paydate("$y-$1-01");
 755     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
 756     return gettext('expired_card')
 757       if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
 758   }
 759
 760   if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
 761        ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) {
 762     $self->payname( $self->first. " ". $self->getfield('last') );
 763   } else {
 764     $self->payname =~ /^([\w \,\.\-\']+)$/
 765       or return gettext('illegal_name'). " payname: ". $self->payname;
 766     $self->payname($1);
 767   }
 768
 769   $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
 770   $self->tax($1);
 771
 772   $self->otaker(getotaker);
 773
 774   #warn "AFTER: \n". $self->_dump;
 775
 776   ''; #no error
 777 }
 778
 779 =item all_pkgs
 780
 781 Returns all packages (see L<FS::cust_pkg>) for this customer.
 782
 783 =cut
 784
 785 sub all_pkgs {
 786   my $self = shift;
 787   if ( $self->{'_pkgnum'} ) {
 788     values %{ $self->{'_pkgnum'}->cache };
 789   } else {
 790     qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
 791   }
 792 }
 793
 794 =item ncancelled_pkgs
 795
 796 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
 797
 798 =cut
 799
 800 sub ncancelled_pkgs {
 801   my $self = shift;
 802   if ( $self->{'_pkgnum'} ) {
 803     grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
 804   } else {
 805     @{ [ # force list context
 806       qsearch( 'cust_pkg', {
 807         'custnum' => $self->custnum,
 808         'cancel'  => '',
 809       }),
 810       qsearch( 'cust_pkg', {
 811         'custnum' => $self->custnum,
 812         'cancel'  => 0,
 813       }),
 814     ] };
 815   }
 816 }
 817
 818 =item suspended_pkgs
 819
 820 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
 821
 822 =cut
 823
 824 sub suspended_pkgs {
 825   my $self = shift;
 826   grep { $_->susp } $self->ncancelled_pkgs;
 827 }
 828
 829 =item unflagged_suspended_pkgs
 830
 831 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
 832 customer (thouse packages without the `manual_flag' set).
 833
 834 =cut
 835
 836 sub unflagged_suspended_pkgs {
 837   my $self = shift;
 838   return $self->suspended_pkgs
 839     unless dbdef->table('cust_pkg')->column('manual_flag');
 840   grep { ! $_->manual_flag } $self->suspended_pkgs;
 841 }
 842
 843 =item unsuspended_pkgs
 844
 845 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
 846 this customer.
 847
 848 =cut
 849
 850 sub unsuspended_pkgs {
 851   my $self = shift;
 852   grep { ! $_->susp } $self->ncancelled_pkgs;
 853 }
 854
 855 =item unsuspend
 856
 857 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
 858 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
 859 on success or a list of errors.
 860
 861 =cut
 862
 863 sub unsuspend {
 864   my $self = shift;
 865   grep { $_->unsuspend } $self->suspended_pkgs;
 866 }
 867
 868 =item suspend
 869
 870 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
 871 Always returns a list: an empty list on success or a list of errors.
 872
 873 =cut
 874
 875 sub suspend {
 876   my $self = shift;
 877   grep { $_->suspend } $self->unsuspended_pkgs;
 878 }
 879
 880 =item cancel [ OPTION => VALUE ... ]
 881
 882 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
 883
 884 Available options are: I<quiet>
 885
 886 I<quiet> can be set true to supress email cancellation notices.
 887
 888 Always returns a list: an empty list on success or a list of errors.
 889
 890 =cut
 891
 892 sub cancel {
 893   my $self = shift;
 894   grep { $_->cancel(@_) } $self->ncancelled_pkgs;
 895 }
 896
 897 =item agent
 898
 899 Returns the agent (see L<FS::agent>) for this customer.
 900
 901 =cut
 902
 903 sub agent {
 904   my $self = shift;
 905   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
 906 }
 907
 908 =item bill OPTIONS
 909
 910 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
 911 conjunction with the collect method.
 912
 913 Options are passed as name-value pairs.
 914
 915 The only currently available option is `time', which bills the customer as if
 916 it were that time.  It is specified as a UNIX timestamp; see
 917 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
 918 functions.  For example:
 919
 920  use Date::Parse;
 921  ...
 922  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
 923
 924 If there is an error, returns the error, otherwise returns false.
 925
 926 =cut
 927
 928 sub bill {
 929   my( $self, %options ) = @_;
 930   my $time = $options{'time'} || time;
 931
 932   my $error;
 933
 934   #put below somehow?
 935   local $SIG{HUP} = 'IGNORE';
 936   local $SIG{INT} = 'IGNORE';
 937   local $SIG{QUIT} = 'IGNORE';
 938   local $SIG{TERM} = 'IGNORE';
 939   local $SIG{TSTP} = 'IGNORE';
 940   local $SIG{PIPE} = 'IGNORE';
 941
 942   my $oldAutoCommit = $FS::UID::AutoCommit;
 943   local $FS::UID::AutoCommit = 0;
 944   my $dbh = dbh;
 945
 946   # find the packages which are due for billing, find out how much they are
 947   # & generate invoice database.
 948
 949   my( $total_setup, $total_recur ) = ( 0, 0 );
 950   #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
 951   my @cust_bill_pkg = ();
 952   my $tax = 0;##
 953   #my $taxable_charged = 0;##
 954   #my $charged = 0;##
 955
 956   foreach my $cust_pkg (
 957     qsearch('cust_pkg', { 'custnum' => $self->custnum } )
 958   ) {
 959
 960     #NO!! next if $cust_pkg->cancel;
 961     next if $cust_pkg->getfield('cancel');
 962
 963     #? to avoid use of uninitialized value errors... ?
 964     $cust_pkg->setfield('bill', '')
 965       unless defined($cust_pkg->bill);
 966
 967     my $part_pkg = $cust_pkg->part_pkg;
 968
 969     #so we don't modify cust_pkg record unnecessarily
 970     my $cust_pkg_mod_flag = 0;
 971     my %hash = $cust_pkg->hash;
 972     my $old_cust_pkg = new FS::cust_pkg \%hash;
 973
 974     # bill setup
 975     my $setup = 0;
 976     unless ( $cust_pkg->setup ) {
 977       my $setup_prog = $part_pkg->getfield('setup');
 978       $setup_prog =~ /^(.*)$/ or do {
 979         $dbh->rollback if $oldAutoCommit;
 980         return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
 981                ": $setup_prog";
 982       };
 983       $setup_prog = $1;
 984       $setup_prog = '0' if $setup_prog =~ /^\s*$/;
 985
 986         #my $cpt = new Safe;
 987         ##$cpt->permit(); #what is necessary?
 988         #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
 989         #$setup = $cpt->reval($setup_prog);
 990       $setup = eval $setup_prog;
 991       unless ( defined($setup) ) {
 992         $dbh->rollback if $oldAutoCommit;
 993         return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
 994                "(expression $setup_prog): $@";
 995       }
 996       $cust_pkg->setfield('setup',$time);
 997       $cust_pkg_mod_flag=1;
 998     }
 999
1000     #bill recurring fee
1001     my $recur = 0;
1002     my $sdate;
1003     if ( $part_pkg->getfield('freq') > 0 &&
1004          ! $cust_pkg->getfield('susp') &&
1005          ( $cust_pkg->getfield('bill') || 0 ) <= $time
1006     ) {
1007       my $recur_prog = $part_pkg->getfield('recur');
1008       $recur_prog =~ /^(.*)$/ or do {
1009         $dbh->rollback if $oldAutoCommit;
1010         return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1011                ": $recur_prog";
1012       };
1013       $recur_prog = $1;
1014       $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1015
1016       # shared with $recur_prog
1017       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1018
1019         #my $cpt = new Safe;
1020         ##$cpt->permit(); #what is necessary?
1021         #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1022         #$recur = $cpt->reval($recur_prog);
1023       $recur = eval $recur_prog;
1024       unless ( defined($recur) ) {
1025         $dbh->rollback if $oldAutoCommit;
1026         return "Error eval-ing part_pkg->recur pkgpart ".  $part_pkg->pkgpart.
1027                "(expression $recur_prog): $@";
1028       }
1029       #change this bit to use Date::Manip? CAREFUL with timezones (see
1030       # mailing list archive)
1031       my ($sec,$min,$hour,$mday,$mon,$year) =
1032         (localtime($sdate) )[0,1,2,3,4,5];
1033
1034       #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1035       # only for figuring next bill date, nothing else, so, reset $sdate again
1036       # here
1037       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1038       $cust_pkg->last_bill($sdate)
1039         if $cust_pkg->dbdef_table->column('last_bill');
1040
1041       $mon += $part_pkg->freq;
1042       until ( $mon < 12 ) { $mon -= 12; $year++; }
1043       $cust_pkg->setfield('bill',
1044         timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1045       $cust_pkg_mod_flag = 1;
1046     }
1047
1048     warn "\$setup is undefined" unless defined($setup);
1049     warn "\$recur is undefined" unless defined($recur);
1050     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1051
1052     my $taxable_charged = 0;
1053     if ( $cust_pkg_mod_flag ) {
1054       $error=$cust_pkg->replace($old_cust_pkg);
1055       if ( $error ) { #just in case
1056         $dbh->rollback if $oldAutoCommit;
1057         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1058       }
1059       $setup = sprintf( "%.2f", $setup );
1060       $recur = sprintf( "%.2f", $recur );
1061       if ( $setup < 0 ) {
1062         $dbh->rollback if $oldAutoCommit;
1063         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1064       }
1065       if ( $recur < 0 ) {
1066         $dbh->rollback if $oldAutoCommit;
1067         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1068       }
1069       if ( $setup > 0 || $recur > 0 ) {
1070         my $cust_bill_pkg = new FS::cust_bill_pkg ({
1071           'pkgnum' => $cust_pkg->pkgnum,
1072           'setup'  => $setup,
1073           'recur'  => $recur,
1074           'sdate'  => $sdate,
1075           'edate'  => $cust_pkg->bill,
1076         });
1077         push @cust_bill_pkg, $cust_bill_pkg;
1078         $total_setup += $setup;
1079         $total_recur += $recur;
1080         $taxable_charged += $setup
1081           unless $part_pkg->setuptax =~ /^Y$/i;
1082         $taxable_charged += $recur
1083           unless $part_pkg->recurtax =~ /^Y$/i;
1084
1085         unless ( $self->tax =~ /Y/i
1086                  || $self->payby eq 'COMP'
1087                  || $taxable_charged == 0 ) {
1088
1089           my $cust_main_county = qsearchs('cust_main_county',{
1090               'state'    => $self->state,
1091               'county'   => $self->county,
1092               'country'  => $self->country,
1093               'taxclass' => $part_pkg->taxclass,
1094           } );
1095           $cust_main_county ||= qsearchs('cust_main_county',{
1096               'state'    => $self->state,
1097               'county'   => $self->county,
1098               'country'  => $self->country,
1099               'taxclass' => '',
1100           } );
1101           unless ( $cust_main_county ) {
1102             $dbh->rollback if $oldAutoCommit;
1103             return
1104               "fatal: can't find tax rate for state/county/country/taxclass ".
1105               join('/', ( map $self->$_(), qw(state county country) ),
1106                         $part_pkg->taxclass ).  "\n";
1107           }
1108
1109           if ( $cust_main_county->exempt_amount ) {
1110             my ($mon,$year) = (localtime($sdate) )[4,5];
1111             $mon++;
1112             my $freq = $part_pkg->freq || 1;
1113             my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1114             foreach my $which_month ( 1 .. $freq ) {
1115               my %hash = (
1116                 'custnum' => $self->custnum,
1117                 'taxnum'  => $cust_main_county->taxnum,
1118                 'year'    => 1900+$year,
1119                 'month'   => $mon++,
1120               );
1121               #until ( $mon < 12 ) { $mon -= 12; $year++; }
1122               until ( $mon < 13 ) { $mon -= 12; $year++; }
1123               my $cust_tax_exempt =
1124                 qsearchs('cust_tax_exempt', \%hash)
1125                 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1126               my $remaining_exemption = sprintf("%.2f",
1127                 $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
1128               if ( $remaining_exemption > 0 ) {
1129                 my $addl = $remaining_exemption > $taxable_per_month
1130                   ? $taxable_per_month
1131                   : $remaining_exemption;
1132                 $taxable_charged -= $addl;
1133                 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1134                   $cust_tax_exempt->hash,
1135                   'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1136                 } );
1137                 $error = $new_cust_tax_exempt->exemptnum
1138                   ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1139                   : $new_cust_tax_exempt->insert;
1140                 if ( $error ) {
1141                   $dbh->rollback if $oldAutoCommit;
1142                   return "fatal: can't update cust_tax_exempt: $error";
1143                 }
1144
1145               } # if $remaining_exemption > 0
1146
1147             } #foreach $which_month
1148
1149           } #if $cust_main_county->exempt_amount
1150
1151           $taxable_charged = sprintf( "%.2f", $taxable_charged);
1152           $tax += $taxable_charged * $cust_main_county->tax / 100
1153
1154         } #unless $self->tax =~ /Y/i
1155           #       || $self->payby eq 'COMP'
1156           #       || $taxable_charged == 0
1157
1158       } #if $setup > 0 || $recur > 0
1159
1160     } #if $cust_pkg_mod_flag
1161
1162   } #foreach my $cust_pkg
1163
1164   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1165 #  my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1166
1167   unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1168     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1169     return '';
1170   }
1171
1172 #  unless ( $self->tax =~ /Y/i
1173 #           || $self->payby eq 'COMP'
1174 #           || $taxable_charged == 0 ) {
1175 #    my $cust_main_county = qsearchs('cust_main_county',{
1176 #        'state'   => $self->state,
1177 #        'county'  => $self->county,
1178 #        'country' => $self->country,
1179 #    } ) or die "fatal: can't find tax rate for state/county/country ".
1180 #               $self->state. "/". $self->county. "/". $self->country. "\n";
1181 #    my $tax = sprintf( "%.2f",
1182 #      $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1183 #    );
1184
1185   $tax = sprintf("%.2f", $tax);
1186   if ( $tax > 0 ) {
1187     $charged = sprintf( "%.2f", $charged+$tax );
1188
1189     my $cust_bill_pkg = new FS::cust_bill_pkg ({
1190       'pkgnum' => 0,
1191       'setup'  => $tax,
1192       'recur'  => 0,
1193       'sdate'  => '',
1194       'edate'  => '',
1195     });
1196     push @cust_bill_pkg, $cust_bill_pkg;
1197   }
1198 #  }
1199
1200   my $cust_bill = new FS::cust_bill ( {
1201     'custnum' => $self->custnum,
1202     '_date'   => $time,
1203     'charged' => $charged,
1204   } );
1205   $error = $cust_bill->insert;
1206   if ( $error ) {
1207     $dbh->rollback if $oldAutoCommit;
1208     return "can't create invoice for customer #". $self->custnum. ": $error";
1209   }
1210
1211   my $invnum = $cust_bill->invnum;
1212   my $cust_bill_pkg;
1213   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1214     #warn $invnum;
1215     $cust_bill_pkg->invnum($invnum);
1216     $error = $cust_bill_pkg->insert;
1217     if ( $error ) {
1218       $dbh->rollback if $oldAutoCommit;
1219       return "can't create invoice line item for customer #". $self->custnum.
1220              ": $error";
1221     }
1222   }
1223
1224   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1225   ''; #no error
1226 }
1227
1228 =item reexport
1229
1230 document me.  Re-schedules all exports by calling the B<reexport> method
1231 of all associated packages (see L<FS::cust_pkg>).  If there is an error,
1232 returns the error; otherwise returns false.
1233
1234 =cut
1235
1236 sub reexport {
1237   my $self = shift;
1238
1239   local $SIG{HUP} = 'IGNORE';
1240   local $SIG{INT} = 'IGNORE';
1241   local $SIG{QUIT} = 'IGNORE';
1242   local $SIG{TERM} = 'IGNORE';
1243   local $SIG{TSTP} = 'IGNORE';
1244   local $SIG{PIPE} = 'IGNORE';
1245
1246   my $oldAutoCommit = $FS::UID::AutoCommit;
1247   local $FS::UID::AutoCommit = 0;
1248   my $dbh = dbh;
1249
1250   foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1251     my $error = $cust_pkg->reexport;
1252     if ( $error ) {
1253       $dbh->rollback if $oldAutoCommit;
1254       return $error;
1255     }
1256   }
1257
1258   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1259   '';
1260
1261 }
1262
1263 =item collect OPTIONS
1264
1265 (Attempt to) collect money for this customer's outstanding invoices (see
1266 L<FS::cust_bill>).  Usually used after the bill method.
1267
1268 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1269 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1270
1271 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1272 and the invoice events web interface.
1273
1274 If there is an error, returns the error, otherwise returns false.
1275
1276 Options are passed as name-value pairs.
1277
1278 Currently available options are:
1279
1280 invoice_time - Use this time when deciding when to print invoices and
1281 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>
1282 for conversion functions.
1283
1284 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1285 events.
1286
1287 retry_card - Deprecated alias for 'retry'
1288
1289 batch_card - This option is deprecated.  See the invoice events web interface
1290 to control whether cards are batched or run against a realtime gateway.
1291
1292 report_badcard - This option is deprecated.
1293
1294 force_print - This option is deprecated; see the invoice events web interface.
1295
1296 quiet - set true to surpress email card/ACH decline notices.
1297
1298 =cut
1299
1300 sub collect {
1301   my( $self, %options ) = @_;
1302   my $invoice_time = $options{'invoice_time'} || time;
1303
1304   #put below somehow?
1305   local $SIG{HUP} = 'IGNORE';
1306   local $SIG{INT} = 'IGNORE';
1307   local $SIG{QUIT} = 'IGNORE';
1308   local $SIG{TERM} = 'IGNORE';
1309   local $SIG{TSTP} = 'IGNORE';
1310   local $SIG{PIPE} = 'IGNORE';
1311
1312   my $oldAutoCommit = $FS::UID::AutoCommit;
1313   local $FS::UID::AutoCommit = 0;
1314   my $dbh = dbh;
1315
1316   my $balance = $self->balance;
1317   warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1318   unless ( $balance > 0 ) { #redundant?????
1319     $dbh->rollback if $oldAutoCommit; #hmm
1320     return '';
1321   }
1322
1323   if ( exists($options{'retry_card'}) ) {
1324     carp 'retry_card option passed to collect is deprecated; use retry';
1325     $options{'retry'} ||= $options{'retry_card'};
1326   }
1327   if ( exists($options{'retry'}) && $options{'retry'} ) {
1328     my $error = $self->retry_realtime;
1329     if ( $error ) {
1330       $dbh->rollback if $oldAutoCommit;
1331       return $error;
1332     }
1333   }
1334
1335   foreach my $cust_bill ( $self->cust_bill ) {
1336
1337     #this has to be before next's
1338     my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1339                                   ? $balance
1340                                   : $cust_bill->owed
1341     );
1342     $balance = sprintf( "%.2f", $balance - $amount );
1343
1344     next unless $cust_bill->owed > 0;
1345
1346     # don't try to charge for the same invoice if it's already in a batch
1347     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1348
1349     warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1350
1351     next unless $amount > 0;
1352
1353
1354     foreach my $part_bill_event (
1355       sort {    $a->seconds   <=> $b->seconds
1356              || $a->weight    <=> $b->weight
1357              || $a->eventpart <=> $b->eventpart }
1358         grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1359                && ! qsearchs( 'cust_bill_event', {
1360                                 'invnum'    => $cust_bill->invnum,
1361                                 'eventpart' => $_->eventpart,
1362                                 'status'    => 'done',
1363                                                                    } )
1364              }
1365           qsearch('part_bill_event', { 'payby'    => $self->payby,
1366                                        'disabled' => '',           } )
1367     ) {
1368
1369       last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1370
1371       warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1372         if $Debug;
1373       my $cust_main = $self; #for callback
1374
1375       my $error;
1376       {
1377         #supress "used only once" warning
1378         $FS::cust_bill::realtime_bop_decline_quiet += 0;
1379         local $FS::cust_bill::realtime_bop_decline_quiet = 1
1380           if $options{'quiet'};
1381         $error = eval $part_bill_event->eventcode;
1382       }
1383
1384       my $status = '';
1385       my $statustext = '';
1386       if ( $@ ) {
1387         $status = 'failed';
1388         $statustext = $@;
1389       } elsif ( $error ) {
1390         $status = 'done';
1391         $statustext = $error;
1392       } else {
1393         $status = 'done'
1394       }
1395
1396       #add cust_bill_event
1397       my $cust_bill_event = new FS::cust_bill_event {
1398         'invnum'     => $cust_bill->invnum,
1399         'eventpart'  => $part_bill_event->eventpart,
1400         #'_date'      => $invoice_time,
1401         '_date'      => time,
1402         'status'     => $status,
1403         'statustext' => $statustext,
1404       };
1405       $error = $cust_bill_event->insert;
1406       if ( $error ) {
1407         #$dbh->rollback if $oldAutoCommit;
1408         #return "error: $error";
1409
1410         # gah, even with transactions.
1411         $dbh->commit if $oldAutoCommit; #well.
1412         my $e = 'WARNING: Event run but database not updated - '.
1413                 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1414                 ', eventpart '. $part_bill_event->eventpart.
1415                 ": $error";
1416         warn $e;
1417         return $e;
1418       }
1419
1420
1421     }
1422
1423   }
1424
1425   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1426   '';
1427
1428 }
1429
1430 =item retry_realtime
1431
1432 Schedules realtime credit card / electronic check / LEC billing events for
1433 for retry.  Useful if card information has changed or manual retry is desired.
1434 The 'collect' method must be called to actually retry the transaction.
1435
1436 Implementation details: For each of this customer's open invoices, changes
1437 the status of the first "done" (with statustext error) realtime processing
1438 event to "failed".
1439
1440 =cut
1441
1442 sub retry_realtime {
1443   my $self = shift;
1444
1445   local $SIG{HUP} = 'IGNORE';
1446   local $SIG{INT} = 'IGNORE';
1447   local $SIG{QUIT} = 'IGNORE';
1448   local $SIG{TERM} = 'IGNORE';
1449   local $SIG{TSTP} = 'IGNORE';
1450   local $SIG{PIPE} = 'IGNORE';
1451
1452   my $oldAutoCommit = $FS::UID::AutoCommit;
1453   local $FS::UID::AutoCommit = 0;
1454   my $dbh = dbh;
1455
1456   foreach my $cust_bill (
1457     grep { $_->cust_bill_event }
1458       $self->open_cust_bill
1459   ) {
1460     my @cust_bill_event =
1461       sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1462         grep {
1463                #$_->part_bill_event->plan eq 'realtime-card'
1464                $_->part_bill_event->eventcode =~
1465                    /\$cust_bill\->realtime_(card|ach|lec)/
1466                  && $_->status eq 'done'
1467                  && $_->statustext
1468              }
1469           $cust_bill->cust_bill_event;
1470     next unless @cust_bill_event;
1471     my $error = $cust_bill_event[0]->retry;
1472     if ( $error ) {
1473       $dbh->rollback if $oldAutoCommit;
1474       return "error scheduling invoice event for retry: $error";
1475     }
1476
1477   }
1478
1479   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1480   '';
1481
1482 }
1483
1484 =item total_owed
1485
1486 Returns the total owed for this customer on all invoices
1487 (see L<FS::cust_bill/owed>).
1488
1489 =cut
1490
1491 sub total_owed {
1492   my $self = shift;
1493   $self->total_owed_date(2145859200); #12/31/2037
1494 }
1495
1496 =item total_owed_date TIME
1497
1498 Returns the total owed for this customer on all invoices with date earlier than
1499 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
1500 see L<Time::Local> and L<Date::Parse> for conversion functions.
1501
1502 =cut
1503
1504 sub total_owed_date {
1505   my $self = shift;
1506   my $time = shift;
1507   my $total_bill = 0;
1508   foreach my $cust_bill (
1509     grep { $_->_date <= $time }
1510       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1511   ) {
1512     $total_bill += $cust_bill->owed;
1513   }
1514   sprintf( "%.2f", $total_bill );
1515 }
1516
1517 =item apply_credits
1518
1519 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1520 to outstanding invoice balances in chronological order and returns the value
1521 of any remaining unapplied credits available for refund
1522 (see L<FS::cust_refund>).
1523
1524 =cut
1525
1526 sub apply_credits {
1527   my $self = shift;
1528
1529   return 0 unless $self->total_credited;
1530
1531   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1532       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1533
1534   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1535       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1536
1537   my $credit;
1538
1539   foreach my $cust_bill ( @invoices ) {
1540     my $amount;
1541
1542     if ( !defined($credit) || $credit->credited == 0) {
1543       $credit = pop @credits or last;
1544     }
1545
1546     if ($cust_bill->owed >= $credit->credited) {
1547       $amount=$credit->credited;
1548     }else{
1549       $amount=$cust_bill->owed;
1550     }
1551
1552     my $cust_credit_bill = new FS::cust_credit_bill ( {
1553       'crednum' => $credit->crednum,
1554       'invnum'  => $cust_bill->invnum,
1555       'amount'  => $amount,
1556     } );
1557     my $error = $cust_credit_bill->insert;
1558     die $error if $error;
1559
1560     redo if ($cust_bill->owed > 0);
1561
1562   }
1563
1564   return $self->total_credited;
1565 }
1566
1567 =item apply_payments
1568
1569 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1570 to outstanding invoice balances in chronological order.
1571
1572  #and returns the value of any remaining unapplied payments.
1573
1574 =cut
1575
1576 sub apply_payments {
1577   my $self = shift;
1578
1579   #return 0 unless
1580
1581   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1582       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1583
1584   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1585       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1586
1587   my $payment;
1588
1589   foreach my $cust_bill ( @invoices ) {
1590     my $amount;
1591
1592     if ( !defined($payment) || $payment->unapplied == 0 ) {
1593       $payment = pop @payments or last;
1594     }
1595
1596     if ( $cust_bill->owed >= $payment->unapplied ) {
1597       $amount = $payment->unapplied;
1598     } else {
1599       $amount = $cust_bill->owed;
1600     }
1601
1602     my $cust_bill_pay = new FS::cust_bill_pay ( {
1603       'paynum' => $payment->paynum,
1604       'invnum' => $cust_bill->invnum,
1605       'amount' => $amount,
1606     } );
1607     my $error = $cust_bill_pay->insert;
1608     die $error if $error;
1609
1610     redo if ( $cust_bill->owed > 0);
1611
1612   }
1613
1614   return $self->total_unapplied_payments;
1615 }
1616
1617 =item total_credited
1618
1619 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1620 customer.  See L<FS::cust_credit/credited>.
1621
1622 =cut
1623
1624 sub total_credited {
1625   my $self = shift;
1626   my $total_credit = 0;
1627   foreach my $cust_credit ( qsearch('cust_credit', {
1628     'custnum' => $self->custnum,
1629   } ) ) {
1630     $total_credit += $cust_credit->credited;
1631   }
1632   sprintf( "%.2f", $total_credit );
1633 }
1634
1635 =item total_unapplied_payments
1636
1637 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1638 See L<FS::cust_pay/unapplied>.
1639
1640 =cut
1641
1642 sub total_unapplied_payments {
1643   my $self = shift;
1644   my $total_unapplied = 0;
1645   foreach my $cust_pay ( qsearch('cust_pay', {
1646     'custnum' => $self->custnum,
1647   } ) ) {
1648     $total_unapplied += $cust_pay->unapplied;
1649   }
1650   sprintf( "%.2f", $total_unapplied );
1651 }
1652
1653 =item balance
1654
1655 Returns the balance for this customer (total_owed minus total_credited
1656 minus total_unapplied_payments).
1657
1658 =cut
1659
1660 sub balance {
1661   my $self = shift;
1662   sprintf( "%.2f",
1663     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1664   );
1665 }
1666
1667 =item balance_date TIME
1668
1669 Returns the balance for this customer, only considering invoices with date
1670 earlier than TIME (total_owed_date minus total_credited minus
1671 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
1672 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
1673 functions.
1674
1675 =cut
1676
1677 sub balance_date {
1678   my $self = shift;
1679   my $time = shift;
1680   sprintf( "%.2f",
1681     $self->total_owed_date($time)
1682       - $self->total_credited
1683       - $self->total_unapplied_payments
1684   );
1685 }
1686
1687 =item invoicing_list [ ARRAYREF ]
1688
1689 If an arguement is given, sets these email addresses as invoice recipients
1690 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
1691 (except as warnings), so use check_invoicing_list first.
1692
1693 Returns a list of email addresses (with svcnum entries expanded).
1694
1695 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
1696 check it without disturbing anything by passing nothing.
1697
1698 This interface may change in the future.
1699
1700 =cut
1701
1702 sub invoicing_list {
1703   my( $self, $arrayref ) = @_;
1704   if ( $arrayref ) {
1705     my @cust_main_invoice;
1706     if ( $self->custnum ) {
1707       @cust_main_invoice =
1708         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1709     } else {
1710       @cust_main_invoice = ();
1711     }
1712     foreach my $cust_main_invoice ( @cust_main_invoice ) {
1713       #warn $cust_main_invoice->destnum;
1714       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1715         #warn $cust_main_invoice->destnum;
1716         my $error = $cust_main_invoice->delete;
1717         warn $error if $error;
1718       }
1719     }
1720     if ( $self->custnum ) {
1721       @cust_main_invoice =
1722         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1723     } else {
1724       @cust_main_invoice = ();
1725     }
1726     my %seen = map { $_->address => 1 } @cust_main_invoice;
1727     foreach my $address ( @{$arrayref} ) {
1728       next if exists $seen{$address} && $seen{$address};
1729       $seen{$address} = 1;
1730       my $cust_main_invoice = new FS::cust_main_invoice ( {
1731         'custnum' => $self->custnum,
1732         'dest'    => $address,
1733       } );
1734       my $error = $cust_main_invoice->insert;
1735       warn $error if $error;
1736     }
1737   }
1738   if ( $self->custnum ) {
1739     map { $_->address }
1740       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1741   } else {
1742     ();
1743   }
1744 }
1745
1746 =item check_invoicing_list ARRAYREF
1747
1748 Checks these arguements as valid input for the invoicing_list method.  If there
1749 is an error, returns the error, otherwise returns false.
1750
1751 =cut
1752
1753 sub check_invoicing_list {
1754   my( $self, $arrayref ) = @_;
1755   foreach my $address ( @{$arrayref} ) {
1756     my $cust_main_invoice = new FS::cust_main_invoice ( {
1757       'custnum' => $self->custnum,
1758       'dest'    => $address,
1759     } );
1760     my $error = $self->custnum
1761                 ? $cust_main_invoice->check
1762                 : $cust_main_invoice->checkdest
1763     ;
1764     return $error if $error;
1765   }
1766   '';
1767 }
1768
1769 =item set_default_invoicing_list
1770
1771 Sets the invoicing list to all accounts associated with this customer,
1772 overwriting any previous invoicing list.
1773
1774 =cut
1775
1776 sub set_default_invoicing_list {
1777   my $self = shift;
1778   $self->invoicing_list($self->all_emails);
1779 }
1780
1781 =item all_emails
1782
1783 Returns the email addresses of all accounts provisioned for this customer.
1784
1785 =cut
1786
1787 sub all_emails {
1788   my $self = shift;
1789   my %list;
1790   foreach my $cust_pkg ( $self->all_pkgs ) {
1791     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1792     my @svc_acct =
1793       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1794         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1795           @cust_svc;
1796     $list{$_}=1 foreach map { $_->email } @svc_acct;
1797   }
1798   keys %list;
1799 }
1800
1801 =item invoicing_list_addpost
1802
1803 Adds postal invoicing to this customer.  If this customer is already configured
1804 to receive postal invoices, does nothing.
1805
1806 =cut
1807
1808 sub invoicing_list_addpost {
1809   my $self = shift;
1810   return if grep { $_ eq 'POST' } $self->invoicing_list;
1811   my @invoicing_list = $self->invoicing_list;
1812   push @invoicing_list, 'POST';
1813   $self->invoicing_list(\@invoicing_list);
1814 }
1815
1816 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1817
1818 Returns an array of customers referred by this customer (referral_custnum set
1819 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
1820 customers referred by customers referred by this customer and so on, inclusive.
1821 The default behavior is DEPTH 1 (no recursion).
1822
1823 =cut
1824
1825 sub referral_cust_main {
1826   my $self = shift;
1827   my $depth = @_ ? shift : 1;
1828   my $exclude = @_ ? shift : {};
1829
1830   my @cust_main =
1831     map { $exclude->{$_->custnum}++; $_; }
1832       grep { ! $exclude->{ $_->custnum } }
1833         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1834
1835   if ( $depth > 1 ) {
1836     push @cust_main,
1837       map { $_->referral_cust_main($depth-1, $exclude) }
1838         @cust_main;
1839   }
1840
1841   @cust_main;
1842 }
1843
1844 =item referral_cust_main_ncancelled
1845
1846 Same as referral_cust_main, except only returns customers with uncancelled
1847 packages.
1848
1849 =cut
1850
1851 sub referral_cust_main_ncancelled {
1852   my $self = shift;
1853   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1854 }
1855
1856 =item referral_cust_pkg [ DEPTH ]
1857
1858 Like referral_cust_main, except returns a flat list of all unsuspended (and
1859 uncancelled) packages for each customer.  The number of items in this list may
1860 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1861
1862 =cut
1863
1864 sub referral_cust_pkg {
1865   my $self = shift;
1866   my $depth = @_ ? shift : 1;
1867
1868   map { $_->unsuspended_pkgs }
1869     grep { $_->unsuspended_pkgs }
1870       $self->referral_cust_main($depth);
1871 }
1872
1873 =item credit AMOUNT, REASON
1874
1875 Applies a credit to this customer.  If there is an error, returns the error,
1876 otherwise returns false.
1877
1878 =cut
1879
1880 sub credit {
1881   my( $self, $amount, $reason ) = @_;
1882   my $cust_credit = new FS::cust_credit {
1883     'custnum' => $self->custnum,
1884     'amount'  => $amount,
1885     'reason'  => $reason,
1886   };
1887   $cust_credit->insert;
1888 }
1889
1890 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
1891
1892 Creates a one-time charge for this customer.  If there is an error, returns
1893 the error, otherwise returns false.
1894
1895 =cut
1896
1897 sub charge {
1898   my ( $self, $amount ) = ( shift, shift );
1899   my $pkg      = @_ ? shift : 'One-time charge';
1900   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
1901   my $taxclass = @_ ? shift : '';
1902
1903   local $SIG{HUP} = 'IGNORE';
1904   local $SIG{INT} = 'IGNORE';
1905   local $SIG{QUIT} = 'IGNORE';
1906   local $SIG{TERM} = 'IGNORE';
1907   local $SIG{TSTP} = 'IGNORE';
1908   local $SIG{PIPE} = 'IGNORE';
1909
1910   my $oldAutoCommit = $FS::UID::AutoCommit;
1911   local $FS::UID::AutoCommit = 0;
1912   my $dbh = dbh;
1913
1914   my $part_pkg = new FS::part_pkg ( {
1915     'pkg'      => $pkg,
1916     'comment'  => $comment,
1917     'setup'    => $amount,
1918     'freq'     => 0,
1919     'recur'    => '0',
1920     'disabled' => 'Y',
1921     'taxclass' => $taxclass,
1922   } );
1923
1924   my $error = $part_pkg->insert;
1925   if ( $error ) {
1926     $dbh->rollback if $oldAutoCommit;
1927     return $error;
1928   }
1929
1930   my $pkgpart = $part_pkg->pkgpart;
1931   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
1932   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
1933     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
1934     $error = $type_pkgs->insert;
1935     if ( $error ) {
1936       $dbh->rollback if $oldAutoCommit;
1937       return $error;
1938     }
1939   }
1940
1941   my $cust_pkg = new FS::cust_pkg ( {
1942     'custnum' => $self->custnum,
1943     'pkgpart' => $pkgpart,
1944   } );
1945
1946   $error = $cust_pkg->insert;
1947   if ( $error ) {
1948     $dbh->rollback if $oldAutoCommit;
1949     return $error;
1950   }
1951
1952   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1953   '';
1954
1955 }
1956
1957 =item cust_bill
1958
1959 Returns all the invoices (see L<FS::cust_bill>) for this customer.
1960
1961 =cut
1962
1963 sub cust_bill {
1964   my $self = shift;
1965   sort { $a->_date <=> $b->_date }
1966     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1967 }
1968
1969 =item open_cust_bill
1970
1971 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
1972 customer.
1973
1974 =cut
1975
1976 sub open_cust_bill {
1977   my $self = shift;
1978   grep { $_->owed > 0 } $self->cust_bill;
1979 }
1980
1981 =back
1982
1983 =head1 SUBROUTINES
1984
1985 =over 4
1986
1987 =item check_and_rebuild_fuzzyfiles
1988
1989 =cut
1990
1991 sub check_and_rebuild_fuzzyfiles {
1992   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1993   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1994     or &rebuild_fuzzyfiles;
1995 }
1996
1997 =item rebuild_fuzzyfiles
1998
1999 =cut
2000
2001 sub rebuild_fuzzyfiles {
2002
2003   use Fcntl qw(:flock);
2004
2005   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2006
2007   #last
2008
2009   open(LASTLOCK,">>$dir/cust_main.last")
2010     or die "can't open $dir/cust_main.last: $!";
2011   flock(LASTLOCK,LOCK_EX)
2012     or die "can't lock $dir/cust_main.last: $!";
2013
2014   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2015   push @all_last,
2016                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2017     if defined dbdef->table('cust_main')->column('ship_last');
2018
2019   open (LASTCACHE,">$dir/cust_main.last.tmp")
2020     or die "can't open $dir/cust_main.last.tmp: $!";
2021   print LASTCACHE join("\n", @all_last), "\n";
2022   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2023
2024   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2025   close LASTLOCK;
2026
2027   #company
2028
2029   open(COMPANYLOCK,">>$dir/cust_main.company")
2030     or die "can't open $dir/cust_main.company: $!";
2031   flock(COMPANYLOCK,LOCK_EX)
2032     or die "can't lock $dir/cust_main.company: $!";
2033
2034   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2035   push @all_company,
2036        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2037     if defined dbdef->table('cust_main')->column('ship_last');
2038
2039   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2040     or die "can't open $dir/cust_main.company.tmp: $!";
2041   print COMPANYCACHE join("\n", @all_company), "\n";
2042   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2043
2044   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2045   close COMPANYLOCK;
2046
2047 }
2048
2049 =item all_last
2050
2051 =cut
2052
2053 sub all_last {
2054   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2055   open(LASTCACHE,"<$dir/cust_main.last")
2056     or die "can't open $dir/cust_main.last: $!";
2057   my @array = map { chomp; $_; } <LASTCACHE>;
2058   close LASTCACHE;
2059   \@array;
2060 }
2061
2062 =item all_company
2063
2064 =cut
2065
2066 sub all_company {
2067   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2068   open(COMPANYCACHE,"<$dir/cust_main.company")
2069     or die "can't open $dir/cust_main.last: $!";
2070   my @array = map { chomp; $_; } <COMPANYCACHE>;
2071   close COMPANYCACHE;
2072   \@array;
2073 }
2074
2075 =item append_fuzzyfiles LASTNAME COMPANY
2076
2077 =cut
2078
2079 sub append_fuzzyfiles {
2080   my( $last, $company ) = @_;
2081
2082   &check_and_rebuild_fuzzyfiles;
2083
2084   use Fcntl qw(:flock);
2085
2086   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2087
2088   if ( $last ) {
2089
2090     open(LAST,">>$dir/cust_main.last")
2091       or die "can't open $dir/cust_main.last: $!";
2092     flock(LAST,LOCK_EX)
2093       or die "can't lock $dir/cust_main.last: $!";
2094
2095     print LAST "$last\n";
2096
2097     flock(LAST,LOCK_UN)
2098       or die "can't unlock $dir/cust_main.last: $!";
2099     close LAST;
2100   }
2101
2102   if ( $company ) {
2103
2104     open(COMPANY,">>$dir/cust_main.company")
2105       or die "can't open $dir/cust_main.company: $!";
2106     flock(COMPANY,LOCK_EX)
2107       or die "can't lock $dir/cust_main.company: $!";
2108
2109     print COMPANY "$company\n";
2110
2111     flock(COMPANY,LOCK_UN)
2112       or die "can't unlock $dir/cust_main.company: $!";
2113
2114     close COMPANY;
2115   }
2116
2117   1;
2118 }
2119
2120 =item batch_import
2121
2122 =cut
2123
2124 sub batch_import {
2125   my $param = shift;
2126   #warn join('-',keys %$param);
2127   my $fh = $param->{filehandle};
2128   my $agentnum = $param->{agentnum};
2129   my $refnum = $param->{refnum};
2130   my $pkgpart = $param->{pkgpart};
2131   my @fields = @{$param->{fields}};
2132
2133   eval "use Date::Parse;";
2134   die $@ if $@;
2135   eval "use Text::CSV_XS;";
2136   die $@ if $@;
2137
2138   my $csv = new Text::CSV_XS;
2139   #warn $csv;
2140   #warn $fh;
2141
2142   my $imported = 0;
2143   #my $columns;
2144
2145   local $SIG{HUP} = 'IGNORE';
2146   local $SIG{INT} = 'IGNORE';
2147   local $SIG{QUIT} = 'IGNORE';
2148   local $SIG{TERM} = 'IGNORE';
2149   local $SIG{TSTP} = 'IGNORE';
2150   local $SIG{PIPE} = 'IGNORE';
2151
2152   my $oldAutoCommit = $FS::UID::AutoCommit;
2153   local $FS::UID::AutoCommit = 0;
2154   my $dbh = dbh;
2155
2156   #while ( $columns = $csv->getline($fh) ) {
2157   my $line;
2158   while ( defined($line=<$fh>) ) {
2159
2160     $csv->parse($line) or do {
2161       $dbh->rollback if $oldAutoCommit;
2162       return "can't parse: ". $csv->error_input();
2163     };
2164
2165     my @columns = $csv->fields();
2166     #warn join('-',@columns);
2167
2168     my %cust_main = (
2169       agentnum => $agentnum,
2170       refnum   => $refnum,
2171       country  => 'US', #default
2172       payby    => 'BILL', #default
2173       paydate  => '12/2037', #default
2174     );
2175     my $billtime = time;
2176     my %cust_pkg = ( pkgpart => $pkgpart );
2177     foreach my $field ( @fields ) {
2178       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2179         #$cust_pkg{$1} = str2time( shift @$columns );
2180         if ( $1 eq 'setup' ) {
2181           $billtime = str2time(shift @columns);
2182         } else {
2183           $cust_pkg{$1} = str2time( shift @columns );
2184         }
2185       } else {
2186         #$cust_main{$field} = shift @$columns;
2187         $cust_main{$field} = shift @columns;
2188       }
2189     }
2190
2191     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2192     my $cust_main = new FS::cust_main ( \%cust_main );
2193     use Tie::RefHash;
2194     tie my %hash, 'Tie::RefHash'; #this part is important
2195     $hash{$cust_pkg} = [] if $pkgpart;
2196     my $error = $cust_main->insert( \%hash );
2197
2198     if ( $error ) {
2199       $dbh->rollback if $oldAutoCommit;
2200       return "can't insert customer for $line: $error";
2201     }
2202
2203     #false laziness w/bill.cgi
2204     $error = $cust_main->bill( 'time' => $billtime );
2205     if ( $error ) {
2206       $dbh->rollback if $oldAutoCommit;
2207       return "can't bill customer for $line: $error";
2208     }
2209
2210     $cust_main->apply_payments;
2211     $cust_main->apply_credits;
2212
2213     $error = $cust_main->collect();
2214     if ( $error ) {
2215       $dbh->rollback if $oldAutoCommit;
2216       return "can't collect customer for $line: $error";
2217     }
2218
2219     $imported++;
2220   }
2221
2222   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2223
2224   return "Empty file!" unless $imported;
2225
2226   ''; #no error
2227
2228 }
2229
2230 =item batch_charge
2231
2232 =cut
2233
2234 sub batch_charge {
2235   my $param = shift;
2236   #warn join('-',keys %$param);
2237   my $fh = $param->{filehandle};
2238   my @fields = @{$param->{fields}};
2239
2240   eval "use Date::Parse;";
2241   die $@ if $@;
2242   eval "use Text::CSV_XS;";
2243   die $@ if $@;
2244
2245   my $csv = new Text::CSV_XS;
2246   #warn $csv;
2247   #warn $fh;
2248
2249   my $imported = 0;
2250   #my $columns;
2251
2252   local $SIG{HUP} = 'IGNORE';
2253   local $SIG{INT} = 'IGNORE';
2254   local $SIG{QUIT} = 'IGNORE';
2255   local $SIG{TERM} = 'IGNORE';
2256   local $SIG{TSTP} = 'IGNORE';
2257   local $SIG{PIPE} = 'IGNORE';
2258
2259   my $oldAutoCommit = $FS::UID::AutoCommit;
2260   local $FS::UID::AutoCommit = 0;
2261   my $dbh = dbh;
2262
2263   #while ( $columns = $csv->getline($fh) ) {
2264   my $line;
2265   while ( defined($line=<$fh>) ) {
2266
2267     $csv->parse($line) or do {
2268       $dbh->rollback if $oldAutoCommit;
2269       return "can't parse: ". $csv->error_input();
2270     };
2271
2272     my @columns = $csv->fields();
2273     #warn join('-',@columns);
2274
2275     my %row = ();
2276     foreach my $field ( @fields ) {
2277       $row{$field} = shift @columns;
2278     }
2279
2280     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2281     unless ( $cust_main ) {
2282       $dbh->rollback if $oldAutoCommit;
2283       return "unknown custnum $row{'custnum'}";
2284     }
2285
2286     if ( $row{'amount'} > 0 ) {
2287       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2288       if ( $error ) {
2289         $dbh->rollback if $oldAutoCommit;
2290         return $error;
2291       }
2292       $imported++;
2293     } elsif ( $row{'amount'} < 0 ) {
2294       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2295                                       $row{'pkg'}                         );
2296       if ( $error ) {
2297         $dbh->rollback if $oldAutoCommit;
2298         return $error;
2299       }
2300       $imported++;
2301     } else {
2302       #hmm?
2303     }
2304
2305   }
2306
2307   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2308
2309   return "Empty file!" unless $imported;
2310
2311   ''; #no error
2312
2313 }
2314
2315 =back
2316
2317 =head1 BUGS
2318
2319 The delete method.
2320
2321 The delete method should possibly take an FS::cust_main object reference
2322 instead of a scalar customer number.
2323
2324 Bill and collect options should probably be passed as references instead of a
2325 list.
2326
2327 There should probably be a configuration file with a list of allowed credit
2328 card types.
2329
2330 No multiple currency support (probably a larger project than just this module).
2331
2332 =head1 SEE ALSO
2333
2334 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2335 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2336 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
2337
2338 =cut
2339
2340 1;
2341