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