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