FS/FS/cust_main.pm

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