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') > 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       $mon += $part_pkg->freq;
1131       until ( $mon < 12 ) { $mon -= 12; $year++; }
1132       $cust_pkg->setfield('bill',
1133         timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1134       $cust_pkg_mod_flag = 1;
1135     }
1136
1137     warn "\$setup is undefined" unless defined($setup);
1138     warn "\$recur is undefined" unless defined($recur);
1139     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1140
1141     if ( $cust_pkg_mod_flag ) {
1142       $error=$cust_pkg->replace($old_cust_pkg);
1143       if ( $error ) { #just in case
1144         $dbh->rollback if $oldAutoCommit;
1145         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1146       }
1147       $setup = sprintf( "%.2f", $setup );
1148       $recur = sprintf( "%.2f", $recur );
1149       if ( $setup < 0 ) {
1150         $dbh->rollback if $oldAutoCommit;
1151         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1152       }
1153       if ( $recur < 0 ) {
1154         $dbh->rollback if $oldAutoCommit;
1155         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1156       }
1157       if ( $setup > 0 || $recur > 0 ) {
1158         my $cust_bill_pkg = new FS::cust_bill_pkg ({
1159           'pkgnum'  => $cust_pkg->pkgnum,
1160           'setup'   => $setup,
1161           'recur'   => $recur,
1162           'sdate'   => $sdate,
1163           'edate'   => $cust_pkg->bill,
1164           'details' => \@details,
1165         });
1166         push @cust_bill_pkg, $cust_bill_pkg;
1167         $total_setup += $setup;
1168         $total_recur += $recur;
1169
1170         unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1171
1172           my @taxes = qsearch( 'cust_main_county', {
1173                                  'state'    => $self->state,
1174                                  'county'   => $self->county,
1175                                  'country'  => $self->country,
1176                                  'taxclass' => $part_pkg->taxclass,
1177                                                                       } );
1178           unless ( @taxes ) {
1179             @taxes =  qsearch( 'cust_main_county', {
1180                                   'state'    => $self->state,
1181                                   'county'   => $self->county,
1182                                   'country'  => $self->country,
1183                                   'taxclass' => '',
1184                                                                       } );
1185           }
1186
1187           # maybe eliminate this entirely, along with all the 0% records
1188           unless ( @taxes ) {
1189             $dbh->rollback if $oldAutoCommit;
1190             return
1191               "fatal: can't find tax rate for state/county/country/taxclass ".
1192               join('/', ( map $self->$_(), qw(state county country) ),
1193                         $part_pkg->taxclass ).  "\n";
1194           }
1195
1196           foreach my $tax ( @taxes ) {
1197
1198             my $taxable_charged = 0;
1199             $taxable_charged += $setup
1200               unless $part_pkg->setuptax =~ /^Y$/i
1201                   || $tax->setuptax =~ /^Y$/i;
1202             $taxable_charged += $recur
1203               unless $part_pkg->recurtax =~ /^Y$/i
1204                   || $tax->recurtax =~ /^Y$/i;
1205             next unless $taxable_charged;
1206
1207             if ( $tax->exempt_amount ) {
1208               my ($mon,$year) = (localtime($sdate) )[4,5];
1209               $mon++;
1210               my $freq = $part_pkg->freq || 1;
1211               my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1212               foreach my $which_month ( 1 .. $freq ) {
1213                 my %hash = (
1214                   'custnum' => $self->custnum,
1215                   'taxnum'  => $tax->taxnum,
1216                   'year'    => 1900+$year,
1217                   'month'   => $mon++,
1218                 );
1219                 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1220                 until ( $mon < 13 ) { $mon -= 12; $year++; }
1221                 my $cust_tax_exempt =
1222                   qsearchs('cust_tax_exempt', \%hash)
1223                   || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1224                 my $remaining_exemption = sprintf("%.2f",
1225                   $tax->exempt_amount - $cust_tax_exempt->amount );
1226                 if ( $remaining_exemption > 0 ) {
1227                   my $addl = $remaining_exemption > $taxable_per_month
1228                     ? $taxable_per_month
1229                     : $remaining_exemption;
1230                   $taxable_charged -= $addl;
1231                   my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1232                     $cust_tax_exempt->hash,
1233                     'amount' =>
1234                       sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1235                   } );
1236                   $error = $new_cust_tax_exempt->exemptnum
1237                     ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1238                     : $new_cust_tax_exempt->insert;
1239                   if ( $error ) {
1240                     $dbh->rollback if $oldAutoCommit;
1241                     return "fatal: can't update cust_tax_exempt: $error";
1242                   }
1243
1244                 } # if $remaining_exemption > 0
1245
1246               } #foreach $which_month
1247
1248             } #if $tax->exempt_amount
1249
1250             $taxable_charged = sprintf( "%.2f", $taxable_charged);
1251
1252             #$tax += $taxable_charged * $cust_main_county->tax / 100
1253             $tax{ $tax->taxname || 'Tax' } +=
1254               $taxable_charged * $tax->tax / 100
1255
1256           } #foreach my $tax ( @taxes )
1257
1258         } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1259
1260       } #if $setup > 0 || $recur > 0
1261
1262     } #if $cust_pkg_mod_flag
1263
1264   } #foreach my $cust_pkg
1265
1266   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1267 #  my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1268
1269   unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1270     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1271     return '';
1272   }
1273
1274 #  unless ( $self->tax =~ /Y/i
1275 #           || $self->payby eq 'COMP'
1276 #           || $taxable_charged == 0 ) {
1277 #    my $cust_main_county = qsearchs('cust_main_county',{
1278 #        'state'   => $self->state,
1279 #        'county'  => $self->county,
1280 #        'country' => $self->country,
1281 #    } ) or die "fatal: can't find tax rate for state/county/country ".
1282 #               $self->state. "/". $self->county. "/". $self->country. "\n";
1283 #    my $tax = sprintf( "%.2f",
1284 #      $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1285 #    );
1286
1287   if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1288
1289     foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1290       my $tax = sprintf("%.2f", $tax{$taxname} );
1291       $charged = sprintf( "%.2f", $charged+$tax );
1292
1293       my $cust_bill_pkg = new FS::cust_bill_pkg ({
1294         'pkgnum'   => 0,
1295         'setup'    => $tax,
1296         'recur'    => 0,
1297         'sdate'    => '',
1298         'edate'    => '',
1299         'itemdesc' => $taxname,
1300       });
1301       push @cust_bill_pkg, $cust_bill_pkg;
1302     }
1303
1304   } else { #1.4 schema
1305
1306     my $tax = 0;
1307     foreach ( values %tax ) { $tax += $_ };
1308     $tax = sprintf("%.2f", $tax);
1309     if ( $tax > 0 ) {
1310       $charged = sprintf( "%.2f", $charged+$tax );
1311
1312       my $cust_bill_pkg = new FS::cust_bill_pkg ({
1313         'pkgnum' => 0,
1314         'setup'  => $tax,
1315         'recur'  => 0,
1316         'sdate'  => '',
1317         'edate'  => '',
1318       });
1319       push @cust_bill_pkg, $cust_bill_pkg;
1320     }
1321
1322   }
1323
1324   my $cust_bill = new FS::cust_bill ( {
1325     'custnum' => $self->custnum,
1326     '_date'   => $time,
1327     'charged' => $charged,
1328   } );
1329   $error = $cust_bill->insert;
1330   if ( $error ) {
1331     $dbh->rollback if $oldAutoCommit;
1332     return "can't create invoice for customer #". $self->custnum. ": $error";
1333   }
1334
1335   my $invnum = $cust_bill->invnum;
1336   my $cust_bill_pkg;
1337   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1338     #warn $invnum;
1339     $cust_bill_pkg->invnum($invnum);
1340     $error = $cust_bill_pkg->insert;
1341     if ( $error ) {
1342       $dbh->rollback if $oldAutoCommit;
1343       return "can't create invoice line item for customer #". $self->custnum.
1344              ": $error";
1345     }
1346   }
1347
1348   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1349   ''; #no error
1350 }
1351
1352 =item collect OPTIONS
1353
1354 (Attempt to) collect money for this customer's outstanding invoices (see
1355 L<FS::cust_bill>).  Usually used after the bill method.
1356
1357 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1358 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1359 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1360
1361 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1362 and the invoice events web interface.
1363
1364 If there is an error, returns the error, otherwise returns false.
1365
1366 Options are passed as name-value pairs.
1367
1368 Currently available options are:
1369
1370 invoice_time - Use this time when deciding when to print invoices and
1371 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>
1372 for conversion functions.
1373
1374 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1375 events.
1376
1377 retry_card - Deprecated alias for 'retry'
1378
1379 batch_card - This option is deprecated.  See the invoice events web interface
1380 to control whether cards are batched or run against a realtime gateway.
1381
1382 report_badcard - This option is deprecated.
1383
1384 force_print - This option is deprecated; see the invoice events web interface.
1385
1386 quiet - set true to surpress email card/ACH decline notices.
1387
1388 =cut
1389
1390 sub collect {
1391   my( $self, %options ) = @_;
1392   my $invoice_time = $options{'invoice_time'} || time;
1393
1394   #put below somehow?
1395   local $SIG{HUP} = 'IGNORE';
1396   local $SIG{INT} = 'IGNORE';
1397   local $SIG{QUIT} = 'IGNORE';
1398   local $SIG{TERM} = 'IGNORE';
1399   local $SIG{TSTP} = 'IGNORE';
1400   local $SIG{PIPE} = 'IGNORE';
1401
1402   my $oldAutoCommit = $FS::UID::AutoCommit;
1403   local $FS::UID::AutoCommit = 0;
1404   my $dbh = dbh;
1405
1406   my $balance = $self->balance;
1407   warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1408   unless ( $balance > 0 ) { #redundant?????
1409     $dbh->rollback if $oldAutoCommit; #hmm
1410     return '';
1411   }
1412
1413   if ( exists($options{'retry_card'}) ) {
1414     carp 'retry_card option passed to collect is deprecated; use retry';
1415     $options{'retry'} ||= $options{'retry_card'};
1416   }
1417   if ( exists($options{'retry'}) && $options{'retry'} ) {
1418     my $error = $self->retry_realtime;
1419     if ( $error ) {
1420       $dbh->rollback if $oldAutoCommit;
1421       return $error;
1422     }
1423   }
1424
1425   foreach my $cust_bill ( $self->cust_bill ) {
1426
1427     #this has to be before next's
1428     my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1429                                   ? $balance
1430                                   : $cust_bill->owed
1431     );
1432     $balance = sprintf( "%.2f", $balance - $amount );
1433
1434     next unless $cust_bill->owed > 0;
1435
1436     # don't try to charge for the same invoice if it's already in a batch
1437     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1438
1439     warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1440
1441     next unless $amount > 0;
1442
1443
1444     foreach my $part_bill_event (
1445       sort {    $a->seconds   <=> $b->seconds
1446              || $a->weight    <=> $b->weight
1447              || $a->eventpart <=> $b->eventpart }
1448         grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1449                && ! qsearchs( 'cust_bill_event', {
1450                                 'invnum'    => $cust_bill->invnum,
1451                                 'eventpart' => $_->eventpart,
1452                                 'status'    => 'done',
1453                                                                    } )
1454              }
1455           qsearch('part_bill_event', { 'payby'    => $self->payby,
1456                                        'disabled' => '',           } )
1457     ) {
1458
1459       last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1460
1461       warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1462         if $Debug;
1463       my $cust_main = $self; #for callback
1464
1465       my $error;
1466       {
1467         local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1468         $error = eval $part_bill_event->eventcode;
1469       }
1470
1471       my $status = '';
1472       my $statustext = '';
1473       if ( $@ ) {
1474         $status = 'failed';
1475         $statustext = $@;
1476       } elsif ( $error ) {
1477         $status = 'done';
1478         $statustext = $error;
1479       } else {
1480         $status = 'done'
1481       }
1482
1483       #add cust_bill_event
1484       my $cust_bill_event = new FS::cust_bill_event {
1485         'invnum'     => $cust_bill->invnum,
1486         'eventpart'  => $part_bill_event->eventpart,
1487         #'_date'      => $invoice_time,
1488         '_date'      => time,
1489         'status'     => $status,
1490         'statustext' => $statustext,
1491       };
1492       $error = $cust_bill_event->insert;
1493       if ( $error ) {
1494         #$dbh->rollback if $oldAutoCommit;
1495         #return "error: $error";
1496
1497         # gah, even with transactions.
1498         $dbh->commit if $oldAutoCommit; #well.
1499         my $e = 'WARNING: Event run but database not updated - '.
1500                 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1501                 ', eventpart '. $part_bill_event->eventpart.
1502                 ": $error";
1503         warn $e;
1504         return $e;
1505       }
1506
1507
1508     }
1509
1510   }
1511
1512   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1513   '';
1514
1515 }
1516
1517 =item retry_realtime
1518
1519 Schedules realtime credit card / electronic check / LEC billing events for
1520 for retry.  Useful if card information has changed or manual retry is desired.
1521 The 'collect' method must be called to actually retry the transaction.
1522
1523 Implementation details: For each of this customer's open invoices, changes
1524 the status of the first "done" (with statustext error) realtime processing
1525 event to "failed".
1526
1527 =cut
1528
1529 sub retry_realtime {
1530   my $self = shift;
1531
1532   local $SIG{HUP} = 'IGNORE';
1533   local $SIG{INT} = 'IGNORE';
1534   local $SIG{QUIT} = 'IGNORE';
1535   local $SIG{TERM} = 'IGNORE';
1536   local $SIG{TSTP} = 'IGNORE';
1537   local $SIG{PIPE} = 'IGNORE';
1538
1539   my $oldAutoCommit = $FS::UID::AutoCommit;
1540   local $FS::UID::AutoCommit = 0;
1541   my $dbh = dbh;
1542
1543   foreach my $cust_bill (
1544     grep { $_->cust_bill_event }
1545       $self->open_cust_bill
1546   ) {
1547     my @cust_bill_event =
1548       sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1549         grep {
1550                #$_->part_bill_event->plan eq 'realtime-card'
1551                $_->part_bill_event->eventcode =~
1552                    /\$cust_bill\->realtime_(card|ach|lec)/
1553                  && $_->status eq 'done'
1554                  && $_->statustext
1555              }
1556           $cust_bill->cust_bill_event;
1557     next unless @cust_bill_event;
1558     my $error = $cust_bill_event[0]->retry;
1559     if ( $error ) {
1560       $dbh->rollback if $oldAutoCommit;
1561       return "error scheduling invoice event for retry: $error";
1562     }
1563
1564   }
1565
1566   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1567   '';
1568
1569 }
1570
1571 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1572
1573 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1574 via a Business::OnlinePayment realtime gateway.  See
1575 L<http://420.am/business-onlinepayment> for supported gateways.
1576
1577 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1578
1579 Available options are: I<description>, I<invnum>, I<quiet>
1580
1581 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1582 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
1583 if set, will override the value from the customer record.
1584
1585 I<description> is a free-text field passed to the gateway.  It defaults to
1586 "Internet services".
1587
1588 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1589 specified invoice.  If you don't specify an I<invnum> you might want to
1590 call the B<apply_payments> method.
1591
1592 I<quiet> can be set true to surpress email decline notices.
1593
1594 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1595
1596 =cut
1597
1598 sub realtime_bop {
1599   my( $self, $method, $amount, %options ) = @_;
1600   if ( $Debug ) {
1601     warn "$self $method $amount\n";
1602     warn "  $_ => $options{$_}\n" foreach keys %options;
1603   }
1604
1605   $options{'description'} ||= 'Internet services';
1606
1607   #pre-requisites
1608   die "Real-time processing not enabled\n"
1609     unless $conf->exists('business-onlinepayment');
1610   eval "use Business::OnlinePayment";
1611   die $@ if $@;
1612
1613   #overrides
1614   $self->set( $_ => $options{$_} )
1615     foreach grep { exists($options{$_}) }
1616             qw( payname address1 address2 city state zip payinfo paydate );
1617
1618   #load up config
1619   my $bop_config = 'business-onlinepayment';
1620   $bop_config .= '-ach'
1621     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1622   my ( $processor, $login, $password, $action, @bop_options ) =
1623     $conf->config($bop_config);
1624   $action ||= 'normal authorization';
1625   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1626
1627   #massage data
1628
1629   my $address = $self->address1;
1630   $address .= ", ". $self->address2 if $self->address2;
1631
1632   my($payname, $payfirst, $paylast);
1633   if ( $self->payname && $method ne 'ECHECK' ) {
1634     $payname = $self->payname;
1635     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1636       or return "Illegal payname $payname";
1637     ($payfirst, $paylast) = ($1, $2);
1638   } else {
1639     $payfirst = $self->getfield('first');
1640     $paylast = $self->getfield('last');
1641     $payname =  "$payfirst $paylast";
1642   }
1643
1644   my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1645   if ( $conf->exists('emailinvoiceauto')
1646        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1647     push @invoicing_list, $self->all_emails;
1648   }
1649   my $email = $invoicing_list[0];
1650
1651   my %content;
1652   if ( $method eq 'CC' ) {
1653     $content{card_number} = $self->payinfo;
1654     $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1655     $content{expiration} = "$2/$1";
1656     if ( qsearch('cust_pay', { 'custnum' => $self->custnum,
1657                                'payby'   => 'CARD',
1658                                'payinfo' => $self->payinfo, } )
1659     ) {
1660       $content{recurring_billing} = 'YES';
1661     }
1662   } elsif ( $method eq 'ECHECK' ) {
1663     my($account_number,$routing_code) = $self->payinfo;
1664     ( $content{account_number}, $content{routing_code} ) =
1665       split('@', $self->payinfo);
1666     $content{bank_name} = $self->payname;
1667     $content{account_type} = 'CHECKING';
1668     $content{account_name} = $payname;
1669     $content{customer_org} = $self->company ? 'B' : 'I';
1670     $content{customer_ssn} = $self->ss;
1671   } elsif ( $method eq 'LEC' ) {
1672     $content{phone} = $self->payinfo;
1673   }
1674
1675   #transaction(s)
1676
1677   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1678
1679   my $transaction =
1680     new Business::OnlinePayment( $processor, @bop_options );
1681   $transaction->content(
1682     'type'           => $method,
1683     'login'          => $login,
1684     'password'       => $password,
1685     'action'         => $action1,
1686     'description'    => $options{'description'},
1687     'amount'         => $amount,
1688     'invoice_number' => $options{'invnum'},
1689     'customer_id'    => $self->custnum,
1690     'last_name'      => $paylast,
1691     'first_name'     => $payfirst,
1692     'name'           => $payname,
1693     'address'        => $address,
1694     'city'           => $self->city,
1695     'state'          => $self->state,
1696     'zip'            => $self->zip,
1697     'country'        => $self->country,
1698     'referer'        => 'http://cleanwhisker.420.am/',
1699     'email'          => $email,
1700     'phone'          => $self->daytime || $self->night,
1701     %content, #after
1702   );
1703   $transaction->submit();
1704
1705   if ( $transaction->is_success() && $action2 ) {
1706     my $auth = $transaction->authorization;
1707     my $ordernum = $transaction->can('order_number')
1708                    ? $transaction->order_number
1709                    : '';
1710
1711     my $capture =
1712       new Business::OnlinePayment( $processor, @bop_options );
1713
1714     my %capture = (
1715       %content,
1716       type           => $method,
1717       action         => $action2,
1718       login          => $login,
1719       password       => $password,
1720       order_number   => $ordernum,
1721       amount         => $amount,
1722       authorization  => $auth,
1723       description    => $options{'description'},
1724     );
1725
1726     foreach my $field (qw( authorization_source_code returned_ACI                                          transaction_identifier validation_code
1727                            transaction_sequence_num local_transaction_date
1728                            local_transaction_time AVS_result_code          )) {
1729       $capture{$field} = $transaction->$field() if $transaction->can($field);
1730     }
1731
1732     $capture->content( %capture );
1733
1734     $capture->submit();
1735
1736     unless ( $capture->is_success ) {
1737       my $e = "Authorization sucessful but capture failed, custnum #".
1738               $self->custnum. ': '.  $capture->result_code.
1739               ": ". $capture->error_message;
1740       warn $e;
1741       return $e;
1742     }
1743
1744   }
1745
1746   #result handling
1747   if ( $transaction->is_success() ) {
1748
1749     my %method2payby = (
1750       'CC'     => 'CARD',
1751       'ECHECK' => 'CHEK',
1752       'LEC'    => 'LECB',
1753     );
1754
1755     my $cust_pay = new FS::cust_pay ( {
1756        'custnum'  => $self->custnum,
1757        'invnum'   => $options{'invnum'},
1758        'paid'     => $amount,
1759        '_date'     => '',
1760        'payby'    => $method2payby{$method},
1761        'payinfo'  => $self->payinfo,
1762        'paybatch' => "$processor:". $transaction->authorization,
1763     } );
1764     my $error = $cust_pay->insert;
1765     if ( $error ) {
1766       # gah, even with transactions.
1767       my $e = 'WARNING: Card/ACH debited but database not updated - '.
1768               'error applying payment, invnum #' . $self->invnum.
1769               " ($processor): $error";
1770       warn $e;
1771       return $e;
1772     } else {
1773       return '';
1774     }
1775
1776   } else {
1777
1778     my $perror = "$processor error: ". $transaction->error_message;
1779
1780     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1781          && $conf->exists('emaildecline')
1782          && grep { $_ ne 'POST' } $self->invoicing_list
1783          && ! grep { $_ eq $transaction->error_message }
1784                    $conf->config('emaildecline-exclude')
1785     ) {
1786       my @templ = $conf->config('declinetemplate');
1787       my $template = new Text::Template (
1788         TYPE   => 'ARRAY',
1789         SOURCE => [ map "$_\n", @templ ],
1790       ) or return "($perror) can't create template: $Text::Template::ERROR";
1791       $template->compile()
1792         or return "($perror) can't compile template: $Text::Template::ERROR";
1793
1794       my $templ_hash = { error => $transaction->error_message };
1795
1796       my $error = send_email(
1797         'from'    => $conf->config('invoice_from'),
1798         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1799         'subject' => 'Your payment could not be processed',
1800         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
1801       );
1802
1803       $perror .= " (also received error sending decline notification: $error)"
1804         if $error;
1805
1806     }
1807
1808     return $perror;
1809   }
1810
1811 }
1812
1813 =item total_owed
1814
1815 Returns the total owed for this customer on all invoices
1816 (see L<FS::cust_bill/owed>).
1817
1818 =cut
1819
1820 sub total_owed {
1821   my $self = shift;
1822   $self->total_owed_date(2145859200); #12/31/2037
1823 }
1824
1825 =item total_owed_date TIME
1826
1827 Returns the total owed for this customer on all invoices with date earlier than
1828 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
1829 see L<Time::Local> and L<Date::Parse> for conversion functions.
1830
1831 =cut
1832
1833 sub total_owed_date {
1834   my $self = shift;
1835   my $time = shift;
1836   my $total_bill = 0;
1837   foreach my $cust_bill (
1838     grep { $_->_date <= $time }
1839       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1840   ) {
1841     $total_bill += $cust_bill->owed;
1842   }
1843   sprintf( "%.2f", $total_bill );
1844 }
1845
1846 =item apply_credits
1847
1848 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1849 to outstanding invoice balances in chronological order and returns the value
1850 of any remaining unapplied credits available for refund
1851 (see L<FS::cust_refund>).
1852
1853 =cut
1854
1855 sub apply_credits {
1856   my $self = shift;
1857
1858   return 0 unless $self->total_credited;
1859
1860   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1861       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1862
1863   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1864       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1865
1866   my $credit;
1867
1868   foreach my $cust_bill ( @invoices ) {
1869     my $amount;
1870
1871     if ( !defined($credit) || $credit->credited == 0) {
1872       $credit = pop @credits or last;
1873     }
1874
1875     if ($cust_bill->owed >= $credit->credited) {
1876       $amount=$credit->credited;
1877     }else{
1878       $amount=$cust_bill->owed;
1879     }
1880
1881     my $cust_credit_bill = new FS::cust_credit_bill ( {
1882       'crednum' => $credit->crednum,
1883       'invnum'  => $cust_bill->invnum,
1884       'amount'  => $amount,
1885     } );
1886     my $error = $cust_credit_bill->insert;
1887     die $error if $error;
1888
1889     redo if ($cust_bill->owed > 0);
1890
1891   }
1892
1893   return $self->total_credited;
1894 }
1895
1896 =item apply_payments
1897
1898 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1899 to outstanding invoice balances in chronological order.
1900
1901  #and returns the value of any remaining unapplied payments.
1902
1903 =cut
1904
1905 sub apply_payments {
1906   my $self = shift;
1907
1908   #return 0 unless
1909
1910   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1911       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1912
1913   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1914       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1915
1916   my $payment;
1917
1918   foreach my $cust_bill ( @invoices ) {
1919     my $amount;
1920
1921     if ( !defined($payment) || $payment->unapplied == 0 ) {
1922       $payment = pop @payments or last;
1923     }
1924
1925     if ( $cust_bill->owed >= $payment->unapplied ) {
1926       $amount = $payment->unapplied;
1927     } else {
1928       $amount = $cust_bill->owed;
1929     }
1930
1931     my $cust_bill_pay = new FS::cust_bill_pay ( {
1932       'paynum' => $payment->paynum,
1933       'invnum' => $cust_bill->invnum,
1934       'amount' => $amount,
1935     } );
1936     my $error = $cust_bill_pay->insert;
1937     die $error if $error;
1938
1939     redo if ( $cust_bill->owed > 0);
1940
1941   }
1942
1943   return $self->total_unapplied_payments;
1944 }
1945
1946 =item total_credited
1947
1948 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1949 customer.  See L<FS::cust_credit/credited>.
1950
1951 =cut
1952
1953 sub total_credited {
1954   my $self = shift;
1955   my $total_credit = 0;
1956   foreach my $cust_credit ( qsearch('cust_credit', {
1957     'custnum' => $self->custnum,
1958   } ) ) {
1959     $total_credit += $cust_credit->credited;
1960   }
1961   sprintf( "%.2f", $total_credit );
1962 }
1963
1964 =item total_unapplied_payments
1965
1966 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1967 See L<FS::cust_pay/unapplied>.
1968
1969 =cut
1970
1971 sub total_unapplied_payments {
1972   my $self = shift;
1973   my $total_unapplied = 0;
1974   foreach my $cust_pay ( qsearch('cust_pay', {
1975     'custnum' => $self->custnum,
1976   } ) ) {
1977     $total_unapplied += $cust_pay->unapplied;
1978   }
1979   sprintf( "%.2f", $total_unapplied );
1980 }
1981
1982 =item balance
1983
1984 Returns the balance for this customer (total_owed minus total_credited
1985 minus total_unapplied_payments).
1986
1987 =cut
1988
1989 sub balance {
1990   my $self = shift;
1991   sprintf( "%.2f",
1992     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1993   );
1994 }
1995
1996 =item balance_date TIME
1997
1998 Returns the balance for this customer, only considering invoices with date
1999 earlier than TIME (total_owed_date minus total_credited minus
2000 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
2001 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
2002 functions.
2003
2004 =cut
2005
2006 sub balance_date {
2007   my $self = shift;
2008   my $time = shift;
2009   sprintf( "%.2f",
2010     $self->total_owed_date($time)
2011       - $self->total_credited
2012       - $self->total_unapplied_payments
2013   );
2014 }
2015
2016 =item invoicing_list [ ARRAYREF ]
2017
2018 If an arguement is given, sets these email addresses as invoice recipients
2019 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
2020 (except as warnings), so use check_invoicing_list first.
2021
2022 Returns a list of email addresses (with svcnum entries expanded).
2023
2024 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
2025 check it without disturbing anything by passing nothing.
2026
2027 This interface may change in the future.
2028
2029 =cut
2030
2031 sub invoicing_list {
2032   my( $self, $arrayref ) = @_;
2033   if ( $arrayref ) {
2034     my @cust_main_invoice;
2035     if ( $self->custnum ) {
2036       @cust_main_invoice =
2037         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2038     } else {
2039       @cust_main_invoice = ();
2040     }
2041     foreach my $cust_main_invoice ( @cust_main_invoice ) {
2042       #warn $cust_main_invoice->destnum;
2043       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2044         #warn $cust_main_invoice->destnum;
2045         my $error = $cust_main_invoice->delete;
2046         warn $error if $error;
2047       }
2048     }
2049     if ( $self->custnum ) {
2050       @cust_main_invoice =
2051         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2052     } else {
2053       @cust_main_invoice = ();
2054     }
2055     my %seen = map { $_->address => 1 } @cust_main_invoice;
2056     foreach my $address ( @{$arrayref} ) {
2057       next if exists $seen{$address} && $seen{$address};
2058       $seen{$address} = 1;
2059       my $cust_main_invoice = new FS::cust_main_invoice ( {
2060         'custnum' => $self->custnum,
2061         'dest'    => $address,
2062       } );
2063       my $error = $cust_main_invoice->insert;
2064       warn $error if $error;
2065     }
2066   }
2067   if ( $self->custnum ) {
2068     map { $_->address }
2069       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2070   } else {
2071     ();
2072   }
2073 }
2074
2075 =item check_invoicing_list ARRAYREF
2076
2077 Checks these arguements as valid input for the invoicing_list method.  If there
2078 is an error, returns the error, otherwise returns false.
2079
2080 =cut
2081
2082 sub check_invoicing_list {
2083   my( $self, $arrayref ) = @_;
2084   foreach my $address ( @{$arrayref} ) {
2085     my $cust_main_invoice = new FS::cust_main_invoice ( {
2086       'custnum' => $self->custnum,
2087       'dest'    => $address,
2088     } );
2089     my $error = $self->custnum
2090                 ? $cust_main_invoice->check
2091                 : $cust_main_invoice->checkdest
2092     ;
2093     return $error if $error;
2094   }
2095   '';
2096 }
2097
2098 =item set_default_invoicing_list
2099
2100 Sets the invoicing list to all accounts associated with this customer,
2101 overwriting any previous invoicing list.
2102
2103 =cut
2104
2105 sub set_default_invoicing_list {
2106   my $self = shift;
2107   $self->invoicing_list($self->all_emails);
2108 }
2109
2110 =item all_emails
2111
2112 Returns the email addresses of all accounts provisioned for this customer.
2113
2114 =cut
2115
2116 sub all_emails {
2117   my $self = shift;
2118   my %list;
2119   foreach my $cust_pkg ( $self->all_pkgs ) {
2120     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2121     my @svc_acct =
2122       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2123         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2124           @cust_svc;
2125     $list{$_}=1 foreach map { $_->email } @svc_acct;
2126   }
2127   keys %list;
2128 }
2129
2130 =item invoicing_list_addpost
2131
2132 Adds postal invoicing to this customer.  If this customer is already configured
2133 to receive postal invoices, does nothing.
2134
2135 =cut
2136
2137 sub invoicing_list_addpost {
2138   my $self = shift;
2139   return if grep { $_ eq 'POST' } $self->invoicing_list;
2140   my @invoicing_list = $self->invoicing_list;
2141   push @invoicing_list, 'POST';
2142   $self->invoicing_list(\@invoicing_list);
2143 }
2144
2145 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2146
2147 Returns an array of customers referred by this customer (referral_custnum set
2148 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
2149 customers referred by customers referred by this customer and so on, inclusive.
2150 The default behavior is DEPTH 1 (no recursion).
2151
2152 =cut
2153
2154 sub referral_cust_main {
2155   my $self = shift;
2156   my $depth = @_ ? shift : 1;
2157   my $exclude = @_ ? shift : {};
2158
2159   my @cust_main =
2160     map { $exclude->{$_->custnum}++; $_; }
2161       grep { ! $exclude->{ $_->custnum } }
2162         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2163
2164   if ( $depth > 1 ) {
2165     push @cust_main,
2166       map { $_->referral_cust_main($depth-1, $exclude) }
2167         @cust_main;
2168   }
2169
2170   @cust_main;
2171 }
2172
2173 =item referral_cust_main_ncancelled
2174
2175 Same as referral_cust_main, except only returns customers with uncancelled
2176 packages.
2177
2178 =cut
2179
2180 sub referral_cust_main_ncancelled {
2181   my $self = shift;
2182   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2183 }
2184
2185 =item referral_cust_pkg [ DEPTH ]
2186
2187 Like referral_cust_main, except returns a flat list of all unsuspended (and
2188 uncancelled) packages for each customer.  The number of items in this list may
2189 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2190
2191 =cut
2192
2193 sub referral_cust_pkg {
2194   my $self = shift;
2195   my $depth = @_ ? shift : 1;
2196
2197   map { $_->unsuspended_pkgs }
2198     grep { $_->unsuspended_pkgs }
2199       $self->referral_cust_main($depth);
2200 }
2201
2202 =item credit AMOUNT, REASON
2203
2204 Applies a credit to this customer.  If there is an error, returns the error,
2205 otherwise returns false.
2206
2207 =cut
2208
2209 sub credit {
2210   my( $self, $amount, $reason ) = @_;
2211   my $cust_credit = new FS::cust_credit {
2212     'custnum' => $self->custnum,
2213     'amount'  => $amount,
2214     'reason'  => $reason,
2215   };
2216   $cust_credit->insert;
2217 }
2218
2219 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2220
2221 Creates a one-time charge for this customer.  If there is an error, returns
2222 the error, otherwise returns false.
2223
2224 =cut
2225
2226 sub charge {
2227   my ( $self, $amount ) = ( shift, shift );
2228   my $pkg      = @_ ? shift : 'One-time charge';
2229   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
2230   my $taxclass = @_ ? shift : '';
2231
2232   local $SIG{HUP} = 'IGNORE';
2233   local $SIG{INT} = 'IGNORE';
2234   local $SIG{QUIT} = 'IGNORE';
2235   local $SIG{TERM} = 'IGNORE';
2236   local $SIG{TSTP} = 'IGNORE';
2237   local $SIG{PIPE} = 'IGNORE';
2238
2239   my $oldAutoCommit = $FS::UID::AutoCommit;
2240   local $FS::UID::AutoCommit = 0;
2241   my $dbh = dbh;
2242
2243   my $part_pkg = new FS::part_pkg ( {
2244     'pkg'      => $pkg,
2245     'comment'  => $comment,
2246     'setup'    => $amount,
2247     'freq'     => 0,
2248     'recur'    => '0',
2249     'disabled' => 'Y',
2250     'taxclass' => $taxclass,
2251   } );
2252
2253   my $error = $part_pkg->insert;
2254   if ( $error ) {
2255     $dbh->rollback if $oldAutoCommit;
2256     return $error;
2257   }
2258
2259   my $pkgpart = $part_pkg->pkgpart;
2260   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2261   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2262     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2263     $error = $type_pkgs->insert;
2264     if ( $error ) {
2265       $dbh->rollback if $oldAutoCommit;
2266       return $error;
2267     }
2268   }
2269
2270   my $cust_pkg = new FS::cust_pkg ( {
2271     'custnum' => $self->custnum,
2272     'pkgpart' => $pkgpart,
2273   } );
2274
2275   $error = $cust_pkg->insert;
2276   if ( $error ) {
2277     $dbh->rollback if $oldAutoCommit;
2278     return $error;
2279   }
2280
2281   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2282   '';
2283
2284 }
2285
2286 =item cust_bill
2287
2288 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2289
2290 =cut
2291
2292 sub cust_bill {
2293   my $self = shift;
2294   sort { $a->_date <=> $b->_date }
2295     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2296 }
2297
2298 =item open_cust_bill
2299
2300 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2301 customer.
2302
2303 =cut
2304
2305 sub open_cust_bill {
2306   my $self = shift;
2307   grep { $_->owed > 0 } $self->cust_bill;
2308 }
2309
2310 =back
2311
2312 =head1 SUBROUTINES
2313
2314 =over 4
2315
2316 =item check_and_rebuild_fuzzyfiles
2317
2318 =cut
2319
2320 sub check_and_rebuild_fuzzyfiles {
2321   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2322   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2323     or &rebuild_fuzzyfiles;
2324 }
2325
2326 =item rebuild_fuzzyfiles
2327
2328 =cut
2329
2330 sub rebuild_fuzzyfiles {
2331
2332   use Fcntl qw(:flock);
2333
2334   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2335
2336   #last
2337
2338   open(LASTLOCK,">>$dir/cust_main.last")
2339     or die "can't open $dir/cust_main.last: $!";
2340   flock(LASTLOCK,LOCK_EX)
2341     or die "can't lock $dir/cust_main.last: $!";
2342
2343   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2344   push @all_last,
2345                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2346     if defined dbdef->table('cust_main')->column('ship_last');
2347
2348   open (LASTCACHE,">$dir/cust_main.last.tmp")
2349     or die "can't open $dir/cust_main.last.tmp: $!";
2350   print LASTCACHE join("\n", @all_last), "\n";
2351   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2352
2353   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2354   close LASTLOCK;
2355
2356   #company
2357
2358   open(COMPANYLOCK,">>$dir/cust_main.company")
2359     or die "can't open $dir/cust_main.company: $!";
2360   flock(COMPANYLOCK,LOCK_EX)
2361     or die "can't lock $dir/cust_main.company: $!";
2362
2363   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2364   push @all_company,
2365        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2366     if defined dbdef->table('cust_main')->column('ship_last');
2367
2368   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2369     or die "can't open $dir/cust_main.company.tmp: $!";
2370   print COMPANYCACHE join("\n", @all_company), "\n";
2371   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2372
2373   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2374   close COMPANYLOCK;
2375
2376 }
2377
2378 =item all_last
2379
2380 =cut
2381
2382 sub all_last {
2383   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2384   open(LASTCACHE,"<$dir/cust_main.last")
2385     or die "can't open $dir/cust_main.last: $!";
2386   my @array = map { chomp; $_; } <LASTCACHE>;
2387   close LASTCACHE;
2388   \@array;
2389 }
2390
2391 =item all_company
2392
2393 =cut
2394
2395 sub all_company {
2396   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2397   open(COMPANYCACHE,"<$dir/cust_main.company")
2398     or die "can't open $dir/cust_main.last: $!";
2399   my @array = map { chomp; $_; } <COMPANYCACHE>;
2400   close COMPANYCACHE;
2401   \@array;
2402 }
2403
2404 =item append_fuzzyfiles LASTNAME COMPANY
2405
2406 =cut
2407
2408 sub append_fuzzyfiles {
2409   my( $last, $company ) = @_;
2410
2411   &check_and_rebuild_fuzzyfiles;
2412
2413   use Fcntl qw(:flock);
2414
2415   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2416
2417   if ( $last ) {
2418
2419     open(LAST,">>$dir/cust_main.last")
2420       or die "can't open $dir/cust_main.last: $!";
2421     flock(LAST,LOCK_EX)
2422       or die "can't lock $dir/cust_main.last: $!";
2423
2424     print LAST "$last\n";
2425
2426     flock(LAST,LOCK_UN)
2427       or die "can't unlock $dir/cust_main.last: $!";
2428     close LAST;
2429   }
2430
2431   if ( $company ) {
2432
2433     open(COMPANY,">>$dir/cust_main.company")
2434       or die "can't open $dir/cust_main.company: $!";
2435     flock(COMPANY,LOCK_EX)
2436       or die "can't lock $dir/cust_main.company: $!";
2437
2438     print COMPANY "$company\n";
2439
2440     flock(COMPANY,LOCK_UN)
2441       or die "can't unlock $dir/cust_main.company: $!";
2442
2443     close COMPANY;
2444   }
2445
2446   1;
2447 }
2448
2449 =item batch_import
2450
2451 =cut
2452
2453 sub batch_import {
2454   my $param = shift;
2455   #warn join('-',keys %$param);
2456   my $fh = $param->{filehandle};
2457   my $agentnum = $param->{agentnum};
2458   my $refnum = $param->{refnum};
2459   my $pkgpart = $param->{pkgpart};
2460   my @fields = @{$param->{fields}};
2461
2462   eval "use Date::Parse;";
2463   die $@ if $@;
2464   eval "use Text::CSV_XS;";
2465   die $@ if $@;
2466
2467   my $csv = new Text::CSV_XS;
2468   #warn $csv;
2469   #warn $fh;
2470
2471   my $imported = 0;
2472   #my $columns;
2473
2474   local $SIG{HUP} = 'IGNORE';
2475   local $SIG{INT} = 'IGNORE';
2476   local $SIG{QUIT} = 'IGNORE';
2477   local $SIG{TERM} = 'IGNORE';
2478   local $SIG{TSTP} = 'IGNORE';
2479   local $SIG{PIPE} = 'IGNORE';
2480
2481   my $oldAutoCommit = $FS::UID::AutoCommit;
2482   local $FS::UID::AutoCommit = 0;
2483   my $dbh = dbh;
2484
2485   #while ( $columns = $csv->getline($fh) ) {
2486   my $line;
2487   while ( defined($line=<$fh>) ) {
2488
2489     $csv->parse($line) or do {
2490       $dbh->rollback if $oldAutoCommit;
2491       return "can't parse: ". $csv->error_input();
2492     };
2493
2494     my @columns = $csv->fields();
2495     #warn join('-',@columns);
2496
2497     my %cust_main = (
2498       agentnum => $agentnum,
2499       refnum   => $refnum,
2500       country  => 'US', #default
2501       payby    => 'BILL', #default
2502       paydate  => '12/2037', #default
2503     );
2504     my $billtime = time;
2505     my %cust_pkg = ( pkgpart => $pkgpart );
2506     foreach my $field ( @fields ) {
2507       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2508         #$cust_pkg{$1} = str2time( shift @$columns );
2509         if ( $1 eq 'setup' ) {
2510           $billtime = str2time(shift @columns);
2511         } else {
2512           $cust_pkg{$1} = str2time( shift @columns );
2513         }
2514       } else {
2515         #$cust_main{$field} = shift @$columns;
2516         $cust_main{$field} = shift @columns;
2517       }
2518     }
2519
2520     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2521     my $cust_main = new FS::cust_main ( \%cust_main );
2522     use Tie::RefHash;
2523     tie my %hash, 'Tie::RefHash'; #this part is important
2524     $hash{$cust_pkg} = [] if $pkgpart;
2525     my $error = $cust_main->insert( \%hash );
2526
2527     if ( $error ) {
2528       $dbh->rollback if $oldAutoCommit;
2529       return "can't insert customer for $line: $error";
2530     }
2531
2532     #false laziness w/bill.cgi
2533     $error = $cust_main->bill( 'time' => $billtime );
2534     if ( $error ) {
2535       $dbh->rollback if $oldAutoCommit;
2536       return "can't bill customer for $line: $error";
2537     }
2538
2539     $cust_main->apply_payments;
2540     $cust_main->apply_credits;
2541
2542     $error = $cust_main->collect();
2543     if ( $error ) {
2544       $dbh->rollback if $oldAutoCommit;
2545       return "can't collect customer for $line: $error";
2546     }
2547
2548     $imported++;
2549   }
2550
2551   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2552
2553   return "Empty file!" unless $imported;
2554
2555   ''; #no error
2556
2557 }
2558
2559 =item batch_charge
2560
2561 =cut
2562
2563 sub batch_charge {
2564   my $param = shift;
2565   #warn join('-',keys %$param);
2566   my $fh = $param->{filehandle};
2567   my @fields = @{$param->{fields}};
2568
2569   eval "use Date::Parse;";
2570   die $@ if $@;
2571   eval "use Text::CSV_XS;";
2572   die $@ if $@;
2573
2574   my $csv = new Text::CSV_XS;
2575   #warn $csv;
2576   #warn $fh;
2577
2578   my $imported = 0;
2579   #my $columns;
2580
2581   local $SIG{HUP} = 'IGNORE';
2582   local $SIG{INT} = 'IGNORE';
2583   local $SIG{QUIT} = 'IGNORE';
2584   local $SIG{TERM} = 'IGNORE';
2585   local $SIG{TSTP} = 'IGNORE';
2586   local $SIG{PIPE} = 'IGNORE';
2587
2588   my $oldAutoCommit = $FS::UID::AutoCommit;
2589   local $FS::UID::AutoCommit = 0;
2590   my $dbh = dbh;
2591
2592   #while ( $columns = $csv->getline($fh) ) {
2593   my $line;
2594   while ( defined($line=<$fh>) ) {
2595
2596     $csv->parse($line) or do {
2597       $dbh->rollback if $oldAutoCommit;
2598       return "can't parse: ". $csv->error_input();
2599     };
2600
2601     my @columns = $csv->fields();
2602     #warn join('-',@columns);
2603
2604     my %row = ();
2605     foreach my $field ( @fields ) {
2606       $row{$field} = shift @columns;
2607     }
2608
2609     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2610     unless ( $cust_main ) {
2611       $dbh->rollback if $oldAutoCommit;
2612       return "unknown custnum $row{'custnum'}";
2613     }
2614
2615     if ( $row{'amount'} > 0 ) {
2616       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2617       if ( $error ) {
2618         $dbh->rollback if $oldAutoCommit;
2619         return $error;
2620       }
2621       $imported++;
2622     } elsif ( $row{'amount'} < 0 ) {
2623       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2624                                       $row{'pkg'}                         );
2625       if ( $error ) {
2626         $dbh->rollback if $oldAutoCommit;
2627         return $error;
2628       }
2629       $imported++;
2630     } else {
2631       #hmm?
2632     }
2633
2634   }
2635
2636   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2637
2638   return "Empty file!" unless $imported;
2639
2640   ''; #no error
2641
2642 }
2643
2644 =back
2645
2646 =head1 BUGS
2647
2648 The delete method.
2649
2650 The delete method should possibly take an FS::cust_main object reference
2651 instead of a scalar customer number.
2652
2653 Bill and collect options should probably be passed as references instead of a
2654 list.
2655
2656 There should probably be a configuration file with a list of allowed credit
2657 card types.
2658
2659 No multiple currency support (probably a larger project than just this module).
2660
2661 =head1 SEE ALSO
2662
2663 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2664 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2665 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
2666
2667 =cut
2668
2669 1;
2670