FS/FS/cust_main.pm

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