FS/FS/cust_main.pm

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