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