FS/FS/cust_main.pm

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