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