FS/FS/cust_main.pm

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