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