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<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->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     $content{account_type} = 'CHECKING';
1560     $content{account_name} = $payname;
1561     $content{customer_org} = $self->company ? 'B' : 'I';
1562     $content{customer_ssn} = $self->ss;
1563   } elsif ( $method eq 'LEC' ) {
1564     $content{phone} = $self->payinfo;
1565   }
1566
1567   #transaction(s)
1568
1569   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1570
1571   my $transaction =
1572     new Business::OnlinePayment( $processor, @bop_options );
1573   $transaction->content(
1574     'type'           => $method,
1575     'login'          => $login,
1576     'password'       => $password,
1577     'action'         => $action1,
1578     'description'    => $options{'description'},
1579     'amount'         => $amount,
1580     'invoice_number' => $options{'invnum'},
1581     'customer_id'    => $self->custnum,
1582     'last_name'      => $paylast,
1583     'first_name'     => $payfirst,
1584     'name'           => $payname,
1585     'address'        => $address,
1586     'city'           => $self->city,
1587     'state'          => $self->state,
1588     'zip'            => $self->zip,
1589     'country'        => $self->country,
1590     'referer'        => 'http://cleanwhisker.420.am/',
1591     'email'          => $email,
1592     'phone'          => $self->daytime || $self->night,
1593     %content, #after
1594   );
1595   $transaction->submit();
1596
1597   if ( $transaction->is_success() && $action2 ) {
1598     my $auth = $transaction->authorization;
1599     my $ordernum = $transaction->can('order_number')
1600                    ? $transaction->order_number
1601                    : '';
1602
1603     my $capture =
1604       new Business::OnlinePayment( $processor, @bop_options );
1605
1606     my %capture = (
1607       %content,
1608       type           => $method,
1609       action         => $action2,
1610       login          => $login,
1611       password       => $password,
1612       order_number   => $ordernum,
1613       amount         => $amount,
1614       authorization  => $auth,
1615       description    => $options{'description'},
1616     );
1617
1618     foreach my $field (qw( authorization_source_code returned_ACI                                          transaction_identifier validation_code
1619                            transaction_sequence_num local_transaction_date
1620                            local_transaction_time AVS_result_code          )) {
1621       $capture{$field} = $transaction->$field() if $transaction->can($field);
1622     }
1623
1624     $capture->content( %capture );
1625
1626     $capture->submit();
1627
1628     unless ( $capture->is_success ) {
1629       my $e = "Authorization sucessful but capture failed, custnum #".
1630               $self->custnum. ': '.  $capture->result_code.
1631               ": ". $capture->error_message;
1632       warn $e;
1633       return $e;
1634     }
1635
1636   }
1637
1638   #result handling
1639   if ( $transaction->is_success() ) {
1640
1641     my %method2payby = (
1642       'CC'     => 'CARD',
1643       'ECHECK' => 'CHEK',
1644       'LEC'    => 'LECB',
1645     );
1646
1647     my $cust_pay = new FS::cust_pay ( {
1648        'custnum'  => $self->custnum,
1649        'invnum'   => $options{'invnum'},
1650        'paid'     => $amount,
1651        '_date'     => '',
1652        'payby'    => $method2payby{$method},
1653        'payinfo'  => $self->payinfo,
1654        'paybatch' => "$processor:". $transaction->authorization,
1655     } );
1656     my $error = $cust_pay->insert;
1657     if ( $error ) {
1658       # gah, even with transactions.
1659       my $e = 'WARNING: Card/ACH debited but database not updated - '.
1660               'error applying payment, invnum #' . $self->invnum.
1661               " ($processor): $error";
1662       warn $e;
1663       return $e;
1664     } else {
1665       return '';
1666     }
1667
1668   } else {
1669
1670     my $perror = "$processor error: ". $transaction->error_message;
1671
1672     if ( !$options{'quiet'} && $conf->exists('emaildecline')
1673          && grep { $_ ne 'POST' } $self->invoicing_list
1674     ) {
1675       my @templ = $conf->config('declinetemplate');
1676       my $template = new Text::Template (
1677         TYPE   => 'ARRAY',
1678         SOURCE => [ map "$_\n", @templ ],
1679       ) or return "($perror) can't create template: $Text::Template::ERROR";
1680       $template->compile()
1681         or return "($perror) can't compile template: $Text::Template::ERROR";
1682
1683       my $templ_hash = { error => $transaction->error_message };
1684
1685       my $error = send_email(
1686         'from'    => $conf->config('invoice_from'),
1687         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1688         'subject' => 'Your payment could not be processed',
1689         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
1690       );
1691
1692       $perror .= " (also received error sending decline notification: $error)"
1693         if $error;
1694
1695     }
1696
1697     return $perror;
1698   }
1699
1700 }
1701
1702 =item total_owed
1703
1704 Returns the total owed for this customer on all invoices
1705 (see L<FS::cust_bill/owed>).
1706
1707 =cut
1708
1709 sub total_owed {
1710   my $self = shift;
1711   $self->total_owed_date(2145859200); #12/31/2037
1712 }
1713
1714 =item total_owed_date TIME
1715
1716 Returns the total owed for this customer on all invoices with date earlier than
1717 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
1718 see L<Time::Local> and L<Date::Parse> for conversion functions.
1719
1720 =cut
1721
1722 sub total_owed_date {
1723   my $self = shift;
1724   my $time = shift;
1725   my $total_bill = 0;
1726   foreach my $cust_bill (
1727     grep { $_->_date <= $time }
1728       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1729   ) {
1730     $total_bill += $cust_bill->owed;
1731   }
1732   sprintf( "%.2f", $total_bill );
1733 }
1734
1735 =item apply_credits
1736
1737 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1738 to outstanding invoice balances in chronological order and returns the value
1739 of any remaining unapplied credits available for refund
1740 (see L<FS::cust_refund>).
1741
1742 =cut
1743
1744 sub apply_credits {
1745   my $self = shift;
1746
1747   return 0 unless $self->total_credited;
1748
1749   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1750       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1751
1752   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1753       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1754
1755   my $credit;
1756
1757   foreach my $cust_bill ( @invoices ) {
1758     my $amount;
1759
1760     if ( !defined($credit) || $credit->credited == 0) {
1761       $credit = pop @credits or last;
1762     }
1763
1764     if ($cust_bill->owed >= $credit->credited) {
1765       $amount=$credit->credited;
1766     }else{
1767       $amount=$cust_bill->owed;
1768     }
1769
1770     my $cust_credit_bill = new FS::cust_credit_bill ( {
1771       'crednum' => $credit->crednum,
1772       'invnum'  => $cust_bill->invnum,
1773       'amount'  => $amount,
1774     } );
1775     my $error = $cust_credit_bill->insert;
1776     die $error if $error;
1777
1778     redo if ($cust_bill->owed > 0);
1779
1780   }
1781
1782   return $self->total_credited;
1783 }
1784
1785 =item apply_payments
1786
1787 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1788 to outstanding invoice balances in chronological order.
1789
1790  #and returns the value of any remaining unapplied payments.
1791
1792 =cut
1793
1794 sub apply_payments {
1795   my $self = shift;
1796
1797   #return 0 unless
1798
1799   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1800       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1801
1802   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1803       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1804
1805   my $payment;
1806
1807   foreach my $cust_bill ( @invoices ) {
1808     my $amount;
1809
1810     if ( !defined($payment) || $payment->unapplied == 0 ) {
1811       $payment = pop @payments or last;
1812     }
1813
1814     if ( $cust_bill->owed >= $payment->unapplied ) {
1815       $amount = $payment->unapplied;
1816     } else {
1817       $amount = $cust_bill->owed;
1818     }
1819
1820     my $cust_bill_pay = new FS::cust_bill_pay ( {
1821       'paynum' => $payment->paynum,
1822       'invnum' => $cust_bill->invnum,
1823       'amount' => $amount,
1824     } );
1825     my $error = $cust_bill_pay->insert;
1826     die $error if $error;
1827
1828     redo if ( $cust_bill->owed > 0);
1829
1830   }
1831
1832   return $self->total_unapplied_payments;
1833 }
1834
1835 =item total_credited
1836
1837 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1838 customer.  See L<FS::cust_credit/credited>.
1839
1840 =cut
1841
1842 sub total_credited {
1843   my $self = shift;
1844   my $total_credit = 0;
1845   foreach my $cust_credit ( qsearch('cust_credit', {
1846     'custnum' => $self->custnum,
1847   } ) ) {
1848     $total_credit += $cust_credit->credited;
1849   }
1850   sprintf( "%.2f", $total_credit );
1851 }
1852
1853 =item total_unapplied_payments
1854
1855 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1856 See L<FS::cust_pay/unapplied>.
1857
1858 =cut
1859
1860 sub total_unapplied_payments {
1861   my $self = shift;
1862   my $total_unapplied = 0;
1863   foreach my $cust_pay ( qsearch('cust_pay', {
1864     'custnum' => $self->custnum,
1865   } ) ) {
1866     $total_unapplied += $cust_pay->unapplied;
1867   }
1868   sprintf( "%.2f", $total_unapplied );
1869 }
1870
1871 =item balance
1872
1873 Returns the balance for this customer (total_owed minus total_credited
1874 minus total_unapplied_payments).
1875
1876 =cut
1877
1878 sub balance {
1879   my $self = shift;
1880   sprintf( "%.2f",
1881     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1882   );
1883 }
1884
1885 =item balance_date TIME
1886
1887 Returns the balance for this customer, only considering invoices with date
1888 earlier than TIME (total_owed_date minus total_credited minus
1889 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
1890 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
1891 functions.
1892
1893 =cut
1894
1895 sub balance_date {
1896   my $self = shift;
1897   my $time = shift;
1898   sprintf( "%.2f",
1899     $self->total_owed_date($time)
1900       - $self->total_credited
1901       - $self->total_unapplied_payments
1902   );
1903 }
1904
1905 =item invoicing_list [ ARRAYREF ]
1906
1907 If an arguement is given, sets these email addresses as invoice recipients
1908 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
1909 (except as warnings), so use check_invoicing_list first.
1910
1911 Returns a list of email addresses (with svcnum entries expanded).
1912
1913 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
1914 check it without disturbing anything by passing nothing.
1915
1916 This interface may change in the future.
1917
1918 =cut
1919
1920 sub invoicing_list {
1921   my( $self, $arrayref ) = @_;
1922   if ( $arrayref ) {
1923     my @cust_main_invoice;
1924     if ( $self->custnum ) {
1925       @cust_main_invoice =
1926         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1927     } else {
1928       @cust_main_invoice = ();
1929     }
1930     foreach my $cust_main_invoice ( @cust_main_invoice ) {
1931       #warn $cust_main_invoice->destnum;
1932       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1933         #warn $cust_main_invoice->destnum;
1934         my $error = $cust_main_invoice->delete;
1935         warn $error if $error;
1936       }
1937     }
1938     if ( $self->custnum ) {
1939       @cust_main_invoice =
1940         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1941     } else {
1942       @cust_main_invoice = ();
1943     }
1944     my %seen = map { $_->address => 1 } @cust_main_invoice;
1945     foreach my $address ( @{$arrayref} ) {
1946       next if exists $seen{$address} && $seen{$address};
1947       $seen{$address} = 1;
1948       my $cust_main_invoice = new FS::cust_main_invoice ( {
1949         'custnum' => $self->custnum,
1950         'dest'    => $address,
1951       } );
1952       my $error = $cust_main_invoice->insert;
1953       warn $error if $error;
1954     }
1955   }
1956   if ( $self->custnum ) {
1957     map { $_->address }
1958       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1959   } else {
1960     ();
1961   }
1962 }
1963
1964 =item check_invoicing_list ARRAYREF
1965
1966 Checks these arguements as valid input for the invoicing_list method.  If there
1967 is an error, returns the error, otherwise returns false.
1968
1969 =cut
1970
1971 sub check_invoicing_list {
1972   my( $self, $arrayref ) = @_;
1973   foreach my $address ( @{$arrayref} ) {
1974     my $cust_main_invoice = new FS::cust_main_invoice ( {
1975       'custnum' => $self->custnum,
1976       'dest'    => $address,
1977     } );
1978     my $error = $self->custnum
1979                 ? $cust_main_invoice->check
1980                 : $cust_main_invoice->checkdest
1981     ;
1982     return $error if $error;
1983   }
1984   '';
1985 }
1986
1987 =item set_default_invoicing_list
1988
1989 Sets the invoicing list to all accounts associated with this customer,
1990 overwriting any previous invoicing list.
1991
1992 =cut
1993
1994 sub set_default_invoicing_list {
1995   my $self = shift;
1996   $self->invoicing_list($self->all_emails);
1997 }
1998
1999 =item all_emails
2000
2001 Returns the email addresses of all accounts provisioned for this customer.
2002
2003 =cut
2004
2005 sub all_emails {
2006   my $self = shift;
2007   my %list;
2008   foreach my $cust_pkg ( $self->all_pkgs ) {
2009     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2010     my @svc_acct =
2011       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2012         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2013           @cust_svc;
2014     $list{$_}=1 foreach map { $_->email } @svc_acct;
2015   }
2016   keys %list;
2017 }
2018
2019 =item invoicing_list_addpost
2020
2021 Adds postal invoicing to this customer.  If this customer is already configured
2022 to receive postal invoices, does nothing.
2023
2024 =cut
2025
2026 sub invoicing_list_addpost {
2027   my $self = shift;
2028   return if grep { $_ eq 'POST' } $self->invoicing_list;
2029   my @invoicing_list = $self->invoicing_list;
2030   push @invoicing_list, 'POST';
2031   $self->invoicing_list(\@invoicing_list);
2032 }
2033
2034 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2035
2036 Returns an array of customers referred by this customer (referral_custnum set
2037 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
2038 customers referred by customers referred by this customer and so on, inclusive.
2039 The default behavior is DEPTH 1 (no recursion).
2040
2041 =cut
2042
2043 sub referral_cust_main {
2044   my $self = shift;
2045   my $depth = @_ ? shift : 1;
2046   my $exclude = @_ ? shift : {};
2047
2048   my @cust_main =
2049     map { $exclude->{$_->custnum}++; $_; }
2050       grep { ! $exclude->{ $_->custnum } }
2051         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2052
2053   if ( $depth > 1 ) {
2054     push @cust_main,
2055       map { $_->referral_cust_main($depth-1, $exclude) }
2056         @cust_main;
2057   }
2058
2059   @cust_main;
2060 }
2061
2062 =item referral_cust_main_ncancelled
2063
2064 Same as referral_cust_main, except only returns customers with uncancelled
2065 packages.
2066
2067 =cut
2068
2069 sub referral_cust_main_ncancelled {
2070   my $self = shift;
2071   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2072 }
2073
2074 =item referral_cust_pkg [ DEPTH ]
2075
2076 Like referral_cust_main, except returns a flat list of all unsuspended (and
2077 uncancelled) packages for each customer.  The number of items in this list may
2078 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2079
2080 =cut
2081
2082 sub referral_cust_pkg {
2083   my $self = shift;
2084   my $depth = @_ ? shift : 1;
2085
2086   map { $_->unsuspended_pkgs }
2087     grep { $_->unsuspended_pkgs }
2088       $self->referral_cust_main($depth);
2089 }
2090
2091 =item credit AMOUNT, REASON
2092
2093 Applies a credit to this customer.  If there is an error, returns the error,
2094 otherwise returns false.
2095
2096 =cut
2097
2098 sub credit {
2099   my( $self, $amount, $reason ) = @_;
2100   my $cust_credit = new FS::cust_credit {
2101     'custnum' => $self->custnum,
2102     'amount'  => $amount,
2103     'reason'  => $reason,
2104   };
2105   $cust_credit->insert;
2106 }
2107
2108 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2109
2110 Creates a one-time charge for this customer.  If there is an error, returns
2111 the error, otherwise returns false.
2112
2113 =cut
2114
2115 sub charge {
2116   my ( $self, $amount ) = ( shift, shift );
2117   my $pkg      = @_ ? shift : 'One-time charge';
2118   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
2119   my $taxclass = @_ ? shift : '';
2120
2121   local $SIG{HUP} = 'IGNORE';
2122   local $SIG{INT} = 'IGNORE';
2123   local $SIG{QUIT} = 'IGNORE';
2124   local $SIG{TERM} = 'IGNORE';
2125   local $SIG{TSTP} = 'IGNORE';
2126   local $SIG{PIPE} = 'IGNORE';
2127
2128   my $oldAutoCommit = $FS::UID::AutoCommit;
2129   local $FS::UID::AutoCommit = 0;
2130   my $dbh = dbh;
2131
2132   my $part_pkg = new FS::part_pkg ( {
2133     'pkg'      => $pkg,
2134     'comment'  => $comment,
2135     'setup'    => $amount,
2136     'freq'     => 0,
2137     'recur'    => '0',
2138     'disabled' => 'Y',
2139     'taxclass' => $taxclass,
2140   } );
2141
2142   my $error = $part_pkg->insert;
2143   if ( $error ) {
2144     $dbh->rollback if $oldAutoCommit;
2145     return $error;
2146   }
2147
2148   my $pkgpart = $part_pkg->pkgpart;
2149   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2150   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2151     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2152     $error = $type_pkgs->insert;
2153     if ( $error ) {
2154       $dbh->rollback if $oldAutoCommit;
2155       return $error;
2156     }
2157   }
2158
2159   my $cust_pkg = new FS::cust_pkg ( {
2160     'custnum' => $self->custnum,
2161     'pkgpart' => $pkgpart,
2162   } );
2163
2164   $error = $cust_pkg->insert;
2165   if ( $error ) {
2166     $dbh->rollback if $oldAutoCommit;
2167     return $error;
2168   }
2169
2170   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2171   '';
2172
2173 }
2174
2175 =item cust_bill
2176
2177 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2178
2179 =cut
2180
2181 sub cust_bill {
2182   my $self = shift;
2183   sort { $a->_date <=> $b->_date }
2184     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2185 }
2186
2187 =item open_cust_bill
2188
2189 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2190 customer.
2191
2192 =cut
2193
2194 sub open_cust_bill {
2195   my $self = shift;
2196   grep { $_->owed > 0 } $self->cust_bill;
2197 }
2198
2199 =back
2200
2201 =head1 SUBROUTINES
2202
2203 =over 4
2204
2205 =item check_and_rebuild_fuzzyfiles
2206
2207 =cut
2208
2209 sub check_and_rebuild_fuzzyfiles {
2210   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2211   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2212     or &rebuild_fuzzyfiles;
2213 }
2214
2215 =item rebuild_fuzzyfiles
2216
2217 =cut
2218
2219 sub rebuild_fuzzyfiles {
2220
2221   use Fcntl qw(:flock);
2222
2223   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2224
2225   #last
2226
2227   open(LASTLOCK,">>$dir/cust_main.last")
2228     or die "can't open $dir/cust_main.last: $!";
2229   flock(LASTLOCK,LOCK_EX)
2230     or die "can't lock $dir/cust_main.last: $!";
2231
2232   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2233   push @all_last,
2234                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2235     if defined dbdef->table('cust_main')->column('ship_last');
2236
2237   open (LASTCACHE,">$dir/cust_main.last.tmp")
2238     or die "can't open $dir/cust_main.last.tmp: $!";
2239   print LASTCACHE join("\n", @all_last), "\n";
2240   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2241
2242   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2243   close LASTLOCK;
2244
2245   #company
2246
2247   open(COMPANYLOCK,">>$dir/cust_main.company")
2248     or die "can't open $dir/cust_main.company: $!";
2249   flock(COMPANYLOCK,LOCK_EX)
2250     or die "can't lock $dir/cust_main.company: $!";
2251
2252   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2253   push @all_company,
2254        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2255     if defined dbdef->table('cust_main')->column('ship_last');
2256
2257   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2258     or die "can't open $dir/cust_main.company.tmp: $!";
2259   print COMPANYCACHE join("\n", @all_company), "\n";
2260   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2261
2262   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2263   close COMPANYLOCK;
2264
2265 }
2266
2267 =item all_last
2268
2269 =cut
2270
2271 sub all_last {
2272   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2273   open(LASTCACHE,"<$dir/cust_main.last")
2274     or die "can't open $dir/cust_main.last: $!";
2275   my @array = map { chomp; $_; } <LASTCACHE>;
2276   close LASTCACHE;
2277   \@array;
2278 }
2279
2280 =item all_company
2281
2282 =cut
2283
2284 sub all_company {
2285   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2286   open(COMPANYCACHE,"<$dir/cust_main.company")
2287     or die "can't open $dir/cust_main.last: $!";
2288   my @array = map { chomp; $_; } <COMPANYCACHE>;
2289   close COMPANYCACHE;
2290   \@array;
2291 }
2292
2293 =item append_fuzzyfiles LASTNAME COMPANY
2294
2295 =cut
2296
2297 sub append_fuzzyfiles {
2298   my( $last, $company ) = @_;
2299
2300   &check_and_rebuild_fuzzyfiles;
2301
2302   use Fcntl qw(:flock);
2303
2304   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2305
2306   if ( $last ) {
2307
2308     open(LAST,">>$dir/cust_main.last")
2309       or die "can't open $dir/cust_main.last: $!";
2310     flock(LAST,LOCK_EX)
2311       or die "can't lock $dir/cust_main.last: $!";
2312
2313     print LAST "$last\n";
2314
2315     flock(LAST,LOCK_UN)
2316       or die "can't unlock $dir/cust_main.last: $!";
2317     close LAST;
2318   }
2319
2320   if ( $company ) {
2321
2322     open(COMPANY,">>$dir/cust_main.company")
2323       or die "can't open $dir/cust_main.company: $!";
2324     flock(COMPANY,LOCK_EX)
2325       or die "can't lock $dir/cust_main.company: $!";
2326
2327     print COMPANY "$company\n";
2328
2329     flock(COMPANY,LOCK_UN)
2330       or die "can't unlock $dir/cust_main.company: $!";
2331
2332     close COMPANY;
2333   }
2334
2335   1;
2336 }
2337
2338 =item batch_import
2339
2340 =cut
2341
2342 sub batch_import {
2343   my $param = shift;
2344   #warn join('-',keys %$param);
2345   my $fh = $param->{filehandle};
2346   my $agentnum = $param->{agentnum};
2347   my $refnum = $param->{refnum};
2348   my $pkgpart = $param->{pkgpart};
2349   my @fields = @{$param->{fields}};
2350
2351   eval "use Date::Parse;";
2352   die $@ if $@;
2353   eval "use Text::CSV_XS;";
2354   die $@ if $@;
2355
2356   my $csv = new Text::CSV_XS;
2357   #warn $csv;
2358   #warn $fh;
2359
2360   my $imported = 0;
2361   #my $columns;
2362
2363   local $SIG{HUP} = 'IGNORE';
2364   local $SIG{INT} = 'IGNORE';
2365   local $SIG{QUIT} = 'IGNORE';
2366   local $SIG{TERM} = 'IGNORE';
2367   local $SIG{TSTP} = 'IGNORE';
2368   local $SIG{PIPE} = 'IGNORE';
2369
2370   my $oldAutoCommit = $FS::UID::AutoCommit;
2371   local $FS::UID::AutoCommit = 0;
2372   my $dbh = dbh;
2373
2374   #while ( $columns = $csv->getline($fh) ) {
2375   my $line;
2376   while ( defined($line=<$fh>) ) {
2377
2378     $csv->parse($line) or do {
2379       $dbh->rollback if $oldAutoCommit;
2380       return "can't parse: ". $csv->error_input();
2381     };
2382
2383     my @columns = $csv->fields();
2384     #warn join('-',@columns);
2385
2386     my %cust_main = (
2387       agentnum => $agentnum,
2388       refnum   => $refnum,
2389       country  => 'US', #default
2390       payby    => 'BILL', #default
2391       paydate  => '12/2037', #default
2392     );
2393     my $billtime = time;
2394     my %cust_pkg = ( pkgpart => $pkgpart );
2395     foreach my $field ( @fields ) {
2396       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2397         #$cust_pkg{$1} = str2time( shift @$columns );
2398         if ( $1 eq 'setup' ) {
2399           $billtime = str2time(shift @columns);
2400         } else {
2401           $cust_pkg{$1} = str2time( shift @columns );
2402         }
2403       } else {
2404         #$cust_main{$field} = shift @$columns;
2405         $cust_main{$field} = shift @columns;
2406       }
2407     }
2408
2409     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2410     my $cust_main = new FS::cust_main ( \%cust_main );
2411     use Tie::RefHash;
2412     tie my %hash, 'Tie::RefHash'; #this part is important
2413     $hash{$cust_pkg} = [] if $pkgpart;
2414     my $error = $cust_main->insert( \%hash );
2415
2416     if ( $error ) {
2417       $dbh->rollback if $oldAutoCommit;
2418       return "can't insert customer for $line: $error";
2419     }
2420
2421     #false laziness w/bill.cgi
2422     $error = $cust_main->bill( 'time' => $billtime );
2423     if ( $error ) {
2424       $dbh->rollback if $oldAutoCommit;
2425       return "can't bill customer for $line: $error";
2426     }
2427
2428     $cust_main->apply_payments;
2429     $cust_main->apply_credits;
2430
2431     $error = $cust_main->collect();
2432     if ( $error ) {
2433       $dbh->rollback if $oldAutoCommit;
2434       return "can't collect customer for $line: $error";
2435     }
2436
2437     $imported++;
2438   }
2439
2440   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2441
2442   return "Empty file!" unless $imported;
2443
2444   ''; #no error
2445
2446 }
2447
2448 =item batch_charge
2449
2450 =cut
2451
2452 sub batch_charge {
2453   my $param = shift;
2454   #warn join('-',keys %$param);
2455   my $fh = $param->{filehandle};
2456   my @fields = @{$param->{fields}};
2457
2458   eval "use Date::Parse;";
2459   die $@ if $@;
2460   eval "use Text::CSV_XS;";
2461   die $@ if $@;
2462
2463   my $csv = new Text::CSV_XS;
2464   #warn $csv;
2465   #warn $fh;
2466
2467   my $imported = 0;
2468   #my $columns;
2469
2470   local $SIG{HUP} = 'IGNORE';
2471   local $SIG{INT} = 'IGNORE';
2472   local $SIG{QUIT} = 'IGNORE';
2473   local $SIG{TERM} = 'IGNORE';
2474   local $SIG{TSTP} = 'IGNORE';
2475   local $SIG{PIPE} = 'IGNORE';
2476
2477   my $oldAutoCommit = $FS::UID::AutoCommit;
2478   local $FS::UID::AutoCommit = 0;
2479   my $dbh = dbh;
2480
2481   #while ( $columns = $csv->getline($fh) ) {
2482   my $line;
2483   while ( defined($line=<$fh>) ) {
2484
2485     $csv->parse($line) or do {
2486       $dbh->rollback if $oldAutoCommit;
2487       return "can't parse: ". $csv->error_input();
2488     };
2489
2490     my @columns = $csv->fields();
2491     #warn join('-',@columns);
2492
2493     my %row = ();
2494     foreach my $field ( @fields ) {
2495       $row{$field} = shift @columns;
2496     }
2497
2498     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2499     unless ( $cust_main ) {
2500       $dbh->rollback if $oldAutoCommit;
2501       return "unknown custnum $row{'custnum'}";
2502     }
2503
2504     if ( $row{'amount'} > 0 ) {
2505       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2506       if ( $error ) {
2507         $dbh->rollback if $oldAutoCommit;
2508         return $error;
2509       }
2510       $imported++;
2511     } elsif ( $row{'amount'} < 0 ) {
2512       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2513                                       $row{'pkg'}                         );
2514       if ( $error ) {
2515         $dbh->rollback if $oldAutoCommit;
2516         return $error;
2517       }
2518       $imported++;
2519     } else {
2520       #hmm?
2521     }
2522
2523   }
2524
2525   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2526
2527   return "Empty file!" unless $imported;
2528
2529   ''; #no error
2530
2531 }
2532
2533 =back
2534
2535 =head1 BUGS
2536
2537 The delete method.
2538
2539 The delete method should possibly take an FS::cust_main object reference
2540 instead of a scalar customer number.
2541
2542 Bill and collect options should probably be passed as references instead of a
2543 list.
2544
2545 There should probably be a configuration file with a list of allowed credit
2546 card types.
2547
2548 No multiple currency support (probably a larger project than just this module).
2549
2550 =head1 SEE ALSO
2551
2552 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2553 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2554 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
2555
2556 =cut
2557
2558 1;
2559