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