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