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