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