FS/FS/cust_main.pm

   1 package FS::cust_main;
   2
   3 use strict;
   4 use vars qw( @ISA $conf $Debug $import );
   5 use vars qw( $realtime_bop_decline_quiet ); #ugh
   6 use Safe;
   7 use Carp;
   8 BEGIN {
   9   eval "use Time::Local;";
  10   die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
  11     if $] < 5.006 && !defined($Time::Local::VERSION);
  12   eval "use Time::Local qw(timelocal timelocal_nocheck);";
  13 }
  14 use Date::Format;
  15 #use Date::Manip;
  16 use Business::CreditCard;
  17 use FS::UID qw( getotaker dbh );
  18 use FS::Record qw( qsearchs qsearch dbdef );
  19 use FS::Misc qw( send_email );
  20 use FS::cust_pkg;
  21 use FS::cust_bill;
  22 use FS::cust_bill_pkg;
  23 use FS::cust_pay;
  24 use FS::cust_credit;
  25 use FS::part_referral;
  26 use FS::cust_main_county;
  27 use FS::agent;
  28 use FS::cust_main_invoice;
  29 use FS::cust_credit_bill;
  30 use FS::cust_bill_pay;
  31 use FS::prepay_credit;
  32 use FS::queue;
  33 use FS::part_pkg;
  34 use FS::part_bill_event;
  35 use FS::cust_bill_event;
  36 use FS::cust_tax_exempt;
  37 use FS::type_pkgs;
  38 use FS::Msgcat qw(gettext);
  39
  40 @ISA = qw( FS::Record );
  41
  42 $realtime_bop_decline_quiet = 0;
  43
  44 $Debug = 1;
  45 #$Debug = 1;
  46
  47 $import = 0;
  48
  49 #ask FS::UID to run this stuff for us later
  50 #$FS::UID::callback{'FS::cust_main'} = sub {
  51 install_callback FS::UID sub {
  52   $conf = new FS::Conf;
  53   #yes, need it for stuff below (prolly should be cached)
  54 };
  55
  56 sub _cache {
  57   my $self = shift;
  58   my ( $hashref, $cache ) = @_;
  59   if ( exists $hashref->{'pkgnum'} ) {
  60 #    #@{ $self->{'_pkgnum'} } = ();
  61     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
  62     $self->{'_pkgnum'} = $subcache;
  63     #push @{ $self->{'_pkgnum'} },
  64     FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
  65   }
  66 }
  67
  68 =head1 NAME
  69
  70 FS::cust_main - Object methods for cust_main records
  71
  72 =head1 SYNOPSIS
  73
  74   use FS::cust_main;
  75
  76   $record = new FS::cust_main \%hash;
  77   $record = new FS::cust_main { 'column' => 'value' };
  78
  79   $error = $record->insert;
  80
  81   $error = $new_record->replace($old_record);
  82
  83   $error = $record->delete;
  84
  85   $error = $record->check;
  86
  87   @cust_pkg = $record->all_pkgs;
  88
  89   @cust_pkg = $record->ncancelled_pkgs;
  90
  91   @cust_pkg = $record->suspended_pkgs;
  92
  93   $error = $record->bill;
  94   $error = $record->bill %options;
  95   $error = $record->bill 'time' => $time;
  96
  97   $error = $record->collect;
  98   $error = $record->collect %options;
  99   $error = $record->collect 'invoice_time'   => $time,
 100                             'batch_card'     => 'yes',
 101                             'report_badcard' => 'yes',
 102                           ;
 103
 104 =head1 DESCRIPTION
 105
 106 An FS::cust_main object represents a customer.  FS::cust_main inherits from
 107 FS::Record.  The following fields are currently supported:
 108
 109 =over 4
 110
 111 =item custnum - primary key (assigned automatically for new customers)
 112
 113 =item agentnum - agent (see L<FS::agent>)
 114
 115 =item refnum - Advertising source (see L<FS::part_referral>)
 116
 117 =item first - name
 118
 119 =item last - name
 120
 121 =item ss - social security number (optional)
 122
 123 =item company - (optional)
 124
 125 =item address1
 126
 127 =item address2 - (optional)
 128
 129 =item city
 130
 131 =item county - (optional, see L<FS::cust_main_county>)
 132
 133 =item state - (see L<FS::cust_main_county>)
 134
 135 =item zip
 136
 137 =item country - (see L<FS::cust_main_county>)
 138
 139 =item daytime - phone (optional)
 140
 141 =item night - phone (optional)
 142
 143 =item fax - phone (optional)
 144
 145 =item ship_first - name
 146
 147 =item ship_last - name
 148
 149 =item ship_company - (optional)
 150
 151 =item ship_address1
 152
 153 =item ship_address2 - (optional)
 154
 155 =item ship_city
 156
 157 =item ship_county - (optional, see L<FS::cust_main_county>)
 158
 159 =item ship_state - (see L<FS::cust_main_county>)
 160
 161 =item ship_zip
 162
 163 =item ship_country - (see L<FS::cust_main_county>)
 164
 165 =item ship_daytime - phone (optional)
 166
 167 =item ship_night - phone (optional)
 168
 169 =item ship_fax - phone (optional)
 170
 171 =item payby - I<CARD> (credit card - automatic), I<DCRD> (credit card - on-demand), I<CHEK> (electronic check - automatic), I<DCHK> (electronic check - on-demand), I<LECB> (Phone bill billing), I<BILL> (billing), I<COMP> (free), or I<PREPAY> (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to I<BILL>)
 172
 173 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
 174
 175 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 176
 177 =item payname - name on card or billing name
 178
 179 =item tax - tax exempt, empty or `Y'
 180
 181 =item otaker - order taker (assigned automatically, see L<FS::UID>)
 182
 183 =item comments - comments (optional)
 184
 185 =item referral_custnum - referring customer number
 186
 187 =back
 188
 189 =head1 METHODS
 190
 191 =over 4
 192
 193 =item new HASHREF
 194
 195 Creates a new customer.  To add the customer to the database, see L<"insert">.
 196
 197 Note that this stores the hash reference, not a distinct copy of the hash it
 198 points to.  You can ask the object for a copy with the I<hash> method.
 199
 200 =cut
 201
 202 sub table { 'cust_main'; }
 203
 204 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
 205
 206 Adds this customer to the database.  If there is an error, returns the error,
 207 otherwise returns false.
 208
 209 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
 210 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
 211 are inserted atomicly, or the transaction is rolled back.  Passing an empty
 212 hash reference is equivalent to not supplying this parameter.  There should be
 213 a better explanation of this, but until then, here's an example:
 214
 215   use Tie::RefHash;
 216   tie %hash, 'Tie::RefHash'; #this part is important
 217   %hash = (
 218     $cust_pkg => [ $svc_acct ],
 219     ...
 220   );
 221   $cust_main->insert( \%hash );
 222
 223 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 224 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 225 expected and rollback the entire transaction; it is not necessary to call
 226 check_invoicing_list first.  The invoicing_list is set after the records in the
 227 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
 228 invoicing_list destination to the newly-created svc_acct.  Here's an example:
 229
 230   $cust_main->insert( {}, [ $email, 'POST' ] );
 231
 232 Currently available options are: I<noexport>
 233
 234 If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
 235 (You can schedule them later with the B<reexport> method.)
 236
 237 =cut
 238
 239 sub insert {
 240   my $self = shift;
 241   my $cust_pkgs = @_ ? shift : {};
 242   my $invoicing_list = @_ ? shift : '';
 243   my %options = @_;
 244
 245   local $SIG{HUP} = 'IGNORE';
 246   local $SIG{INT} = 'IGNORE';
 247   local $SIG{QUIT} = 'IGNORE';
 248   local $SIG{TERM} = 'IGNORE';
 249   local $SIG{TSTP} = 'IGNORE';
 250   local $SIG{PIPE} = 'IGNORE';
 251
 252   my $oldAutoCommit = $FS::UID::AutoCommit;
 253   local $FS::UID::AutoCommit = 0;
 254   my $dbh = dbh;
 255
 256   my $amount = 0;
 257   my $seconds = 0;
 258   if ( $self->payby eq 'PREPAY' ) {
 259     $self->payby('BILL');
 260     my $prepay_credit = qsearchs(
 261       'prepay_credit',
 262       { 'identifier' => $self->payinfo },
 263       '',
 264       'FOR UPDATE'
 265     );
 266     warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
 267       unless $prepay_credit;
 268     $amount = $prepay_credit->amount;
 269     $seconds = $prepay_credit->seconds;
 270     my $error = $prepay_credit->delete;
 271     if ( $error ) {
 272       $dbh->rollback if $oldAutoCommit;
 273       return "removing prepay_credit (transaction rolled back): $error";
 274     }
 275   }
 276
 277   my $error = $self->SUPER::insert;
 278   if ( $error ) {
 279     $dbh->rollback if $oldAutoCommit;
 280     #return "inserting cust_main record (transaction rolled back): $error";
 281     return $error;
 282   }
 283
 284   # invoicing list
 285   if ( $invoicing_list ) {
 286     $error = $self->check_invoicing_list( $invoicing_list );
 287     if ( $error ) {
 288       $dbh->rollback if $oldAutoCommit;
 289       return "checking invoicing_list (transaction rolled back): $error";
 290     }
 291     $self->invoicing_list( $invoicing_list );
 292   }
 293
 294   # packages
 295   local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
 296   $error = $self->order_pkgs($cust_pkgs, \$seconds);
 297   if ( $error ) {
 298     $dbh->rollback if $oldAutoCommit;
 299     return $error;
 300   }
 301
 302   if ( $seconds ) {
 303     $dbh->rollback if $oldAutoCommit;
 304     return "No svc_acct record to apply pre-paid time";
 305   }
 306
 307   if ( $amount ) {
 308     my $cust_credit = new FS::cust_credit {
 309       'custnum' => $self->custnum,
 310       'amount'  => $amount,
 311     };
 312     $error = $cust_credit->insert;
 313     if ( $error ) {
 314       $dbh->rollback if $oldAutoCommit;
 315       return "inserting credit (transaction rolled back): $error";
 316     }
 317   }
 318
 319   $error = $self->queue_fuzzyfiles_update;
 320   if ( $error ) {
 321     $dbh->rollback if $oldAutoCommit;
 322     return "updating fuzzy search cache: $error";
 323   }
 324
 325   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 326   '';
 327
 328 }
 329
 330 =item order_pkgs
 331
 332 document me.  like ->insert(%cust_pkg) on an existing record
 333
 334 =cut
 335
 336 sub order_pkgs {
 337   my $self = shift;
 338   my $cust_pkgs = shift;
 339   my $seconds = shift;
 340
 341   local $SIG{HUP} = 'IGNORE';
 342   local $SIG{INT} = 'IGNORE';
 343   local $SIG{QUIT} = 'IGNORE';
 344   local $SIG{TERM} = 'IGNORE';
 345   local $SIG{TSTP} = 'IGNORE';
 346   local $SIG{PIPE} = 'IGNORE';
 347
 348   my $oldAutoCommit = $FS::UID::AutoCommit;
 349   local $FS::UID::AutoCommit = 0;
 350   my $dbh = dbh;
 351
 352   foreach my $cust_pkg ( keys %$cust_pkgs ) {
 353     $cust_pkg->custnum( $self->custnum );
 354     my $error = $cust_pkg->insert;
 355     if ( $error ) {
 356       $dbh->rollback if $oldAutoCommit;
 357       return "inserting cust_pkg (transaction rolled back): $error";
 358     }
 359     foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
 360       $svc_something->pkgnum( $cust_pkg->pkgnum );
 361       if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
 362         $svc_something->seconds( $svc_something->seconds + $$seconds );
 363         $$seconds = 0;
 364       }
 365       $error = $svc_something->insert;
 366       if ( $error ) {
 367         $dbh->rollback if $oldAutoCommit;
 368         #return "inserting svc_ (transaction rolled back): $error";
 369         return $error;
 370       }
 371     }
 372   }
 373
 374   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 375   ''; #no error
 376 }
 377
 378 =item reexport
 379
 380 document me.  Re-schedules all exports by calling the B<reexport> method
 381 of all associated packages (see L<FS::cust_pkg>).  If there is an error,
 382 returns the error; otherwise returns false.
 383
 384 =cut
 385
 386 sub reexport {
 387   my $self = shift;
 388
 389   local $SIG{HUP} = 'IGNORE';
 390   local $SIG{INT} = 'IGNORE';
 391   local $SIG{QUIT} = 'IGNORE';
 392   local $SIG{TERM} = 'IGNORE';
 393   local $SIG{TSTP} = 'IGNORE';
 394   local $SIG{PIPE} = 'IGNORE';
 395
 396   my $oldAutoCommit = $FS::UID::AutoCommit;
 397   local $FS::UID::AutoCommit = 0;
 398   my $dbh = dbh;
 399
 400   foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
 401     my $error = $cust_pkg->reexport;
 402     if ( $error ) {
 403       $dbh->rollback if $oldAutoCommit;
 404       return $error;
 405     }
 406   }
 407
 408   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 409   '';
 410
 411 }
 412
 413 =item delete NEW_CUSTNUM
 414
 415 This deletes the customer.  If there is an error, returns the error, otherwise
 416 returns false.
 417
 418 This will completely remove all traces of the customer record.  This is not
 419 what you want when a customer cancels service; for that, cancel all of the
 420 customer's packages (see L</cancel>).
 421
 422 If the customer has any uncancelled packages, you need to pass a new (valid)
 423 customer number for those packages to be transferred to.  Cancelled packages
 424 will be deleted.  Did I mention that this is NOT what you want when a customer
 425 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
 426
 427 You can't delete a customer with invoices (see L<FS::cust_bill>),
 428 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
 429 refunds (see L<FS::cust_refund>).
 430
 431 =cut
 432
 433 sub delete {
 434   my $self = shift;
 435
 436   local $SIG{HUP} = 'IGNORE';
 437   local $SIG{INT} = 'IGNORE';
 438   local $SIG{QUIT} = 'IGNORE';
 439   local $SIG{TERM} = 'IGNORE';
 440   local $SIG{TSTP} = 'IGNORE';
 441   local $SIG{PIPE} = 'IGNORE';
 442
 443   my $oldAutoCommit = $FS::UID::AutoCommit;
 444   local $FS::UID::AutoCommit = 0;
 445   my $dbh = dbh;
 446
 447   if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
 448     $dbh->rollback if $oldAutoCommit;
 449     return "Can't delete a customer with invoices";
 450   }
 451   if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
 452     $dbh->rollback if $oldAutoCommit;
 453     return "Can't delete a customer with credits";
 454   }
 455   if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
 456     $dbh->rollback if $oldAutoCommit;
 457     return "Can't delete a customer with payments";
 458   }
 459   if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
 460     $dbh->rollback if $oldAutoCommit;
 461     return "Can't delete a customer with refunds";
 462   }
 463
 464   my @cust_pkg = $self->ncancelled_pkgs;
 465   if ( @cust_pkg ) {
 466     my $new_custnum = shift;
 467     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
 468       $dbh->rollback if $oldAutoCommit;
 469       return "Invalid new customer number: $new_custnum";
 470     }
 471     foreach my $cust_pkg ( @cust_pkg ) {
 472       my %hash = $cust_pkg->hash;
 473       $hash{'custnum'} = $new_custnum;
 474       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
 475       my $error = $new_cust_pkg->replace($cust_pkg);
 476       if ( $error ) {
 477         $dbh->rollback if $oldAutoCommit;
 478         return $error;
 479       }
 480     }
 481   }
 482   my @cancelled_cust_pkg = $self->all_pkgs;
 483   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
 484     my $error = $cust_pkg->delete;
 485     if ( $error ) {
 486       $dbh->rollback if $oldAutoCommit;
 487       return $error;
 488     }
 489   }
 490
 491   foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
 492     qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
 493   ) {
 494     my $error = $cust_main_invoice->delete;
 495     if ( $error ) {
 496       $dbh->rollback if $oldAutoCommit;
 497       return $error;
 498     }
 499   }
 500
 501   my $error = $self->SUPER::delete;
 502   if ( $error ) {
 503     $dbh->rollback if $oldAutoCommit;
 504     return $error;
 505   }
 506
 507   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 508   '';
 509
 510 }
 511
 512 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
 513
 514 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 515 returns the error, otherwise returns false.
 516
 517 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 518 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 519 expected and rollback the entire transaction; it is not necessary to call
 520 check_invoicing_list first.  Here's an example:
 521
 522   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
 523
 524 =cut
 525
 526 sub replace {
 527   my $self = shift;
 528   my $old = shift;
 529   my @param = @_;
 530
 531   local $SIG{HUP} = 'IGNORE';
 532   local $SIG{INT} = 'IGNORE';
 533   local $SIG{QUIT} = 'IGNORE';
 534   local $SIG{TERM} = 'IGNORE';
 535   local $SIG{TSTP} = 'IGNORE';
 536   local $SIG{PIPE} = 'IGNORE';
 537
 538   if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
 539        && $conf->config('users-allow_comp')                  ) {
 540     return "You are not permitted to create complimentary accounts."
 541       unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
 542   }
 543
 544   my $oldAutoCommit = $FS::UID::AutoCommit;
 545   local $FS::UID::AutoCommit = 0;
 546   my $dbh = dbh;
 547
 548   my $error = $self->SUPER::replace($old);
 549
 550   if ( $error ) {
 551     $dbh->rollback if $oldAutoCommit;
 552     return $error;
 553   }
 554
 555   if ( @param ) { # INVOICING_LIST_ARYREF
 556     my $invoicing_list = shift @param;
 557     $error = $self->check_invoicing_list( $invoicing_list );
 558     if ( $error ) {
 559       $dbh->rollback if $oldAutoCommit;
 560       return $error;
 561     }
 562     $self->invoicing_list( $invoicing_list );
 563   }
 564
 565   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
 566        grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
 567     # card/check/lec info has changed, want to retry realtime_ invoice events
 568     my $error = $self->retry_realtime;
 569     if ( $error ) {
 570       $dbh->rollback if $oldAutoCommit;
 571       return $error;
 572     }
 573   }
 574
 575   $error = $self->queue_fuzzyfiles_update;
 576   if ( $error ) {
 577     $dbh->rollback if $oldAutoCommit;
 578     return "updating fuzzy search cache: $error";
 579   }
 580
 581   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 582   '';
 583
 584 }
 585
 586 =item queue_fuzzyfiles_update
 587
 588 Used by insert & replace to update the fuzzy search cache
 589
 590 =cut
 591
 592 sub queue_fuzzyfiles_update {
 593   my $self = shift;
 594
 595   local $SIG{HUP} = 'IGNORE';
 596   local $SIG{INT} = 'IGNORE';
 597   local $SIG{QUIT} = 'IGNORE';
 598   local $SIG{TERM} = 'IGNORE';
 599   local $SIG{TSTP} = 'IGNORE';
 600   local $SIG{PIPE} = 'IGNORE';
 601
 602   my $oldAutoCommit = $FS::UID::AutoCommit;
 603   local $FS::UID::AutoCommit = 0;
 604   my $dbh = dbh;
 605
 606   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
 607   my $error = $queue->insert($self->getfield('last'), $self->company);
 608   if ( $error ) {
 609     $dbh->rollback if $oldAutoCommit;
 610     return "queueing job (transaction rolled back): $error";
 611   }
 612
 613   if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
 614     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
 615     $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
 616     if ( $error ) {
 617       $dbh->rollback if $oldAutoCommit;
 618       return "queueing job (transaction rolled back): $error";
 619     }
 620   }
 621
 622   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 623   '';
 624
 625 }
 626
 627 =item check
 628
 629 Checks all fields to make sure this is a valid customer record.  If there is
 630 an error, returns the error, otherwise returns false.  Called by the insert
 631 and repalce methods.
 632
 633 =cut
 634
 635 sub check {
 636   my $self = shift;
 637
 638   #warn "BEFORE: \n". $self->_dump;
 639
 640   my $error =
 641     $self->ut_numbern('custnum')
 642     || $self->ut_number('agentnum')
 643     || $self->ut_number('refnum')
 644     || $self->ut_name('last')
 645     || $self->ut_name('first')
 646     || $self->ut_textn('company')
 647     || $self->ut_text('address1')
 648     || $self->ut_textn('address2')
 649     || $self->ut_text('city')
 650     || $self->ut_textn('county')
 651     || $self->ut_textn('state')
 652     || $self->ut_country('country')
 653     || $self->ut_anything('comments')
 654     || $self->ut_numbern('referral_custnum')
 655   ;
 656   #barf.  need message catalogs.  i18n.  etc.
 657   $error .= "Please select an advertising source."
 658     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
 659   return $error if $error;
 660
 661   return "Unknown agent"
 662     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
 663
 664   return "Unknown refnum"
 665     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
 666
 667   return "Unknown referring custnum ". $self->referral_custnum
 668     unless ! $self->referral_custnum
 669            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
 670
 671   if ( $self->ss eq '' ) {
 672     $self->ss('');
 673   } else {
 674     my $ss = $self->ss;
 675     $ss =~ s/\D//g;
 676     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
 677       or return "Illegal social security number: ". $self->ss;
 678     $self->ss("$1-$2-$3");
 679   }
 680
 681
 682 # bad idea to disable, causes billing to fail because of no tax rates later
 683 #  unless ( $import ) {
 684     unless ( qsearch('cust_main_county', {
 685       'country' => $self->country,
 686       'state'   => '',
 687      } ) ) {
 688       return "Unknown state/county/country: ".
 689         $self->state. "/". $self->county. "/". $self->country
 690         unless qsearch('cust_main_county',{
 691           'state'   => $self->state,
 692           'county'  => $self->county,
 693           'country' => $self->country,
 694         } );
 695     }
 696 #  }
 697
 698   $error =
 699     $self->ut_phonen('daytime', $self->country)
 700     || $self->ut_phonen('night', $self->country)
 701     || $self->ut_phonen('fax', $self->country)
 702     || $self->ut_zip('zip', $self->country)
 703   ;
 704   return $error if $error;
 705
 706   my @addfields = qw(
 707     last first company address1 address2 city county state zip
 708     country daytime night fax
 709   );
 710
 711   if ( defined $self->dbdef_table->column('ship_last') ) {
 712     if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
 713                        @addfields )
 714          && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
 715        )
 716     {
 717       my $error =
 718         $self->ut_name('ship_last')
 719         || $self->ut_name('ship_first')
 720         || $self->ut_textn('ship_company')
 721         || $self->ut_text('ship_address1')
 722         || $self->ut_textn('ship_address2')
 723         || $self->ut_text('ship_city')
 724         || $self->ut_textn('ship_county')
 725         || $self->ut_textn('ship_state')
 726         || $self->ut_country('ship_country')
 727       ;
 728       return $error if $error;
 729
 730       #false laziness with above
 731       unless ( qsearchs('cust_main_county', {
 732         'country' => $self->ship_country,
 733         'state'   => '',
 734        } ) ) {
 735         return "Unknown ship_state/ship_county/ship_country: ".
 736           $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
 737           unless qsearchs('cust_main_county',{
 738             'state'   => $self->ship_state,
 739             'county'  => $self->ship_county,
 740             'country' => $self->ship_country,
 741           } );
 742       }
 743       #eofalse
 744
 745       $error =
 746         $self->ut_phonen('ship_daytime', $self->ship_country)
 747         || $self->ut_phonen('ship_night', $self->ship_country)
 748         || $self->ut_phonen('ship_fax', $self->ship_country)
 749         || $self->ut_zip('ship_zip', $self->ship_country)
 750       ;
 751       return $error if $error;
 752
 753     } else { # ship_ info eq billing info, so don't store dup info in database
 754       $self->setfield("ship_$_", '')
 755         foreach qw( last first company address1 address2 city county state zip
 756                     country daytime night fax );
 757     }
 758   }
 759
 760   $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
 761     or return "Illegal payby: ". $self->payby;
 762   $self->payby($1);
 763
 764   if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) {
 765
 766     my $payinfo = $self->payinfo;
 767     $payinfo =~ s/\D//g;
 768     $payinfo =~ /^(\d{13,16})$/
 769       or return gettext('invalid_card'); # . ": ". $self->payinfo;
 770     $payinfo = $1;
 771     $self->payinfo($payinfo);
 772     validate($payinfo)
 773       or return gettext('invalid_card'); # . ": ". $self->payinfo;
 774     return gettext('unknown_card_type')
 775       if cardtype($self->payinfo) eq "Unknown";
 776
 777   } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) {
 778
 779     my $payinfo = $self->payinfo;
 780     $payinfo =~ s/[^\d\@]//g;
 781     $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
 782     $payinfo = "$1\@$2";
 783     $self->payinfo($payinfo);
 784
 785   } elsif ( $self->payby eq 'LECB' ) {
 786
 787     my $payinfo = $self->payinfo;
 788     $payinfo =~ s/\D//g;
 789     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
 790     $payinfo = $1;
 791     $self->payinfo($payinfo);
 792
 793   } elsif ( $self->payby eq 'BILL' ) {
 794
 795     $error = $self->ut_textn('payinfo');
 796     return "Illegal P.O. number: ". $self->payinfo if $error;
 797
 798   } elsif ( $self->payby eq 'COMP' ) {
 799
 800     if ( !$self->custnum && $conf->config('users-allow_comp') ) {
 801       return "You are not permitted to create complimentary accounts."
 802         unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
 803     }
 804
 805     $error = $self->ut_textn('payinfo');
 806     return "Illegal comp account issuer: ". $self->payinfo if $error;
 807
 808   } elsif ( $self->payby eq 'PREPAY' ) {
 809
 810     my $payinfo = $self->payinfo;
 811     $payinfo =~ s/\W//g; #anything else would just confuse things
 812     $self->payinfo($payinfo);
 813     $error = $self->ut_alpha('payinfo');
 814     return "Illegal prepayment identifier: ". $self->payinfo if $error;
 815     return "Unknown prepayment identifier"
 816       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
 817
 818   }
 819
 820   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
 821     return "Expriation date required"
 822       unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
 823     $self->paydate('');
 824   } else {
 825     my( $m, $y );
 826     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
 827       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
 828     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{2})[\/\-]\d+$/ ) {
 829       ( $m, $y ) = ( $3, "20$2" );
 830     } else {
 831       return "Illegal expiration date: ". $self->paydate;
 832     }
 833     $self->paydate("$y-$m-01");
 834     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
 835     return gettext('expired_card')
 836       if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
 837   }
 838
 839   if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
 840        ( ! $conf->exists('require_cardname')
 841          || $self->payby !~ /^(CARD|DCRD)$/  )
 842   ) {
 843     $self->payname( $self->first. " ". $self->getfield('last') );
 844   } else {
 845     $self->payname =~ /^([\w \,\.\-\']+)$/
 846       or return gettext('illegal_name'). " payname: ". $self->payname;
 847     $self->payname($1);
 848   }
 849
 850   $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
 851   $self->tax($1);
 852
 853   $self->otaker(getotaker);
 854
 855   #warn "AFTER: \n". $self->_dump;
 856
 857   $self->SUPER::check;
 858 }
 859
 860 =item all_pkgs
 861
 862 Returns all packages (see L<FS::cust_pkg>) for this customer.
 863
 864 =cut
 865
 866 sub all_pkgs {
 867   my $self = shift;
 868   if ( $self->{'_pkgnum'} ) {
 869     values %{ $self->{'_pkgnum'}->cache };
 870   } else {
 871     qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
 872   }
 873 }
 874
 875 =item ncancelled_pkgs
 876
 877 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
 878
 879 =cut
 880
 881 sub ncancelled_pkgs {
 882   my $self = shift;
 883   if ( $self->{'_pkgnum'} ) {
 884     grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
 885   } else {
 886     @{ [ # force list context
 887       qsearch( 'cust_pkg', {
 888         'custnum' => $self->custnum,
 889         'cancel'  => '',
 890       }),
 891       qsearch( 'cust_pkg', {
 892         'custnum' => $self->custnum,
 893         'cancel'  => 0,
 894       }),
 895     ] };
 896   }
 897 }
 898
 899 =item suspended_pkgs
 900
 901 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
 902
 903 =cut
 904
 905 sub suspended_pkgs {
 906   my $self = shift;
 907   grep { $_->susp } $self->ncancelled_pkgs;
 908 }
 909
 910 =item unflagged_suspended_pkgs
 911
 912 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
 913 customer (thouse packages without the `manual_flag' set).
 914
 915 =cut
 916
 917 sub unflagged_suspended_pkgs {
 918   my $self = shift;
 919   return $self->suspended_pkgs
 920     unless dbdef->table('cust_pkg')->column('manual_flag');
 921   grep { ! $_->manual_flag } $self->suspended_pkgs;
 922 }
 923
 924 =item unsuspended_pkgs
 925
 926 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
 927 this customer.
 928
 929 =cut
 930
 931 sub unsuspended_pkgs {
 932   my $self = shift;
 933   grep { ! $_->susp } $self->ncancelled_pkgs;
 934 }
 935
 936 =item unsuspend
 937
 938 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
 939 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
 940 on success or a list of errors.
 941
 942 =cut
 943
 944 sub unsuspend {
 945   my $self = shift;
 946   grep { $_->unsuspend } $self->suspended_pkgs;
 947 }
 948
 949 =item suspend
 950
 951 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
 952 Always returns a list: an empty list on success or a list of errors.
 953
 954 =cut
 955
 956 sub suspend {
 957   my $self = shift;
 958   grep { $_->suspend } $self->unsuspended_pkgs;
 959 }
 960
 961 =item cancel [ OPTION => VALUE ... ]
 962
 963 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
 964
 965 Available options are: I<quiet>
 966
 967 I<quiet> can be set true to supress email cancellation notices.
 968
 969 Always returns a list: an empty list on success or a list of errors.
 970
 971 =cut
 972
 973 sub cancel {
 974   my $self = shift;
 975   grep { $_->cancel(@_) } $self->ncancelled_pkgs;
 976 }
 977
 978 =item agent
 979
 980 Returns the agent (see L<FS::agent>) for this customer.
 981
 982 =cut
 983
 984 sub agent {
 985   my $self = shift;
 986   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
 987 }
 988
 989 =item bill OPTIONS
 990
 991 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
 992 conjunction with the collect method.
 993
 994 Options are passed as name-value pairs.
 995
 996 The only currently available option is `time', which bills the customer as if
 997 it were that time.  It is specified as a UNIX timestamp; see
 998 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
 999 functions.  For example:
1000
1001  use Date::Parse;
1002  ...
1003  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1004
1005 If there is an error, returns the error, otherwise returns false.
1006
1007 =cut
1008
1009 sub bill {
1010   my( $self, %options ) = @_;
1011   my $time = $options{'time'} || time;
1012
1013   my $error;
1014
1015   #put below somehow?
1016   local $SIG{HUP} = 'IGNORE';
1017   local $SIG{INT} = 'IGNORE';
1018   local $SIG{QUIT} = 'IGNORE';
1019   local $SIG{TERM} = 'IGNORE';
1020   local $SIG{TSTP} = 'IGNORE';
1021   local $SIG{PIPE} = 'IGNORE';
1022
1023   my $oldAutoCommit = $FS::UID::AutoCommit;
1024   local $FS::UID::AutoCommit = 0;
1025   my $dbh = dbh;
1026
1027   # find the packages which are due for billing, find out how much they are
1028   # & generate invoice database.
1029
1030   my( $total_setup, $total_recur ) = ( 0, 0 );
1031   #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1032   my @cust_bill_pkg = ();
1033   #my $tax = 0;##
1034   #my $taxable_charged = 0;##
1035   #my $charged = 0;##
1036
1037   my %tax;
1038
1039   foreach my $cust_pkg (
1040     qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1041   ) {
1042
1043     #NO!! next if $cust_pkg->cancel;
1044     next if $cust_pkg->getfield('cancel');
1045
1046     #? to avoid use of uninitialized value errors... ?
1047     $cust_pkg->setfield('bill', '')
1048       unless defined($cust_pkg->bill);
1049
1050     my $part_pkg = $cust_pkg->part_pkg;
1051
1052     #so we don't modify cust_pkg record unnecessarily
1053     my $cust_pkg_mod_flag = 0;
1054     my %hash = $cust_pkg->hash;
1055     my $old_cust_pkg = new FS::cust_pkg \%hash;
1056
1057     my @details = ();
1058
1059     # bill setup
1060     my $setup = 0;
1061     unless ( $cust_pkg->setup ) {
1062       my $setup_prog = $part_pkg->getfield('setup');
1063       $setup_prog =~ /^(.*)$/ or do {
1064         $dbh->rollback if $oldAutoCommit;
1065         return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
1066                ": $setup_prog";
1067       };
1068       $setup_prog = $1;
1069       $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1070
1071         #my $cpt = new Safe;
1072         ##$cpt->permit(); #what is necessary?
1073         #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1074         #$setup = $cpt->reval($setup_prog);
1075       $setup = eval $setup_prog;
1076       unless ( defined($setup) ) {
1077         $dbh->rollback if $oldAutoCommit;
1078         return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1079                "(expression $setup_prog): $@";
1080       }
1081       $cust_pkg->setfield('setup',$time);
1082       $cust_pkg_mod_flag=1;
1083     }
1084
1085     #bill recurring fee
1086     my $recur = 0;
1087     my $sdate;
1088     if ( $part_pkg->getfield('freq') > 0 &&
1089          ! $cust_pkg->getfield('susp') &&
1090          ( $cust_pkg->getfield('bill') || 0 ) <= $time
1091     ) {
1092       my $recur_prog = $part_pkg->getfield('recur');
1093       $recur_prog =~ /^(.*)$/ or do {
1094         $dbh->rollback if $oldAutoCommit;
1095         return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1096                ": $recur_prog";
1097       };
1098       $recur_prog = $1;
1099       $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1100
1101       # shared with $recur_prog
1102       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1103
1104         #my $cpt = new Safe;
1105         ##$cpt->permit(); #what is necessary?
1106         #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1107         #$recur = $cpt->reval($recur_prog);
1108       $recur = eval $recur_prog;
1109       unless ( defined($recur) ) {
1110         $dbh->rollback if $oldAutoCommit;
1111         return "Error eval-ing part_pkg->recur pkgpart ".  $part_pkg->pkgpart.
1112                "(expression $recur_prog): $@";
1113       }
1114       #change this bit to use Date::Manip? CAREFUL with timezones (see
1115       # mailing list archive)
1116       my ($sec,$min,$hour,$mday,$mon,$year) =
1117         (localtime($sdate) )[0,1,2,3,4,5];
1118
1119       #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1120       # only for figuring next bill date, nothing else, so, reset $sdate again
1121       # here
1122       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1123       $cust_pkg->last_bill($sdate)
1124         if $cust_pkg->dbdef_table->column('last_bill');
1125
1126       $mon += $part_pkg->freq;
1127       until ( $mon < 12 ) { $mon -= 12; $year++; }
1128       $cust_pkg->setfield('bill',
1129         timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1130       $cust_pkg_mod_flag = 1;
1131     }
1132
1133     warn "\$setup is undefined" unless defined($setup);
1134     warn "\$recur is undefined" unless defined($recur);
1135     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1136
1137     my $taxable_charged = 0;
1138     if ( $cust_pkg_mod_flag ) {
1139       $error=$cust_pkg->replace($old_cust_pkg);
1140       if ( $error ) { #just in case
1141         $dbh->rollback if $oldAutoCommit;
1142         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1143       }
1144       $setup = sprintf( "%.2f", $setup );
1145       $recur = sprintf( "%.2f", $recur );
1146       if ( $setup < 0 ) {
1147         $dbh->rollback if $oldAutoCommit;
1148         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1149       }
1150       if ( $recur < 0 ) {
1151         $dbh->rollback if $oldAutoCommit;
1152         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1153       }
1154       if ( $setup > 0 || $recur > 0 ) {
1155         my $cust_bill_pkg = new FS::cust_bill_pkg ({
1156           'pkgnum'  => $cust_pkg->pkgnum,
1157           'setup'   => $setup,
1158           'recur'   => $recur,
1159           'sdate'   => $sdate,
1160           'edate'   => $cust_pkg->bill,
1161           'details' => \@details,
1162         });
1163         push @cust_bill_pkg, $cust_bill_pkg;
1164         $total_setup += $setup;
1165         $total_recur += $recur;
1166         $taxable_charged += $setup
1167           unless $part_pkg->setuptax =~ /^Y$/i;
1168         $taxable_charged += $recur
1169           unless $part_pkg->recurtax =~ /^Y$/i;
1170
1171         unless ( $self->tax =~ /Y/i
1172                  || $self->payby eq 'COMP'
1173                  || $taxable_charged == 0 ) {
1174
1175           my $cust_main_county = qsearchs('cust_main_county',{
1176               'state'    => $self->state,
1177               'county'   => $self->county,
1178               'country'  => $self->country,
1179               'taxclass' => $part_pkg->taxclass,
1180           } );
1181           $cust_main_county ||= qsearchs('cust_main_county',{
1182               'state'    => $self->state,
1183               'county'   => $self->county,
1184               'country'  => $self->country,
1185               'taxclass' => '',
1186           } );
1187           unless ( $cust_main_county ) {
1188             $dbh->rollback if $oldAutoCommit;
1189             return
1190               "fatal: can't find tax rate for state/county/country/taxclass ".
1191               join('/', ( map $self->$_(), qw(state county country) ),
1192                         $part_pkg->taxclass ).  "\n";
1193           }
1194
1195           if ( $cust_main_county->exempt_amount ) {
1196             my ($mon,$year) = (localtime($sdate) )[4,5];
1197             $mon++;
1198             my $freq = $part_pkg->freq || 1;
1199             my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1200             foreach my $which_month ( 1 .. $freq ) {
1201               my %hash = (
1202                 'custnum' => $self->custnum,
1203                 'taxnum'  => $cust_main_county->taxnum,
1204                 'year'    => 1900+$year,
1205                 'month'   => $mon++,
1206               );
1207               #until ( $mon < 12 ) { $mon -= 12; $year++; }
1208               until ( $mon < 13 ) { $mon -= 12; $year++; }
1209               my $cust_tax_exempt =
1210                 qsearchs('cust_tax_exempt', \%hash)
1211                 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1212               my $remaining_exemption = sprintf("%.2f",
1213                 $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
1214               if ( $remaining_exemption > 0 ) {
1215                 my $addl = $remaining_exemption > $taxable_per_month
1216                   ? $taxable_per_month
1217                   : $remaining_exemption;
1218                 $taxable_charged -= $addl;
1219                 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1220                   $cust_tax_exempt->hash,
1221                   'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1222                 } );
1223                 $error = $new_cust_tax_exempt->exemptnum
1224                   ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1225                   : $new_cust_tax_exempt->insert;
1226                 if ( $error ) {
1227                   $dbh->rollback if $oldAutoCommit;
1228                   return "fatal: can't update cust_tax_exempt: $error";
1229                 }
1230
1231               } # if $remaining_exemption > 0
1232
1233             } #foreach $which_month
1234
1235           } #if $cust_main_county->exempt_amount
1236
1237           $taxable_charged = sprintf( "%.2f", $taxable_charged);
1238
1239           #$tax += $taxable_charged * $cust_main_county->tax / 100
1240           $tax{ $cust_main_county->taxname || 'Tax' } +=
1241             $taxable_charged * $cust_main_county->tax / 100
1242
1243         } #unless $self->tax =~ /Y/i
1244           #       || $self->payby eq 'COMP'
1245           #       || $taxable_charged == 0
1246
1247       } #if $setup > 0 || $recur > 0
1248
1249     } #if $cust_pkg_mod_flag
1250
1251   } #foreach my $cust_pkg
1252
1253   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1254 #  my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1255
1256   unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1257     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1258     return '';
1259   }
1260
1261 #  unless ( $self->tax =~ /Y/i
1262 #           || $self->payby eq 'COMP'
1263 #           || $taxable_charged == 0 ) {
1264 #    my $cust_main_county = qsearchs('cust_main_county',{
1265 #        'state'   => $self->state,
1266 #        'county'  => $self->county,
1267 #        'country' => $self->country,
1268 #    } ) or die "fatal: can't find tax rate for state/county/country ".
1269 #               $self->state. "/". $self->county. "/". $self->country. "\n";
1270 #    my $tax = sprintf( "%.2f",
1271 #      $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1272 #    );
1273
1274   foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1275     my $tax = sprintf("%.2f", $tax{$taxname} );
1276     $charged = sprintf( "%.2f", $charged+$tax );
1277
1278     my $cust_bill_pkg = new FS::cust_bill_pkg ({
1279       'pkgnum'   => 0,
1280       'setup'    => $tax,
1281       'recur'    => 0,
1282       'sdate'    => '',
1283       'edate'    => '',
1284       'itemdesc' => $taxname,
1285     });
1286     push @cust_bill_pkg, $cust_bill_pkg;
1287   }
1288 #  }
1289
1290   my $cust_bill = new FS::cust_bill ( {
1291     'custnum' => $self->custnum,
1292     '_date'   => $time,
1293     'charged' => $charged,
1294   } );
1295   $error = $cust_bill->insert;
1296   if ( $error ) {
1297     $dbh->rollback if $oldAutoCommit;
1298     return "can't create invoice for customer #". $self->custnum. ": $error";
1299   }
1300
1301   my $invnum = $cust_bill->invnum;
1302   my $cust_bill_pkg;
1303   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1304     #warn $invnum;
1305     $cust_bill_pkg->invnum($invnum);
1306     $error = $cust_bill_pkg->insert;
1307     if ( $error ) {
1308       $dbh->rollback if $oldAutoCommit;
1309       return "can't create invoice line item for customer #". $self->custnum.
1310              ": $error";
1311     }
1312   }
1313
1314   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1315   ''; #no error
1316 }
1317
1318 =item collect OPTIONS
1319
1320 (Attempt to) collect money for this customer's outstanding invoices (see
1321 L<FS::cust_bill>).  Usually used after the bill method.
1322
1323 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1324 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1325 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<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         local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1434         $error = eval $part_bill_event->eventcode;
1435       }
1436
1437       my $status = '';
1438       my $statustext = '';
1439       if ( $@ ) {
1440         $status = 'failed';
1441         $statustext = $@;
1442       } elsif ( $error ) {
1443         $status = 'done';
1444         $statustext = $error;
1445       } else {
1446         $status = 'done'
1447       }
1448
1449       #add cust_bill_event
1450       my $cust_bill_event = new FS::cust_bill_event {
1451         'invnum'     => $cust_bill->invnum,
1452         'eventpart'  => $part_bill_event->eventpart,
1453         #'_date'      => $invoice_time,
1454         '_date'      => time,
1455         'status'     => $status,
1456         'statustext' => $statustext,
1457       };
1458       $error = $cust_bill_event->insert;
1459       if ( $error ) {
1460         #$dbh->rollback if $oldAutoCommit;
1461         #return "error: $error";
1462
1463         # gah, even with transactions.
1464         $dbh->commit if $oldAutoCommit; #well.
1465         my $e = 'WARNING: Event run but database not updated - '.
1466                 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1467                 ', eventpart '. $part_bill_event->eventpart.
1468                 ": $error";
1469         warn $e;
1470         return $e;
1471       }
1472
1473
1474     }
1475
1476   }
1477
1478   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1479   '';
1480
1481 }
1482
1483 =item retry_realtime
1484
1485 Schedules realtime credit card / electronic check / LEC billing events for
1486 for retry.  Useful if card information has changed or manual retry is desired.
1487 The 'collect' method must be called to actually retry the transaction.
1488
1489 Implementation details: For each of this customer's open invoices, changes
1490 the status of the first "done" (with statustext error) realtime processing
1491 event to "failed".
1492
1493 =cut
1494
1495 sub retry_realtime {
1496   my $self = shift;
1497
1498   local $SIG{HUP} = 'IGNORE';
1499   local $SIG{INT} = 'IGNORE';
1500   local $SIG{QUIT} = 'IGNORE';
1501   local $SIG{TERM} = 'IGNORE';
1502   local $SIG{TSTP} = 'IGNORE';
1503   local $SIG{PIPE} = 'IGNORE';
1504
1505   my $oldAutoCommit = $FS::UID::AutoCommit;
1506   local $FS::UID::AutoCommit = 0;
1507   my $dbh = dbh;
1508
1509   foreach my $cust_bill (
1510     grep { $_->cust_bill_event }
1511       $self->open_cust_bill
1512   ) {
1513     my @cust_bill_event =
1514       sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1515         grep {
1516                #$_->part_bill_event->plan eq 'realtime-card'
1517                $_->part_bill_event->eventcode =~
1518                    /\$cust_bill\->realtime_(card|ach|lec)/
1519                  && $_->status eq 'done'
1520                  && $_->statustext
1521              }
1522           $cust_bill->cust_bill_event;
1523     next unless @cust_bill_event;
1524     my $error = $cust_bill_event[0]->retry;
1525     if ( $error ) {
1526       $dbh->rollback if $oldAutoCommit;
1527       return "error scheduling invoice event for retry: $error";
1528     }
1529
1530   }
1531
1532   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1533   '';
1534
1535 }
1536
1537 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1538
1539 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1540 via a Business::OnlinePayment realtime gateway.  See
1541 L<http://420.am/business-onlinepayment> for supported gateways.
1542
1543 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1544
1545 Available options are: I<description>, I<invnum>, I<quiet>
1546
1547 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1548 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
1549 if set, will override the value from the customer record.
1550
1551 I<description> is a free-text field passed to the gateway.  It defaults to
1552 "Internet services".
1553
1554 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1555 specified invoice.  If you don't specify an I<invnum> you might want to
1556 call the B<apply_payments> method.
1557
1558 I<quiet> can be set true to surpress email decline notices.
1559
1560 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1561
1562 =cut
1563
1564 sub realtime_bop {
1565   my( $self, $method, $amount, %options ) = @_;
1566   if ( $Debug ) {
1567     warn "$self $method $amount\n";
1568     warn "  $_ => $options{$_}\n" foreach keys %options;
1569   }
1570
1571   $options{'description'} ||= 'Internet services';
1572
1573   #pre-requisites
1574   die "Real-time processing not enabled\n"
1575     unless $conf->exists('business-onlinepayment');
1576   eval "use Business::OnlinePayment";
1577   die $@ if $@;
1578
1579   #overrides
1580   $self->set( $_ => $options{$_} )
1581     foreach grep { exists($options{$_}) }
1582             qw( payname address1 address2 city state zip payinfo paydate );
1583
1584   #load up config
1585   my $bop_config = 'business-onlinepayment';
1586   $bop_config .= '-ach'
1587     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1588   my ( $processor, $login, $password, $action, @bop_options ) =
1589     $conf->config($bop_config);
1590   $action ||= 'normal authorization';
1591   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1592
1593   #massage data
1594
1595   my $address = $self->address1;
1596   $address .= ", ". $self->address2 if $self->address2;
1597
1598   my($payname, $payfirst, $paylast);
1599   if ( $self->payname && $method ne 'ECHECK' ) {
1600     $payname = $self->payname;
1601     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1602       or return "Illegal payname $payname";
1603     ($payfirst, $paylast) = ($1, $2);
1604   } else {
1605     $payfirst = $self->getfield('first');
1606     $paylast = $self->getfield('last');
1607     $payname =  "$payfirst $paylast";
1608   }
1609
1610   my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1611   if ( $conf->exists('emailinvoiceauto')
1612        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1613     push @invoicing_list, $self->all_emails;
1614   }
1615   my $email = $invoicing_list[0];
1616
1617   my %content;
1618   if ( $method eq 'CC' ) {
1619     $content{card_number} = $self->payinfo;
1620     $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1621     $content{expiration} = "$2/$1";
1622   } elsif ( $method eq 'ECHECK' ) {
1623     my($account_number,$routing_code) = $self->payinfo;
1624     ( $content{account_number}, $content{routing_code} ) =
1625       split('@', $self->payinfo);
1626     $content{bank_name} = $self->payname;
1627     $content{account_type} = 'CHECKING';
1628     $content{account_name} = $payname;
1629     $content{customer_org} = $self->company ? 'B' : 'I';
1630     $content{customer_ssn} = $self->ss;
1631   } elsif ( $method eq 'LEC' ) {
1632     $content{phone} = $self->payinfo;
1633   }
1634
1635   #transaction(s)
1636
1637   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1638
1639   my $transaction =
1640     new Business::OnlinePayment( $processor, @bop_options );
1641   $transaction->content(
1642     'type'           => $method,
1643     'login'          => $login,
1644     'password'       => $password,
1645     'action'         => $action1,
1646     'description'    => $options{'description'},
1647     'amount'         => $amount,
1648     'invoice_number' => $options{'invnum'},
1649     'customer_id'    => $self->custnum,
1650     'last_name'      => $paylast,
1651     'first_name'     => $payfirst,
1652     'name'           => $payname,
1653     'address'        => $address,
1654     'city'           => $self->city,
1655     'state'          => $self->state,
1656     'zip'            => $self->zip,
1657     'country'        => $self->country,
1658     'referer'        => 'http://cleanwhisker.420.am/',
1659     'email'          => $email,
1660     'phone'          => $self->daytime || $self->night,
1661     %content, #after
1662   );
1663   $transaction->submit();
1664
1665   if ( $transaction->is_success() && $action2 ) {
1666     my $auth = $transaction->authorization;
1667     my $ordernum = $transaction->can('order_number')
1668                    ? $transaction->order_number
1669                    : '';
1670
1671     my $capture =
1672       new Business::OnlinePayment( $processor, @bop_options );
1673
1674     my %capture = (
1675       %content,
1676       type           => $method,
1677       action         => $action2,
1678       login          => $login,
1679       password       => $password,
1680       order_number   => $ordernum,
1681       amount         => $amount,
1682       authorization  => $auth,
1683       description    => $options{'description'},
1684     );
1685
1686     foreach my $field (qw( authorization_source_code returned_ACI                                          transaction_identifier validation_code
1687                            transaction_sequence_num local_transaction_date
1688                            local_transaction_time AVS_result_code          )) {
1689       $capture{$field} = $transaction->$field() if $transaction->can($field);
1690     }
1691
1692     $capture->content( %capture );
1693
1694     $capture->submit();
1695
1696     unless ( $capture->is_success ) {
1697       my $e = "Authorization sucessful but capture failed, custnum #".
1698               $self->custnum. ': '.  $capture->result_code.
1699               ": ". $capture->error_message;
1700       warn $e;
1701       return $e;
1702     }
1703
1704   }
1705
1706   #result handling
1707   if ( $transaction->is_success() ) {
1708
1709     my %method2payby = (
1710       'CC'     => 'CARD',
1711       'ECHECK' => 'CHEK',
1712       'LEC'    => 'LECB',
1713     );
1714
1715     my $cust_pay = new FS::cust_pay ( {
1716        'custnum'  => $self->custnum,
1717        'invnum'   => $options{'invnum'},
1718        'paid'     => $amount,
1719        '_date'     => '',
1720        'payby'    => $method2payby{$method},
1721        'payinfo'  => $self->payinfo,
1722        'paybatch' => "$processor:". $transaction->authorization,
1723     } );
1724     my $error = $cust_pay->insert;
1725     if ( $error ) {
1726       # gah, even with transactions.
1727       my $e = 'WARNING: Card/ACH debited but database not updated - '.
1728               'error applying payment, invnum #' . $self->invnum.
1729               " ($processor): $error";
1730       warn $e;
1731       return $e;
1732     } else {
1733       return '';
1734     }
1735
1736   } else {
1737
1738     my $perror = "$processor error: ". $transaction->error_message;
1739
1740     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1741          && $conf->exists('emaildecline')
1742          && grep { $_ ne 'POST' } $self->invoicing_list
1743     ) {
1744       my @templ = $conf->config('declinetemplate');
1745       my $template = new Text::Template (
1746         TYPE   => 'ARRAY',
1747         SOURCE => [ map "$_\n", @templ ],
1748       ) or return "($perror) can't create template: $Text::Template::ERROR";
1749       $template->compile()
1750         or return "($perror) can't compile template: $Text::Template::ERROR";
1751
1752       my $templ_hash = { error => $transaction->error_message };
1753
1754       my $error = send_email(
1755         'from'    => $conf->config('invoice_from'),
1756         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1757         'subject' => 'Your payment could not be processed',
1758         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
1759       );
1760
1761       $perror .= " (also received error sending decline notification: $error)"
1762         if $error;
1763
1764     }
1765
1766     return $perror;
1767   }
1768
1769 }
1770
1771 =item total_owed
1772
1773 Returns the total owed for this customer on all invoices
1774 (see L<FS::cust_bill/owed>).
1775
1776 =cut
1777
1778 sub total_owed {
1779   my $self = shift;
1780   $self->total_owed_date(2145859200); #12/31/2037
1781 }
1782
1783 =item total_owed_date TIME
1784
1785 Returns the total owed for this customer on all invoices with date earlier than
1786 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
1787 see L<Time::Local> and L<Date::Parse> for conversion functions.
1788
1789 =cut
1790
1791 sub total_owed_date {
1792   my $self = shift;
1793   my $time = shift;
1794   my $total_bill = 0;
1795   foreach my $cust_bill (
1796     grep { $_->_date <= $time }
1797       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1798   ) {
1799     $total_bill += $cust_bill->owed;
1800   }
1801   sprintf( "%.2f", $total_bill );
1802 }
1803
1804 =item apply_credits
1805
1806 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1807 to outstanding invoice balances in chronological order and returns the value
1808 of any remaining unapplied credits available for refund
1809 (see L<FS::cust_refund>).
1810
1811 =cut
1812
1813 sub apply_credits {
1814   my $self = shift;
1815
1816   return 0 unless $self->total_credited;
1817
1818   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1819       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1820
1821   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1822       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1823
1824   my $credit;
1825
1826   foreach my $cust_bill ( @invoices ) {
1827     my $amount;
1828
1829     if ( !defined($credit) || $credit->credited == 0) {
1830       $credit = pop @credits or last;
1831     }
1832
1833     if ($cust_bill->owed >= $credit->credited) {
1834       $amount=$credit->credited;
1835     }else{
1836       $amount=$cust_bill->owed;
1837     }
1838
1839     my $cust_credit_bill = new FS::cust_credit_bill ( {
1840       'crednum' => $credit->crednum,
1841       'invnum'  => $cust_bill->invnum,
1842       'amount'  => $amount,
1843     } );
1844     my $error = $cust_credit_bill->insert;
1845     die $error if $error;
1846
1847     redo if ($cust_bill->owed > 0);
1848
1849   }
1850
1851   return $self->total_credited;
1852 }
1853
1854 =item apply_payments
1855
1856 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1857 to outstanding invoice balances in chronological order.
1858
1859  #and returns the value of any remaining unapplied payments.
1860
1861 =cut
1862
1863 sub apply_payments {
1864   my $self = shift;
1865
1866   #return 0 unless
1867
1868   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1869       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1870
1871   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1872       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1873
1874   my $payment;
1875
1876   foreach my $cust_bill ( @invoices ) {
1877     my $amount;
1878
1879     if ( !defined($payment) || $payment->unapplied == 0 ) {
1880       $payment = pop @payments or last;
1881     }
1882
1883     if ( $cust_bill->owed >= $payment->unapplied ) {
1884       $amount = $payment->unapplied;
1885     } else {
1886       $amount = $cust_bill->owed;
1887     }
1888
1889     my $cust_bill_pay = new FS::cust_bill_pay ( {
1890       'paynum' => $payment->paynum,
1891       'invnum' => $cust_bill->invnum,
1892       'amount' => $amount,
1893     } );
1894     my $error = $cust_bill_pay->insert;
1895     die $error if $error;
1896
1897     redo if ( $cust_bill->owed > 0);
1898
1899   }
1900
1901   return $self->total_unapplied_payments;
1902 }
1903
1904 =item total_credited
1905
1906 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1907 customer.  See L<FS::cust_credit/credited>.
1908
1909 =cut
1910
1911 sub total_credited {
1912   my $self = shift;
1913   my $total_credit = 0;
1914   foreach my $cust_credit ( qsearch('cust_credit', {
1915     'custnum' => $self->custnum,
1916   } ) ) {
1917     $total_credit += $cust_credit->credited;
1918   }
1919   sprintf( "%.2f", $total_credit );
1920 }
1921
1922 =item total_unapplied_payments
1923
1924 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1925 See L<FS::cust_pay/unapplied>.
1926
1927 =cut
1928
1929 sub total_unapplied_payments {
1930   my $self = shift;
1931   my $total_unapplied = 0;
1932   foreach my $cust_pay ( qsearch('cust_pay', {
1933     'custnum' => $self->custnum,
1934   } ) ) {
1935     $total_unapplied += $cust_pay->unapplied;
1936   }
1937   sprintf( "%.2f", $total_unapplied );
1938 }
1939
1940 =item balance
1941
1942 Returns the balance for this customer (total_owed minus total_credited
1943 minus total_unapplied_payments).
1944
1945 =cut
1946
1947 sub balance {
1948   my $self = shift;
1949   sprintf( "%.2f",
1950     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1951   );
1952 }
1953
1954 =item balance_date TIME
1955
1956 Returns the balance for this customer, only considering invoices with date
1957 earlier than TIME (total_owed_date minus total_credited minus
1958 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
1959 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
1960 functions.
1961
1962 =cut
1963
1964 sub balance_date {
1965   my $self = shift;
1966   my $time = shift;
1967   sprintf( "%.2f",
1968     $self->total_owed_date($time)
1969       - $self->total_credited
1970       - $self->total_unapplied_payments
1971   );
1972 }
1973
1974 =item invoicing_list [ ARRAYREF ]
1975
1976 If an arguement is given, sets these email addresses as invoice recipients
1977 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
1978 (except as warnings), so use check_invoicing_list first.
1979
1980 Returns a list of email addresses (with svcnum entries expanded).
1981
1982 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
1983 check it without disturbing anything by passing nothing.
1984
1985 This interface may change in the future.
1986
1987 =cut
1988
1989 sub invoicing_list {
1990   my( $self, $arrayref ) = @_;
1991   if ( $arrayref ) {
1992     my @cust_main_invoice;
1993     if ( $self->custnum ) {
1994       @cust_main_invoice =
1995         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1996     } else {
1997       @cust_main_invoice = ();
1998     }
1999     foreach my $cust_main_invoice ( @cust_main_invoice ) {
2000       #warn $cust_main_invoice->destnum;
2001       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2002         #warn $cust_main_invoice->destnum;
2003         my $error = $cust_main_invoice->delete;
2004         warn $error if $error;
2005       }
2006     }
2007     if ( $self->custnum ) {
2008       @cust_main_invoice =
2009         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2010     } else {
2011       @cust_main_invoice = ();
2012     }
2013     my %seen = map { $_->address => 1 } @cust_main_invoice;
2014     foreach my $address ( @{$arrayref} ) {
2015       next if exists $seen{$address} && $seen{$address};
2016       $seen{$address} = 1;
2017       my $cust_main_invoice = new FS::cust_main_invoice ( {
2018         'custnum' => $self->custnum,
2019         'dest'    => $address,
2020       } );
2021       my $error = $cust_main_invoice->insert;
2022       warn $error if $error;
2023     }
2024   }
2025   if ( $self->custnum ) {
2026     map { $_->address }
2027       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2028   } else {
2029     ();
2030   }
2031 }
2032
2033 =item check_invoicing_list ARRAYREF
2034
2035 Checks these arguements as valid input for the invoicing_list method.  If there
2036 is an error, returns the error, otherwise returns false.
2037
2038 =cut
2039
2040 sub check_invoicing_list {
2041   my( $self, $arrayref ) = @_;
2042   foreach my $address ( @{$arrayref} ) {
2043     my $cust_main_invoice = new FS::cust_main_invoice ( {
2044       'custnum' => $self->custnum,
2045       'dest'    => $address,
2046     } );
2047     my $error = $self->custnum
2048                 ? $cust_main_invoice->check
2049                 : $cust_main_invoice->checkdest
2050     ;
2051     return $error if $error;
2052   }
2053   '';
2054 }
2055
2056 =item set_default_invoicing_list
2057
2058 Sets the invoicing list to all accounts associated with this customer,
2059 overwriting any previous invoicing list.
2060
2061 =cut
2062
2063 sub set_default_invoicing_list {
2064   my $self = shift;
2065   $self->invoicing_list($self->all_emails);
2066 }
2067
2068 =item all_emails
2069
2070 Returns the email addresses of all accounts provisioned for this customer.
2071
2072 =cut
2073
2074 sub all_emails {
2075   my $self = shift;
2076   my %list;
2077   foreach my $cust_pkg ( $self->all_pkgs ) {
2078     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2079     my @svc_acct =
2080       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2081         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2082           @cust_svc;
2083     $list{$_}=1 foreach map { $_->email } @svc_acct;
2084   }
2085   keys %list;
2086 }
2087
2088 =item invoicing_list_addpost
2089
2090 Adds postal invoicing to this customer.  If this customer is already configured
2091 to receive postal invoices, does nothing.
2092
2093 =cut
2094
2095 sub invoicing_list_addpost {
2096   my $self = shift;
2097   return if grep { $_ eq 'POST' } $self->invoicing_list;
2098   my @invoicing_list = $self->invoicing_list;
2099   push @invoicing_list, 'POST';
2100   $self->invoicing_list(\@invoicing_list);
2101 }
2102
2103 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2104
2105 Returns an array of customers referred by this customer (referral_custnum set
2106 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
2107 customers referred by customers referred by this customer and so on, inclusive.
2108 The default behavior is DEPTH 1 (no recursion).
2109
2110 =cut
2111
2112 sub referral_cust_main {
2113   my $self = shift;
2114   my $depth = @_ ? shift : 1;
2115   my $exclude = @_ ? shift : {};
2116
2117   my @cust_main =
2118     map { $exclude->{$_->custnum}++; $_; }
2119       grep { ! $exclude->{ $_->custnum } }
2120         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2121
2122   if ( $depth > 1 ) {
2123     push @cust_main,
2124       map { $_->referral_cust_main($depth-1, $exclude) }
2125         @cust_main;
2126   }
2127
2128   @cust_main;
2129 }
2130
2131 =item referral_cust_main_ncancelled
2132
2133 Same as referral_cust_main, except only returns customers with uncancelled
2134 packages.
2135
2136 =cut
2137
2138 sub referral_cust_main_ncancelled {
2139   my $self = shift;
2140   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2141 }
2142
2143 =item referral_cust_pkg [ DEPTH ]
2144
2145 Like referral_cust_main, except returns a flat list of all unsuspended (and
2146 uncancelled) packages for each customer.  The number of items in this list may
2147 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2148
2149 =cut
2150
2151 sub referral_cust_pkg {
2152   my $self = shift;
2153   my $depth = @_ ? shift : 1;
2154
2155   map { $_->unsuspended_pkgs }
2156     grep { $_->unsuspended_pkgs }
2157       $self->referral_cust_main($depth);
2158 }
2159
2160 =item credit AMOUNT, REASON
2161
2162 Applies a credit to this customer.  If there is an error, returns the error,
2163 otherwise returns false.
2164
2165 =cut
2166
2167 sub credit {
2168   my( $self, $amount, $reason ) = @_;
2169   my $cust_credit = new FS::cust_credit {
2170     'custnum' => $self->custnum,
2171     'amount'  => $amount,
2172     'reason'  => $reason,
2173   };
2174   $cust_credit->insert;
2175 }
2176
2177 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2178
2179 Creates a one-time charge for this customer.  If there is an error, returns
2180 the error, otherwise returns false.
2181
2182 =cut
2183
2184 sub charge {
2185   my ( $self, $amount ) = ( shift, shift );
2186   my $pkg      = @_ ? shift : 'One-time charge';
2187   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
2188   my $taxclass = @_ ? shift : '';
2189
2190   local $SIG{HUP} = 'IGNORE';
2191   local $SIG{INT} = 'IGNORE';
2192   local $SIG{QUIT} = 'IGNORE';
2193   local $SIG{TERM} = 'IGNORE';
2194   local $SIG{TSTP} = 'IGNORE';
2195   local $SIG{PIPE} = 'IGNORE';
2196
2197   my $oldAutoCommit = $FS::UID::AutoCommit;
2198   local $FS::UID::AutoCommit = 0;
2199   my $dbh = dbh;
2200
2201   my $part_pkg = new FS::part_pkg ( {
2202     'pkg'      => $pkg,
2203     'comment'  => $comment,
2204     'setup'    => $amount,
2205     'freq'     => 0,
2206     'recur'    => '0',
2207     'disabled' => 'Y',
2208     'taxclass' => $taxclass,
2209   } );
2210
2211   my $error = $part_pkg->insert;
2212   if ( $error ) {
2213     $dbh->rollback if $oldAutoCommit;
2214     return $error;
2215   }
2216
2217   my $pkgpart = $part_pkg->pkgpart;
2218   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2219   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2220     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2221     $error = $type_pkgs->insert;
2222     if ( $error ) {
2223       $dbh->rollback if $oldAutoCommit;
2224       return $error;
2225     }
2226   }
2227
2228   my $cust_pkg = new FS::cust_pkg ( {
2229     'custnum' => $self->custnum,
2230     'pkgpart' => $pkgpart,
2231   } );
2232
2233   $error = $cust_pkg->insert;
2234   if ( $error ) {
2235     $dbh->rollback if $oldAutoCommit;
2236     return $error;
2237   }
2238
2239   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2240   '';
2241
2242 }
2243
2244 =item cust_bill
2245
2246 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2247
2248 =cut
2249
2250 sub cust_bill {
2251   my $self = shift;
2252   sort { $a->_date <=> $b->_date }
2253     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2254 }
2255
2256 =item open_cust_bill
2257
2258 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2259 customer.
2260
2261 =cut
2262
2263 sub open_cust_bill {
2264   my $self = shift;
2265   grep { $_->owed > 0 } $self->cust_bill;
2266 }
2267
2268 =back
2269
2270 =head1 SUBROUTINES
2271
2272 =over 4
2273
2274 =item check_and_rebuild_fuzzyfiles
2275
2276 =cut
2277
2278 sub check_and_rebuild_fuzzyfiles {
2279   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2280   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2281     or &rebuild_fuzzyfiles;
2282 }
2283
2284 =item rebuild_fuzzyfiles
2285
2286 =cut
2287
2288 sub rebuild_fuzzyfiles {
2289
2290   use Fcntl qw(:flock);
2291
2292   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2293
2294   #last
2295
2296   open(LASTLOCK,">>$dir/cust_main.last")
2297     or die "can't open $dir/cust_main.last: $!";
2298   flock(LASTLOCK,LOCK_EX)
2299     or die "can't lock $dir/cust_main.last: $!";
2300
2301   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2302   push @all_last,
2303                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2304     if defined dbdef->table('cust_main')->column('ship_last');
2305
2306   open (LASTCACHE,">$dir/cust_main.last.tmp")
2307     or die "can't open $dir/cust_main.last.tmp: $!";
2308   print LASTCACHE join("\n", @all_last), "\n";
2309   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2310
2311   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2312   close LASTLOCK;
2313
2314   #company
2315
2316   open(COMPANYLOCK,">>$dir/cust_main.company")
2317     or die "can't open $dir/cust_main.company: $!";
2318   flock(COMPANYLOCK,LOCK_EX)
2319     or die "can't lock $dir/cust_main.company: $!";
2320
2321   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2322   push @all_company,
2323        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2324     if defined dbdef->table('cust_main')->column('ship_last');
2325
2326   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2327     or die "can't open $dir/cust_main.company.tmp: $!";
2328   print COMPANYCACHE join("\n", @all_company), "\n";
2329   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2330
2331   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2332   close COMPANYLOCK;
2333
2334 }
2335
2336 =item all_last
2337
2338 =cut
2339
2340 sub all_last {
2341   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2342   open(LASTCACHE,"<$dir/cust_main.last")
2343     or die "can't open $dir/cust_main.last: $!";
2344   my @array = map { chomp; $_; } <LASTCACHE>;
2345   close LASTCACHE;
2346   \@array;
2347 }
2348
2349 =item all_company
2350
2351 =cut
2352
2353 sub all_company {
2354   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2355   open(COMPANYCACHE,"<$dir/cust_main.company")
2356     or die "can't open $dir/cust_main.last: $!";
2357   my @array = map { chomp; $_; } <COMPANYCACHE>;
2358   close COMPANYCACHE;
2359   \@array;
2360 }
2361
2362 =item append_fuzzyfiles LASTNAME COMPANY
2363
2364 =cut
2365
2366 sub append_fuzzyfiles {
2367   my( $last, $company ) = @_;
2368
2369   &check_and_rebuild_fuzzyfiles;
2370
2371   use Fcntl qw(:flock);
2372
2373   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2374
2375   if ( $last ) {
2376
2377     open(LAST,">>$dir/cust_main.last")
2378       or die "can't open $dir/cust_main.last: $!";
2379     flock(LAST,LOCK_EX)
2380       or die "can't lock $dir/cust_main.last: $!";
2381
2382     print LAST "$last\n";
2383
2384     flock(LAST,LOCK_UN)
2385       or die "can't unlock $dir/cust_main.last: $!";
2386     close LAST;
2387   }
2388
2389   if ( $company ) {
2390
2391     open(COMPANY,">>$dir/cust_main.company")
2392       or die "can't open $dir/cust_main.company: $!";
2393     flock(COMPANY,LOCK_EX)
2394       or die "can't lock $dir/cust_main.company: $!";
2395
2396     print COMPANY "$company\n";
2397
2398     flock(COMPANY,LOCK_UN)
2399       or die "can't unlock $dir/cust_main.company: $!";
2400
2401     close COMPANY;
2402   }
2403
2404   1;
2405 }
2406
2407 =item batch_import
2408
2409 =cut
2410
2411 sub batch_import {
2412   my $param = shift;
2413   #warn join('-',keys %$param);
2414   my $fh = $param->{filehandle};
2415   my $agentnum = $param->{agentnum};
2416   my $refnum = $param->{refnum};
2417   my $pkgpart = $param->{pkgpart};
2418   my @fields = @{$param->{fields}};
2419
2420   eval "use Date::Parse;";
2421   die $@ if $@;
2422   eval "use Text::CSV_XS;";
2423   die $@ if $@;
2424
2425   my $csv = new Text::CSV_XS;
2426   #warn $csv;
2427   #warn $fh;
2428
2429   my $imported = 0;
2430   #my $columns;
2431
2432   local $SIG{HUP} = 'IGNORE';
2433   local $SIG{INT} = 'IGNORE';
2434   local $SIG{QUIT} = 'IGNORE';
2435   local $SIG{TERM} = 'IGNORE';
2436   local $SIG{TSTP} = 'IGNORE';
2437   local $SIG{PIPE} = 'IGNORE';
2438
2439   my $oldAutoCommit = $FS::UID::AutoCommit;
2440   local $FS::UID::AutoCommit = 0;
2441   my $dbh = dbh;
2442
2443   #while ( $columns = $csv->getline($fh) ) {
2444   my $line;
2445   while ( defined($line=<$fh>) ) {
2446
2447     $csv->parse($line) or do {
2448       $dbh->rollback if $oldAutoCommit;
2449       return "can't parse: ". $csv->error_input();
2450     };
2451
2452     my @columns = $csv->fields();
2453     #warn join('-',@columns);
2454
2455     my %cust_main = (
2456       agentnum => $agentnum,
2457       refnum   => $refnum,
2458       country  => 'US', #default
2459       payby    => 'BILL', #default
2460       paydate  => '12/2037', #default
2461     );
2462     my $billtime = time;
2463     my %cust_pkg = ( pkgpart => $pkgpart );
2464     foreach my $field ( @fields ) {
2465       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2466         #$cust_pkg{$1} = str2time( shift @$columns );
2467         if ( $1 eq 'setup' ) {
2468           $billtime = str2time(shift @columns);
2469         } else {
2470           $cust_pkg{$1} = str2time( shift @columns );
2471         }
2472       } else {
2473         #$cust_main{$field} = shift @$columns;
2474         $cust_main{$field} = shift @columns;
2475       }
2476     }
2477
2478     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2479     my $cust_main = new FS::cust_main ( \%cust_main );
2480     use Tie::RefHash;
2481     tie my %hash, 'Tie::RefHash'; #this part is important
2482     $hash{$cust_pkg} = [] if $pkgpart;
2483     my $error = $cust_main->insert( \%hash );
2484
2485     if ( $error ) {
2486       $dbh->rollback if $oldAutoCommit;
2487       return "can't insert customer for $line: $error";
2488     }
2489
2490     #false laziness w/bill.cgi
2491     $error = $cust_main->bill( 'time' => $billtime );
2492     if ( $error ) {
2493       $dbh->rollback if $oldAutoCommit;
2494       return "can't bill customer for $line: $error";
2495     }
2496
2497     $cust_main->apply_payments;
2498     $cust_main->apply_credits;
2499
2500     $error = $cust_main->collect();
2501     if ( $error ) {
2502       $dbh->rollback if $oldAutoCommit;
2503       return "can't collect customer for $line: $error";
2504     }
2505
2506     $imported++;
2507   }
2508
2509   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2510
2511   return "Empty file!" unless $imported;
2512
2513   ''; #no error
2514
2515 }
2516
2517 =item batch_charge
2518
2519 =cut
2520
2521 sub batch_charge {
2522   my $param = shift;
2523   #warn join('-',keys %$param);
2524   my $fh = $param->{filehandle};
2525   my @fields = @{$param->{fields}};
2526
2527   eval "use Date::Parse;";
2528   die $@ if $@;
2529   eval "use Text::CSV_XS;";
2530   die $@ if $@;
2531
2532   my $csv = new Text::CSV_XS;
2533   #warn $csv;
2534   #warn $fh;
2535
2536   my $imported = 0;
2537   #my $columns;
2538
2539   local $SIG{HUP} = 'IGNORE';
2540   local $SIG{INT} = 'IGNORE';
2541   local $SIG{QUIT} = 'IGNORE';
2542   local $SIG{TERM} = 'IGNORE';
2543   local $SIG{TSTP} = 'IGNORE';
2544   local $SIG{PIPE} = 'IGNORE';
2545
2546   my $oldAutoCommit = $FS::UID::AutoCommit;
2547   local $FS::UID::AutoCommit = 0;
2548   my $dbh = dbh;
2549
2550   #while ( $columns = $csv->getline($fh) ) {
2551   my $line;
2552   while ( defined($line=<$fh>) ) {
2553
2554     $csv->parse($line) or do {
2555       $dbh->rollback if $oldAutoCommit;
2556       return "can't parse: ". $csv->error_input();
2557     };
2558
2559     my @columns = $csv->fields();
2560     #warn join('-',@columns);
2561
2562     my %row = ();
2563     foreach my $field ( @fields ) {
2564       $row{$field} = shift @columns;
2565     }
2566
2567     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2568     unless ( $cust_main ) {
2569       $dbh->rollback if $oldAutoCommit;
2570       return "unknown custnum $row{'custnum'}";
2571     }
2572
2573     if ( $row{'amount'} > 0 ) {
2574       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2575       if ( $error ) {
2576         $dbh->rollback if $oldAutoCommit;
2577         return $error;
2578       }
2579       $imported++;
2580     } elsif ( $row{'amount'} < 0 ) {
2581       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2582                                       $row{'pkg'}                         );
2583       if ( $error ) {
2584         $dbh->rollback if $oldAutoCommit;
2585         return $error;
2586       }
2587       $imported++;
2588     } else {
2589       #hmm?
2590     }
2591
2592   }
2593
2594   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2595
2596   return "Empty file!" unless $imported;
2597
2598   ''; #no error
2599
2600 }
2601
2602 =back
2603
2604 =head1 BUGS
2605
2606 The delete method.
2607
2608 The delete method should possibly take an FS::cust_main object reference
2609 instead of a scalar customer number.
2610
2611 Bill and collect options should probably be passed as references instead of a
2612 list.
2613
2614 There should probably be a configuration file with a list of allowed credit
2615 card types.
2616
2617 No multiple currency support (probably a larger project than just this module).
2618
2619 =head1 SEE ALSO
2620
2621 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2622 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2623 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
2624
2625 =cut
2626
2627 1;
2628