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   return '' if $self->payby eq 'COMP';
1121   warn "bill customer ". $self->custnum if $DEBUG;
1122
1123   my $time = $options{'time'} || time;
1124
1125   my $error;
1126
1127   #put below somehow?
1128   local $SIG{HUP} = 'IGNORE';
1129   local $SIG{INT} = 'IGNORE';
1130   local $SIG{QUIT} = 'IGNORE';
1131   local $SIG{TERM} = 'IGNORE';
1132   local $SIG{TSTP} = 'IGNORE';
1133   local $SIG{PIPE} = 'IGNORE';
1134
1135   my $oldAutoCommit = $FS::UID::AutoCommit;
1136   local $FS::UID::AutoCommit = 0;
1137   my $dbh = dbh;
1138
1139   $self->select_for_update; #mutex
1140
1141   # find the packages which are due for billing, find out how much they are
1142   # & generate invoice database.
1143
1144   my( $total_setup, $total_recur ) = ( 0, 0 );
1145   #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1146   my @cust_bill_pkg = ();
1147   #my $tax = 0;##
1148   #my $taxable_charged = 0;##
1149   #my $charged = 0;##
1150
1151   my %tax;
1152
1153   foreach my $cust_pkg (
1154     qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1155   ) {
1156
1157     #NO!! next if $cust_pkg->cancel;
1158     next if $cust_pkg->getfield('cancel');
1159
1160     warn "  bill package ". $cust_pkg->pkgnum if $DEBUG;
1161
1162     #? to avoid use of uninitialized value errors... ?
1163     $cust_pkg->setfield('bill', '')
1164       unless defined($cust_pkg->bill);
1165
1166     my $part_pkg = $cust_pkg->part_pkg;
1167
1168     my %hash = $cust_pkg->hash;
1169     my $old_cust_pkg = new FS::cust_pkg \%hash;
1170
1171     my @details = ();
1172
1173     # bill setup
1174     my $setup = 0;
1175     if ( !$cust_pkg->setup || $options{'resetup'} ) {
1176
1177       warn "    bill setup" if $DEBUG;
1178
1179       $setup = eval { $cust_pkg->calc_setup( $time ) };
1180       if ( $@ ) {
1181         $dbh->rollback if $oldAutoCommit;
1182         return $@;
1183       }
1184
1185       $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1186     }
1187
1188     #bill recurring fee
1189     my $recur = 0;
1190     my $sdate;
1191     if ( $part_pkg->getfield('freq') ne '0' &&
1192          ! $cust_pkg->getfield('susp') &&
1193          ( $cust_pkg->getfield('bill') || 0 ) <= $time
1194     ) {
1195
1196       warn "    bill recur" if $DEBUG;
1197
1198       # XXX shared with $recur_prog
1199       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1200
1201       $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details ) };
1202       if ( $@ ) {
1203         $dbh->rollback if $oldAutoCommit;
1204         return $@;
1205       }
1206
1207       #change this bit to use Date::Manip? CAREFUL with timezones (see
1208       # mailing list archive)
1209       my ($sec,$min,$hour,$mday,$mon,$year) =
1210         (localtime($sdate) )[0,1,2,3,4,5];
1211
1212       #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1213       # only for figuring next bill date, nothing else, so, reset $sdate again
1214       # here
1215       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1216       $cust_pkg->last_bill($sdate)
1217         if $cust_pkg->dbdef_table->column('last_bill');
1218
1219       if ( $part_pkg->freq =~ /^\d+$/ ) {
1220         $mon += $part_pkg->freq;
1221         until ( $mon < 12 ) { $mon -= 12; $year++; }
1222       } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1223         my $weeks = $1;
1224         $mday += $weeks * 7;
1225       } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1226         my $days = $1;
1227         $mday += $days;
1228       } else {
1229         $dbh->rollback if $oldAutoCommit;
1230         return "unparsable frequency: ". $part_pkg->freq;
1231       }
1232       $cust_pkg->setfield('bill',
1233         timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1234     }
1235
1236     warn "\$setup is undefined" unless defined($setup);
1237     warn "\$recur is undefined" unless defined($recur);
1238     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1239
1240     if ( $cust_pkg->modified ) {
1241
1242       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n" if $DEBUG;
1243
1244       $error=$cust_pkg->replace($old_cust_pkg);
1245       if ( $error ) { #just in case
1246         $dbh->rollback if $oldAutoCommit;
1247         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1248       }
1249
1250       $setup = sprintf( "%.2f", $setup );
1251       $recur = sprintf( "%.2f", $recur );
1252       if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1253         $dbh->rollback if $oldAutoCommit;
1254         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1255       }
1256       if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1257         $dbh->rollback if $oldAutoCommit;
1258         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1259       }
1260       if ( $setup != 0 || $recur != 0 ) {
1261         warn "    charges (setup=$setup, recur=$recur); queueing line items\n"
1262           if $DEBUG;
1263         my $cust_bill_pkg = new FS::cust_bill_pkg ({
1264           'pkgnum'  => $cust_pkg->pkgnum,
1265           'setup'   => $setup,
1266           'recur'   => $recur,
1267           'sdate'   => $sdate,
1268           'edate'   => $cust_pkg->bill,
1269           'details' => \@details,
1270         });
1271         push @cust_bill_pkg, $cust_bill_pkg;
1272         $total_setup += $setup;
1273         $total_recur += $recur;
1274
1275         unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1276
1277           my @taxes = qsearch( 'cust_main_county', {
1278                                  'state'    => $self->state,
1279                                  'county'   => $self->county,
1280                                  'country'  => $self->country,
1281                                  'taxclass' => $part_pkg->taxclass,
1282                                                                       } );
1283           unless ( @taxes ) {
1284             @taxes =  qsearch( 'cust_main_county', {
1285                                   'state'    => $self->state,
1286                                   'county'   => $self->county,
1287                                   'country'  => $self->country,
1288                                   'taxclass' => '',
1289                                                                       } );
1290           }
1291
1292           #one more try at a whole-country tax rate
1293           unless ( @taxes ) {
1294             @taxes =  qsearch( 'cust_main_county', {
1295                                   'state'    => '',
1296                                   'county'   => '',
1297                                   'country'  => $self->country,
1298                                   'taxclass' => '',
1299                                                                       } );
1300           }
1301
1302           # maybe eliminate this entirely, along with all the 0% records
1303           unless ( @taxes ) {
1304             $dbh->rollback if $oldAutoCommit;
1305             return
1306               "fatal: can't find tax rate for state/county/country/taxclass ".
1307               join('/', ( map $self->$_(), qw(state county country) ),
1308                         $part_pkg->taxclass ).  "\n";
1309           }
1310
1311           foreach my $tax ( @taxes ) {
1312
1313             my $taxable_charged = 0;
1314             $taxable_charged += $setup
1315               unless $part_pkg->setuptax =~ /^Y$/i
1316                   || $tax->setuptax =~ /^Y$/i;
1317             $taxable_charged += $recur
1318               unless $part_pkg->recurtax =~ /^Y$/i
1319                   || $tax->recurtax =~ /^Y$/i;
1320             next unless $taxable_charged;
1321
1322             if ( $tax->exempt_amount > 0 ) {
1323               my ($mon,$year) = (localtime($sdate) )[4,5];
1324               $mon++;
1325               my $freq = $part_pkg->freq || 1;
1326               if ( $freq !~ /(\d+)$/ ) {
1327                 $dbh->rollback if $oldAutoCommit;
1328                 return "daily/weekly package definitions not (yet?)".
1329                        " compatible with monthly tax exemptions";
1330               }
1331               my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1332               foreach my $which_month ( 1 .. $freq ) {
1333                 my %hash = (
1334                   'custnum' => $self->custnum,
1335                   'taxnum'  => $tax->taxnum,
1336                   'year'    => 1900+$year,
1337                   'month'   => $mon++,
1338                 );
1339                 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1340                 until ( $mon < 13 ) { $mon -= 12; $year++; }
1341                 my $cust_tax_exempt =
1342                   qsearchs('cust_tax_exempt', \%hash)
1343                   || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1344                 my $remaining_exemption = sprintf("%.2f",
1345                   $tax->exempt_amount - $cust_tax_exempt->amount );
1346                 if ( $remaining_exemption > 0 ) {
1347                   my $addl = $remaining_exemption > $taxable_per_month
1348                     ? $taxable_per_month
1349                     : $remaining_exemption;
1350                   $taxable_charged -= $addl;
1351                   my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1352                     $cust_tax_exempt->hash,
1353                     'amount' =>
1354                       sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1355                   } );
1356                   $error = $new_cust_tax_exempt->exemptnum
1357                     ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1358                     : $new_cust_tax_exempt->insert;
1359                   if ( $error ) {
1360                     $dbh->rollback if $oldAutoCommit;
1361                     return "fatal: can't update cust_tax_exempt: $error";
1362                   }
1363
1364                 } # if $remaining_exemption > 0
1365
1366               } #foreach $which_month
1367
1368             } #if $tax->exempt_amount
1369
1370             $taxable_charged = sprintf( "%.2f", $taxable_charged);
1371
1372             #$tax += $taxable_charged * $cust_main_county->tax / 100
1373             $tax{ $tax->taxname || 'Tax' } +=
1374               $taxable_charged * $tax->tax / 100
1375
1376           } #foreach my $tax ( @taxes )
1377
1378         } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1379
1380       } #if $setup != 0 || $recur != 0
1381
1382     } #if $cust_pkg->modified
1383
1384   } #foreach my $cust_pkg
1385
1386   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1387 #  my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1388
1389   unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1390     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1391     return '';
1392   }
1393
1394 #  unless ( $self->tax =~ /Y/i
1395 #           || $self->payby eq 'COMP'
1396 #           || $taxable_charged == 0 ) {
1397 #    my $cust_main_county = qsearchs('cust_main_county',{
1398 #        'state'   => $self->state,
1399 #        'county'  => $self->county,
1400 #        'country' => $self->country,
1401 #    } ) or die "fatal: can't find tax rate for state/county/country ".
1402 #               $self->state. "/". $self->county. "/". $self->country. "\n";
1403 #    my $tax = sprintf( "%.2f",
1404 #      $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1405 #    );
1406
1407   if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1408
1409     foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1410       my $tax = sprintf("%.2f", $tax{$taxname} );
1411       $charged = sprintf( "%.2f", $charged+$tax );
1412
1413       my $cust_bill_pkg = new FS::cust_bill_pkg ({
1414         'pkgnum'   => 0,
1415         'setup'    => $tax,
1416         'recur'    => 0,
1417         'sdate'    => '',
1418         'edate'    => '',
1419         'itemdesc' => $taxname,
1420       });
1421       push @cust_bill_pkg, $cust_bill_pkg;
1422     }
1423
1424   } else { #1.4 schema
1425
1426     my $tax = 0;
1427     foreach ( values %tax ) { $tax += $_ };
1428     $tax = sprintf("%.2f", $tax);
1429     if ( $tax > 0 ) {
1430       $charged = sprintf( "%.2f", $charged+$tax );
1431
1432       my $cust_bill_pkg = new FS::cust_bill_pkg ({
1433         'pkgnum' => 0,
1434         'setup'  => $tax,
1435         'recur'  => 0,
1436         'sdate'  => '',
1437         'edate'  => '',
1438       });
1439       push @cust_bill_pkg, $cust_bill_pkg;
1440     }
1441
1442   }
1443
1444   my $cust_bill = new FS::cust_bill ( {
1445     'custnum' => $self->custnum,
1446     '_date'   => $time,
1447     'charged' => $charged,
1448   } );
1449   $error = $cust_bill->insert;
1450   if ( $error ) {
1451     $dbh->rollback if $oldAutoCommit;
1452     return "can't create invoice for customer #". $self->custnum. ": $error";
1453   }
1454
1455   my $invnum = $cust_bill->invnum;
1456   my $cust_bill_pkg;
1457   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1458     #warn $invnum;
1459     $cust_bill_pkg->invnum($invnum);
1460     $error = $cust_bill_pkg->insert;
1461     if ( $error ) {
1462       $dbh->rollback if $oldAutoCommit;
1463       return "can't create invoice line item for customer #". $self->custnum.
1464              ": $error";
1465     }
1466   }
1467
1468   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1469   ''; #no error
1470 }
1471
1472 =item collect OPTIONS
1473
1474 (Attempt to) collect money for this customer's outstanding invoices (see
1475 L<FS::cust_bill>).  Usually used after the bill method.
1476
1477 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1478 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1479 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1480
1481 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1482 and the invoice events web interface.
1483
1484 If there is an error, returns the error, otherwise returns false.
1485
1486 Options are passed as name-value pairs.
1487
1488 Currently available options are:
1489
1490 invoice_time - Use this time when deciding when to print invoices and
1491 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>
1492 for conversion functions.
1493
1494 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1495 events.
1496
1497 retry_card - Deprecated alias for 'retry'
1498
1499 batch_card - This option is deprecated.  See the invoice events web interface
1500 to control whether cards are batched or run against a realtime gateway.
1501
1502 report_badcard - This option is deprecated.
1503
1504 force_print - This option is deprecated; see the invoice events web interface.
1505
1506 quiet - set true to surpress email card/ACH decline notices.
1507
1508 =cut
1509
1510 sub collect {
1511   my( $self, %options ) = @_;
1512   my $invoice_time = $options{'invoice_time'} || time;
1513
1514   #put below somehow?
1515   local $SIG{HUP} = 'IGNORE';
1516   local $SIG{INT} = 'IGNORE';
1517   local $SIG{QUIT} = 'IGNORE';
1518   local $SIG{TERM} = 'IGNORE';
1519   local $SIG{TSTP} = 'IGNORE';
1520   local $SIG{PIPE} = 'IGNORE';
1521
1522   my $oldAutoCommit = $FS::UID::AutoCommit;
1523   local $FS::UID::AutoCommit = 0;
1524   my $dbh = dbh;
1525
1526   $self->select_for_update; #mutex
1527
1528   my $balance = $self->balance;
1529   warn "collect customer ". $self->custnum. ": balance $balance" if $DEBUG;
1530   unless ( $balance > 0 ) { #redundant?????
1531     $dbh->rollback if $oldAutoCommit; #hmm
1532     return '';
1533   }
1534
1535   if ( exists($options{'retry_card'}) ) {
1536     carp 'retry_card option passed to collect is deprecated; use retry';
1537     $options{'retry'} ||= $options{'retry_card'};
1538   }
1539   if ( exists($options{'retry'}) && $options{'retry'} ) {
1540     my $error = $self->retry_realtime;
1541     if ( $error ) {
1542       $dbh->rollback if $oldAutoCommit;
1543       return $error;
1544     }
1545   }
1546
1547   foreach my $cust_bill ( $self->open_cust_bill ) {
1548
1549     # don't try to charge for the same invoice if it's already in a batch
1550     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1551
1552     last if $self->balance <= 0;
1553
1554     warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
1555       if $DEBUG;
1556
1557     foreach my $part_bill_event (
1558       sort {    $a->seconds   <=> $b->seconds
1559              || $a->weight    <=> $b->weight
1560              || $a->eventpart <=> $b->eventpart }
1561         grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1562                && ! qsearch( 'cust_bill_event', {
1563                                 'invnum'    => $cust_bill->invnum,
1564                                 'eventpart' => $_->eventpart,
1565                                 'status'    => 'done',
1566                                                                    } )
1567              }
1568           qsearch('part_bill_event', { 'payby'    => $self->payby,
1569                                        'disabled' => '',           } )
1570     ) {
1571
1572       last if $cust_bill->owed <= 0  # don't run subsequent events if owed<=0
1573            || $self->balance   <= 0; # or if balance<=0
1574
1575       warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1576         if $DEBUG;
1577       my $cust_main = $self; #for callback
1578
1579       my $error;
1580       {
1581         local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1582         $error = eval $part_bill_event->eventcode;
1583       }
1584
1585       my $status = '';
1586       my $statustext = '';
1587       if ( $@ ) {
1588         $status = 'failed';
1589         $statustext = $@;
1590       } elsif ( $error ) {
1591         $status = 'done';
1592         $statustext = $error;
1593       } else {
1594         $status = 'done'
1595       }
1596
1597       #add cust_bill_event
1598       my $cust_bill_event = new FS::cust_bill_event {
1599         'invnum'     => $cust_bill->invnum,
1600         'eventpart'  => $part_bill_event->eventpart,
1601         #'_date'      => $invoice_time,
1602         '_date'      => time,
1603         'status'     => $status,
1604         'statustext' => $statustext,
1605       };
1606       $error = $cust_bill_event->insert;
1607       if ( $error ) {
1608         #$dbh->rollback if $oldAutoCommit;
1609         #return "error: $error";
1610
1611         # gah, even with transactions.
1612         $dbh->commit if $oldAutoCommit; #well.
1613         my $e = 'WARNING: Event run but database not updated - '.
1614                 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1615                 ', eventpart '. $part_bill_event->eventpart.
1616                 ": $error";
1617         warn $e;
1618         return $e;
1619       }
1620
1621
1622     }
1623
1624   }
1625
1626   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1627   '';
1628
1629 }
1630
1631 =item retry_realtime
1632
1633 Schedules realtime credit card / electronic check / LEC billing events for
1634 for retry.  Useful if card information has changed or manual retry is desired.
1635 The 'collect' method must be called to actually retry the transaction.
1636
1637 Implementation details: For each of this customer's open invoices, changes
1638 the status of the first "done" (with statustext error) realtime processing
1639 event to "failed".
1640
1641 =cut
1642
1643 sub retry_realtime {
1644   my $self = shift;
1645
1646   local $SIG{HUP} = 'IGNORE';
1647   local $SIG{INT} = 'IGNORE';
1648   local $SIG{QUIT} = 'IGNORE';
1649   local $SIG{TERM} = 'IGNORE';
1650   local $SIG{TSTP} = 'IGNORE';
1651   local $SIG{PIPE} = 'IGNORE';
1652
1653   my $oldAutoCommit = $FS::UID::AutoCommit;
1654   local $FS::UID::AutoCommit = 0;
1655   my $dbh = dbh;
1656
1657   foreach my $cust_bill (
1658     grep { $_->cust_bill_event }
1659       $self->open_cust_bill
1660   ) {
1661     my @cust_bill_event =
1662       sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1663         grep {
1664                #$_->part_bill_event->plan eq 'realtime-card'
1665                $_->part_bill_event->eventcode =~
1666                    /\$cust_bill\->realtime_(card|ach|lec)/
1667                  && $_->status eq 'done'
1668                  && $_->statustext
1669              }
1670           $cust_bill->cust_bill_event;
1671     next unless @cust_bill_event;
1672     my $error = $cust_bill_event[0]->retry;
1673     if ( $error ) {
1674       $dbh->rollback if $oldAutoCommit;
1675       return "error scheduling invoice event for retry: $error";
1676     }
1677
1678   }
1679
1680   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1681   '';
1682
1683 }
1684
1685 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1686
1687 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1688 via a Business::OnlinePayment realtime gateway.  See
1689 L<http://420.am/business-onlinepayment> for supported gateways.
1690
1691 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1692
1693 Available options are: I<description>, I<invnum>, I<quiet>
1694
1695 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1696 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
1697 if set, will override the value from the customer record.
1698
1699 I<description> is a free-text field passed to the gateway.  It defaults to
1700 "Internet services".
1701
1702 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1703 specified invoice.  If you don't specify an I<invnum> you might want to
1704 call the B<apply_payments> method.
1705
1706 I<quiet> can be set true to surpress email decline notices.
1707
1708 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1709
1710 =cut
1711
1712 sub realtime_bop {
1713   my( $self, $method, $amount, %options ) = @_;
1714   if ( $DEBUG ) {
1715     warn "$self $method $amount\n";
1716     warn "  $_ => $options{$_}\n" foreach keys %options;
1717   }
1718
1719   $options{'description'} ||= 'Internet services';
1720
1721   #pre-requisites
1722   die "Real-time processing not enabled\n"
1723     unless $conf->exists('business-onlinepayment');
1724   eval "use Business::OnlinePayment";
1725   die $@ if $@;
1726
1727   #load up config
1728   my $bop_config = 'business-onlinepayment';
1729   $bop_config .= '-ach'
1730     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1731   my ( $processor, $login, $password, $action, @bop_options ) =
1732     $conf->config($bop_config);
1733   $action ||= 'normal authorization';
1734   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1735   die "No real-time processor is enabled - ".
1736       "did you set the business-onlinepayment configuration value?\n"
1737     unless $processor;
1738
1739   #massage data
1740
1741   my $address = exists($options{'address1'})
1742                     ? $options{'address1'}
1743                     : $self->address1;
1744   my $address2 = exists($options{'address2'})
1745                     ? $options{'address2'}
1746                     : $self->address2;
1747   $address .= ", ". $address2 if length($address2);
1748
1749   my $o_payname = exists($options{'payname'})
1750                     ? $options{'payname'}
1751                     : $self->payname;
1752   my($payname, $payfirst, $paylast);
1753   if ( $o_payname && $method ne 'ECHECK' ) {
1754     ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1755       or return "Illegal payname $payname";
1756     ($payfirst, $paylast) = ($1, $2);
1757   } else {
1758     $payfirst = $self->getfield('first');
1759     $paylast = $self->getfield('last');
1760     $payname =  "$payfirst $paylast";
1761   }
1762
1763   my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1764   if ( $conf->exists('emailinvoiceauto')
1765        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1766     push @invoicing_list, $self->all_emails;
1767   }
1768   my $email = $invoicing_list[0];
1769
1770   my $payinfo = exists($options{'payinfo'})
1771                   ? $options{'payinfo'}
1772                   : $self->payinfo;
1773
1774   my %content = ();
1775   if ( $method eq 'CC' ) {
1776
1777     $content{card_number} = $payinfo;
1778     my $paydate = exists($options{'paydate'})
1779                     ? $options{'paydate'}
1780                     : $self->paydate;
1781     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1782     $content{expiration} = "$2/$1";
1783
1784     if ( defined $self->dbdef_table->column('paycvv') ) {
1785       my $paycvv = exists($options{'paycvv'})
1786                      ? $options{'paycvv'}
1787                      : $self->paycvv;
1788       $content{cvv2} = $self->paycvv
1789         if length($paycvv);
1790     }
1791
1792     $content{recurring_billing} = 'YES'
1793       if qsearch('cust_pay', { 'custnum' => $self->custnum,
1794                                'payby'   => 'CARD',
1795                                'payinfo' => $payinfo,
1796                              } );
1797
1798   } elsif ( $method eq 'ECHECK' ) {
1799     ( $content{account_number}, $content{routing_code} ) =
1800       split('@', $payinfo);
1801     $content{bank_name} = $o_payname;
1802     $content{account_type} = 'CHECKING';
1803     $content{account_name} = $payname;
1804     $content{customer_org} = $self->company ? 'B' : 'I';
1805     $content{customer_ssn} = exists($options{'ss'})
1806                                ? $options{'ss'}
1807                                : $self->ss;
1808   } elsif ( $method eq 'LEC' ) {
1809     $content{phone} = $payinfo;
1810   }
1811
1812   #transaction(s)
1813
1814   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1815
1816   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
1817   $transaction->content(
1818     'type'           => $method,
1819     'login'          => $login,
1820     'password'       => $password,
1821     'action'         => $action1,
1822     'description'    => $options{'description'},
1823     'amount'         => $amount,
1824     'invoice_number' => $options{'invnum'},
1825     'customer_id'    => $self->custnum,
1826     'last_name'      => $paylast,
1827     'first_name'     => $payfirst,
1828     'name'           => $payname,
1829     'address'        => $address,
1830     'city'           => ( exists($options{'city'})
1831                             ? $options{'city'}
1832                             : $self->city          ),
1833     'state'          => ( exists($options{'state'})
1834                             ? $options{'state'}
1835                             : $self->state          ),
1836     'zip'            => ( exists($options{'zip'})
1837                             ? $options{'zip'}
1838                             : $self->zip          ),
1839     'country'        => ( exists($options{'country'})
1840                             ? $options{'country'}
1841                             : $self->country          ),
1842     'referer'        => 'http://cleanwhisker.420.am/',
1843     'email'          => $email,
1844     'phone'          => $self->daytime || $self->night,
1845     %content, #after
1846   );
1847   $transaction->submit();
1848
1849   if ( $transaction->is_success() && $action2 ) {
1850     my $auth = $transaction->authorization;
1851     my $ordernum = $transaction->can('order_number')
1852                    ? $transaction->order_number
1853                    : '';
1854
1855     my $capture =
1856       new Business::OnlinePayment( $processor, @bop_options );
1857
1858     my %capture = (
1859       %content,
1860       type           => $method,
1861       action         => $action2,
1862       login          => $login,
1863       password       => $password,
1864       order_number   => $ordernum,
1865       amount         => $amount,
1866       authorization  => $auth,
1867       description    => $options{'description'},
1868     );
1869
1870     foreach my $field (qw( authorization_source_code returned_ACI                                          transaction_identifier validation_code
1871                            transaction_sequence_num local_transaction_date
1872                            local_transaction_time AVS_result_code          )) {
1873       $capture{$field} = $transaction->$field() if $transaction->can($field);
1874     }
1875
1876     $capture->content( %capture );
1877
1878     $capture->submit();
1879
1880     unless ( $capture->is_success ) {
1881       my $e = "Authorization sucessful but capture failed, custnum #".
1882               $self->custnum. ': '.  $capture->result_code.
1883               ": ". $capture->error_message;
1884       warn $e;
1885       return $e;
1886     }
1887
1888   }
1889
1890   #remove paycvv after initial transaction
1891   #false laziness w/misc/process/payment.cgi - check both to make sure working
1892   # correctly
1893   if ( defined $self->dbdef_table->column('paycvv')
1894        && length($self->paycvv)
1895        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
1896   ) {
1897     my $error = $self->remove_cvv;
1898     if ( $error ) {
1899       warn "error removing cvv: $error\n";
1900     }
1901   }
1902
1903   #result handling
1904   if ( $transaction->is_success() ) {
1905
1906     my %method2payby = (
1907       'CC'     => 'CARD',
1908       'ECHECK' => 'CHEK',
1909       'LEC'    => 'LECB',
1910     );
1911
1912     my $paybatch = "$processor:". $transaction->authorization;
1913     $paybatch .= ':'. $transaction->order_number
1914       if $transaction->can('order_number')
1915       && length($transaction->order_number);
1916
1917     my $cust_pay = new FS::cust_pay ( {
1918        'custnum'  => $self->custnum,
1919        'invnum'   => $options{'invnum'},
1920        'paid'     => $amount,
1921        '_date'     => '',
1922        'payby'    => $method2payby{$method},
1923        'payinfo'  => $payinfo,
1924        'paybatch' => $paybatch,
1925     } );
1926     my $error = $cust_pay->insert;
1927     if ( $error ) {
1928       $cust_pay->invnum(''); #try again with no specific invnum
1929       my $error2 = $cust_pay->insert;
1930       if ( $error2 ) {
1931         # gah, even with transactions.
1932         my $e = 'WARNING: Card/ACH debited but database not updated - '.
1933                 "error inserting payment ($processor): $error2".
1934                 " (previously tried insert with invnum #$options{'invnum'}" .
1935                 ": $error )";
1936         warn $e;
1937         return $e;
1938       }
1939     }
1940     return ''; #no error
1941
1942   } else {
1943
1944     my $perror = "$processor error: ". $transaction->error_message;
1945
1946     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1947          && $conf->exists('emaildecline')
1948          && grep { $_ ne 'POST' } $self->invoicing_list
1949          && ! grep { $transaction->error_message =~ /$_/ }
1950                    $conf->config('emaildecline-exclude')
1951     ) {
1952       my @templ = $conf->config('declinetemplate');
1953       my $template = new Text::Template (
1954         TYPE   => 'ARRAY',
1955         SOURCE => [ map "$_\n", @templ ],
1956       ) or return "($perror) can't create template: $Text::Template::ERROR";
1957       $template->compile()
1958         or return "($perror) can't compile template: $Text::Template::ERROR";
1959
1960       my $templ_hash = { error => $transaction->error_message };
1961
1962       my $error = send_email(
1963         'from'    => $conf->config('invoice_from'),
1964         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1965         'subject' => 'Your payment could not be processed',
1966         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
1967       );
1968
1969       $perror .= " (also received error sending decline notification: $error)"
1970         if $error;
1971
1972     }
1973
1974     return $perror;
1975   }
1976
1977 }
1978
1979 =item remove_cvv
1980
1981 Removes the I<paycvv> field from the database directly.
1982
1983 If there is an error, returns the error, otherwise returns false.
1984
1985 =cut
1986
1987 sub remove_cvv {
1988   my $self = shift;
1989   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
1990     or return dbh->errstr;
1991   $sth->execute($self->custnum)
1992     or return $sth->errstr;
1993   $self->paycvv('');
1994   '';
1995 }
1996
1997 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
1998
1999 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2000 via a Business::OnlinePayment realtime gateway.  See
2001 L<http://420.am/business-onlinepayment> for supported gateways.
2002
2003 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2004
2005 Available options are: I<amount>, I<reason>, I<paynum>
2006
2007 Most gateways require a reference to an original payment transaction to refund,
2008 so you probably need to specify a I<paynum>.
2009
2010 I<amount> defaults to the original amount of the payment if not specified.
2011
2012 I<reason> specifies a reason for the refund.
2013
2014 Implementation note: If I<amount> is unspecified or equal to the amount of the
2015 orignal payment, first an attempt is made to "void" the transaction via
2016 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2017 the normal attempt is made to "refund" ("credit") the transaction via the
2018 gateway is attempted.
2019
2020 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2021 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2022 #if set, will override the value from the customer record.
2023
2024 #If an I<invnum> is specified, this payment (if sucessful) is applied to the
2025 #specified invoice.  If you don't specify an I<invnum> you might want to
2026 #call the B<apply_payments> method.
2027
2028 =cut
2029
2030 #some false laziness w/realtime_bop, not enough to make it worth merging
2031 #but some useful small subs should be pulled out
2032 sub realtime_refund_bop {
2033   my( $self, $method, %options ) = @_;
2034   if ( $DEBUG ) {
2035     warn "$self $method refund\n";
2036     warn "  $_ => $options{$_}\n" foreach keys %options;
2037   }
2038
2039   #pre-requisites
2040   die "Real-time processing not enabled\n"
2041     unless $conf->exists('business-onlinepayment');
2042   eval "use Business::OnlinePayment";
2043   die $@ if $@;
2044
2045   #load up config
2046   my $bop_config = 'business-onlinepayment';
2047   $bop_config .= '-ach'
2048     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2049   my ( $processor, $login, $password, $unused_action, @bop_options ) =
2050     $conf->config($bop_config);
2051   #$action ||= 'normal authorization';
2052   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2053   die "No real-time processor is enabled - ".
2054       "did you set the business-onlinepayment configuration value?\n"
2055     unless $processor;
2056
2057   my $cust_pay = '';
2058   my $amount = $options{'amount'};
2059   my( $pay_processor, $auth, $order_number ) = ( '', '', '' );
2060   if ( $options{'paynum'} ) {
2061     warn "FS::cust_main::realtime_bop: paynum: $options{paynum}\n" if $DEBUG;
2062     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2063       or return "Unknown paynum $options{'paynum'}";
2064     $amount ||= $cust_pay->paid;
2065     $cust_pay->paybatch =~ /^(\w+):(\w*)(:(\w+))?$/
2066       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2067                 $cust_pay->paybatch;
2068     ( $pay_processor, $auth, $order_number ) = ( $1, $2, $4 );
2069     return "processor of payment $options{'paynum'} $pay_processor does not".
2070            " match current processor $processor"
2071       unless $pay_processor eq $processor;
2072   }
2073   return "neither amount nor paynum specified" unless $amount;
2074
2075   my %content = (
2076     'type'           => $method,
2077     'login'          => $login,
2078     'password'       => $password,
2079     'order_number'   => $order_number,
2080     'amount'         => $amount,
2081     'referer'        => 'http://cleanwhisker.420.am/',
2082   );
2083   $content{authorization} = $auth
2084     if length($auth); #echeck/ACH transactions have an order # but no auth
2085                       #(at least with authorize.net)
2086
2087   #first try void if applicable
2088   if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2089     my $void = new Business::OnlinePayment( $processor, @bop_options );
2090     $void->content( 'action' => 'void', %content );
2091     $void->submit();
2092     if ( $void->is_success ) {
2093       my $error = $cust_pay->void($options{'reason'});
2094       if ( $error ) {
2095         # gah, even with transactions.
2096         my $e = 'WARNING: Card/ACH voided but database not updated - '.
2097                 "error voiding payment: $error";
2098         warn $e;
2099         return $e;
2100       }
2101       return '';
2102     }
2103   }
2104
2105   #massage data
2106   my $address = $self->address1;
2107   $address .= ", ". $self->address2 if $self->address2;
2108
2109   my($payname, $payfirst, $paylast);
2110   if ( $self->payname && $method ne 'ECHECK' ) {
2111     $payname = $self->payname;
2112     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2113       or return "Illegal payname $payname";
2114     ($payfirst, $paylast) = ($1, $2);
2115   } else {
2116     $payfirst = $self->getfield('first');
2117     $paylast = $self->getfield('last');
2118     $payname =  "$payfirst $paylast";
2119   }
2120
2121   if ( $method eq 'CC' ) {
2122
2123     $content{card_number} = $self->payinfo;
2124     $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2125     $content{expiration} = "$2/$1";
2126
2127     #$content{cvv2} = $self->paycvv
2128     #  if defined $self->dbdef_table->column('paycvv')
2129     #     && length($self->paycvv);
2130
2131     #$content{recurring_billing} = 'YES'
2132     #  if qsearch('cust_pay', { 'custnum' => $self->custnum,
2133     #                           'payby'   => 'CARD',
2134     #                           'payinfo' => $self->payinfo, } );
2135
2136   } elsif ( $method eq 'ECHECK' ) {
2137     ( $content{account_number}, $content{routing_code} ) =
2138       split('@', $self->payinfo);
2139     $content{bank_name} = $self->payname;
2140     $content{account_type} = 'CHECKING';
2141     $content{account_name} = $payname;
2142     $content{customer_org} = $self->company ? 'B' : 'I';
2143     $content{customer_ssn} = $self->ss;
2144   } elsif ( $method eq 'LEC' ) {
2145     $content{phone} = $self->payinfo;
2146   }
2147
2148   #then try refund
2149   my $refund = new Business::OnlinePayment( $processor, @bop_options );
2150   $refund->content(
2151     'action'         => 'credit',
2152     'customer_id'    => $self->custnum,
2153     'last_name'      => $paylast,
2154     'first_name'     => $payfirst,
2155     'name'           => $payname,
2156     'address'        => $address,
2157     'city'           => $self->city,
2158     'state'          => $self->state,
2159     'zip'            => $self->zip,
2160     'country'        => $self->country,
2161     %content, #after
2162   );
2163   $refund->submit();
2164
2165   return "$processor error: ". $refund->error_message
2166     unless $refund->is_success();
2167
2168   my %method2payby = (
2169     'CC'     => 'CARD',
2170     'ECHECK' => 'CHEK',
2171     'LEC'    => 'LECB',
2172   );
2173
2174   my $paybatch = "$processor:". $refund->authorization;
2175   $paybatch .= ':'. $refund->order_number
2176     if $refund->can('order_number') && $refund->order_number;
2177
2178   while ( $cust_pay && $cust_pay->unappled < $amount ) {
2179     my @cust_bill_pay = $cust_pay->cust_bill_pay;
2180     last unless @cust_bill_pay;
2181     my $cust_bill_pay = pop @cust_bill_pay;
2182     my $error = $cust_bill_pay->delete;
2183     last if $error;
2184   }
2185
2186   my $cust_refund = new FS::cust_refund ( {
2187     'custnum'  => $self->custnum,
2188     'paynum'   => $options{'paynum'},
2189     'refund'   => $amount,
2190     '_date'    => '',
2191     'payby'    => $method2payby{$method},
2192     'payinfo'  => $self->payinfo,
2193     'paybatch' => $paybatch,
2194     'reason'   => $options{'reason'} || 'card or ACH refund',
2195   } );
2196   my $error = $cust_refund->insert;
2197   if ( $error ) {
2198     $cust_refund->paynum(''); #try again with no specific paynum
2199     my $error2 = $cust_refund->insert;
2200     if ( $error2 ) {
2201       # gah, even with transactions.
2202       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2203               "error inserting refund ($processor): $error2".
2204               " (previously tried insert with paynum #$options{'paynum'}" .
2205               ": $error )";
2206       warn $e;
2207       return $e;
2208     }
2209   }
2210
2211   ''; #no error
2212
2213 }
2214
2215 =item total_owed
2216
2217 Returns the total owed for this customer on all invoices
2218 (see L<FS::cust_bill/owed>).
2219
2220 =cut
2221
2222 sub total_owed {
2223   my $self = shift;
2224   $self->total_owed_date(2145859200); #12/31/2037
2225 }
2226
2227 =item total_owed_date TIME
2228
2229 Returns the total owed for this customer on all invoices with date earlier than
2230 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2231 see L<Time::Local> and L<Date::Parse> for conversion functions.
2232
2233 =cut
2234
2235 sub total_owed_date {
2236   my $self = shift;
2237   my $time = shift;
2238   my $total_bill = 0;
2239   foreach my $cust_bill (
2240     grep { $_->_date <= $time }
2241       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2242   ) {
2243     $total_bill += $cust_bill->owed;
2244   }
2245   sprintf( "%.2f", $total_bill );
2246 }
2247
2248 =item apply_credits OPTION => VALUE ...
2249
2250 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2251 to outstanding invoice balances in chronological order (or reverse
2252 chronological order if the I<order> option is set to B<newest>) and returns the
2253 value of any remaining unapplied credits available for refund (see
2254 L<FS::cust_refund>).
2255
2256 =cut
2257
2258 sub apply_credits {
2259   my $self = shift;
2260   my %opt = @_;
2261
2262   return 0 unless $self->total_credited;
2263
2264   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2265       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2266
2267   my @invoices = $self->open_cust_bill;
2268   @invoices = sort { $b->_date <=> $a->_date } @invoices
2269     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2270
2271   my $credit;
2272   foreach my $cust_bill ( @invoices ) {
2273     my $amount;
2274
2275     if ( !defined($credit) || $credit->credited == 0) {
2276       $credit = pop @credits or last;
2277     }
2278
2279     if ($cust_bill->owed >= $credit->credited) {
2280       $amount=$credit->credited;
2281     }else{
2282       $amount=$cust_bill->owed;
2283     }
2284
2285     my $cust_credit_bill = new FS::cust_credit_bill ( {
2286       'crednum' => $credit->crednum,
2287       'invnum'  => $cust_bill->invnum,
2288       'amount'  => $amount,
2289     } );
2290     my $error = $cust_credit_bill->insert;
2291     die $error if $error;
2292
2293     redo if ($cust_bill->owed > 0);
2294
2295   }
2296
2297   return $self->total_credited;
2298 }
2299
2300 =item apply_payments
2301
2302 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2303 to outstanding invoice balances in chronological order.
2304
2305  #and returns the value of any remaining unapplied payments.
2306
2307 =cut
2308
2309 sub apply_payments {
2310   my $self = shift;
2311
2312   #return 0 unless
2313
2314   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2315       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
2316
2317   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2318       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2319
2320   my $payment;
2321
2322   foreach my $cust_bill ( @invoices ) {
2323     my $amount;
2324
2325     if ( !defined($payment) || $payment->unapplied == 0 ) {
2326       $payment = pop @payments or last;
2327     }
2328
2329     if ( $cust_bill->owed >= $payment->unapplied ) {
2330       $amount = $payment->unapplied;
2331     } else {
2332       $amount = $cust_bill->owed;
2333     }
2334
2335     my $cust_bill_pay = new FS::cust_bill_pay ( {
2336       'paynum' => $payment->paynum,
2337       'invnum' => $cust_bill->invnum,
2338       'amount' => $amount,
2339     } );
2340     my $error = $cust_bill_pay->insert;
2341     die $error if $error;
2342
2343     redo if ( $cust_bill->owed > 0);
2344
2345   }
2346
2347   return $self->total_unapplied_payments;
2348 }
2349
2350 =item total_credited
2351
2352 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2353 customer.  See L<FS::cust_credit/credited>.
2354
2355 =cut
2356
2357 sub total_credited {
2358   my $self = shift;
2359   my $total_credit = 0;
2360   foreach my $cust_credit ( qsearch('cust_credit', {
2361     'custnum' => $self->custnum,
2362   } ) ) {
2363     $total_credit += $cust_credit->credited;
2364   }
2365   sprintf( "%.2f", $total_credit );
2366 }
2367
2368 =item total_unapplied_payments
2369
2370 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2371 See L<FS::cust_pay/unapplied>.
2372
2373 =cut
2374
2375 sub total_unapplied_payments {
2376   my $self = shift;
2377   my $total_unapplied = 0;
2378   foreach my $cust_pay ( qsearch('cust_pay', {
2379     'custnum' => $self->custnum,
2380   } ) ) {
2381     $total_unapplied += $cust_pay->unapplied;
2382   }
2383   sprintf( "%.2f", $total_unapplied );
2384 }
2385
2386 =item balance
2387
2388 Returns the balance for this customer (total_owed minus total_credited
2389 minus total_unapplied_payments).
2390
2391 =cut
2392
2393 sub balance {
2394   my $self = shift;
2395   sprintf( "%.2f",
2396     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2397   );
2398 }
2399
2400 =item balance_date TIME
2401
2402 Returns the balance for this customer, only considering invoices with date
2403 earlier than TIME (total_owed_date minus total_credited minus
2404 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
2405 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
2406 functions.
2407
2408 =cut
2409
2410 sub balance_date {
2411   my $self = shift;
2412   my $time = shift;
2413   sprintf( "%.2f",
2414     $self->total_owed_date($time)
2415       - $self->total_credited
2416       - $self->total_unapplied_payments
2417   );
2418 }
2419
2420 =item paydate_monthyear
2421
2422 Returns a two-element list consisting of the month and year of this customer's
2423 paydate (credit card expiration date for CARD customers)
2424
2425 =cut
2426
2427 sub paydate_monthyear {
2428   my $self = shift;
2429   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2430     ( $2, $1 );
2431   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2432     ( $1, $3 );
2433   } else {
2434     ('', '');
2435   }
2436 }
2437
2438 =item payinfo_masked
2439
2440 Returns a "masked" payinfo field with all but the last four characters replaced
2441 by 'x'es.  Useful for displaying credit cards.
2442
2443 =cut
2444
2445 sub payinfo_masked {
2446   my $self = shift;
2447   my $payinfo = $self->payinfo;
2448   'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
2449 }
2450
2451 =item invoicing_list [ ARRAYREF ]
2452
2453 If an arguement is given, sets these email addresses as invoice recipients
2454 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
2455 (except as warnings), so use check_invoicing_list first.
2456
2457 Returns a list of email addresses (with svcnum entries expanded).
2458
2459 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
2460 check it without disturbing anything by passing nothing.
2461
2462 This interface may change in the future.
2463
2464 =cut
2465
2466 sub invoicing_list {
2467   my( $self, $arrayref ) = @_;
2468   if ( $arrayref ) {
2469     my @cust_main_invoice;
2470     if ( $self->custnum ) {
2471       @cust_main_invoice =
2472         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2473     } else {
2474       @cust_main_invoice = ();
2475     }
2476     foreach my $cust_main_invoice ( @cust_main_invoice ) {
2477       #warn $cust_main_invoice->destnum;
2478       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2479         #warn $cust_main_invoice->destnum;
2480         my $error = $cust_main_invoice->delete;
2481         warn $error if $error;
2482       }
2483     }
2484     if ( $self->custnum ) {
2485       @cust_main_invoice =
2486         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2487     } else {
2488       @cust_main_invoice = ();
2489     }
2490     my %seen = map { $_->address => 1 } @cust_main_invoice;
2491     foreach my $address ( @{$arrayref} ) {
2492       next if exists $seen{$address} && $seen{$address};
2493       $seen{$address} = 1;
2494       my $cust_main_invoice = new FS::cust_main_invoice ( {
2495         'custnum' => $self->custnum,
2496         'dest'    => $address,
2497       } );
2498       my $error = $cust_main_invoice->insert;
2499       warn $error if $error;
2500     }
2501   }
2502   if ( $self->custnum ) {
2503     map { $_->address }
2504       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2505   } else {
2506     ();
2507   }
2508 }
2509
2510 =item check_invoicing_list ARRAYREF
2511
2512 Checks these arguements as valid input for the invoicing_list method.  If there
2513 is an error, returns the error, otherwise returns false.
2514
2515 =cut
2516
2517 sub check_invoicing_list {
2518   my( $self, $arrayref ) = @_;
2519   foreach my $address ( @{$arrayref} ) {
2520     my $cust_main_invoice = new FS::cust_main_invoice ( {
2521       'custnum' => $self->custnum,
2522       'dest'    => $address,
2523     } );
2524     my $error = $self->custnum
2525                 ? $cust_main_invoice->check
2526                 : $cust_main_invoice->checkdest
2527     ;
2528     return $error if $error;
2529   }
2530   '';
2531 }
2532
2533 =item set_default_invoicing_list
2534
2535 Sets the invoicing list to all accounts associated with this customer,
2536 overwriting any previous invoicing list.
2537
2538 =cut
2539
2540 sub set_default_invoicing_list {
2541   my $self = shift;
2542   $self->invoicing_list($self->all_emails);
2543 }
2544
2545 =item all_emails
2546
2547 Returns the email addresses of all accounts provisioned for this customer.
2548
2549 =cut
2550
2551 sub all_emails {
2552   my $self = shift;
2553   my %list;
2554   foreach my $cust_pkg ( $self->all_pkgs ) {
2555     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2556     my @svc_acct =
2557       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2558         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2559           @cust_svc;
2560     $list{$_}=1 foreach map { $_->email } @svc_acct;
2561   }
2562   keys %list;
2563 }
2564
2565 =item invoicing_list_addpost
2566
2567 Adds postal invoicing to this customer.  If this customer is already configured
2568 to receive postal invoices, does nothing.
2569
2570 =cut
2571
2572 sub invoicing_list_addpost {
2573   my $self = shift;
2574   return if grep { $_ eq 'POST' } $self->invoicing_list;
2575   my @invoicing_list = $self->invoicing_list;
2576   push @invoicing_list, 'POST';
2577   $self->invoicing_list(\@invoicing_list);
2578 }
2579
2580 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2581
2582 Returns an array of customers referred by this customer (referral_custnum set
2583 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
2584 customers referred by customers referred by this customer and so on, inclusive.
2585 The default behavior is DEPTH 1 (no recursion).
2586
2587 =cut
2588
2589 sub referral_cust_main {
2590   my $self = shift;
2591   my $depth = @_ ? shift : 1;
2592   my $exclude = @_ ? shift : {};
2593
2594   my @cust_main =
2595     map { $exclude->{$_->custnum}++; $_; }
2596       grep { ! $exclude->{ $_->custnum } }
2597         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2598
2599   if ( $depth > 1 ) {
2600     push @cust_main,
2601       map { $_->referral_cust_main($depth-1, $exclude) }
2602         @cust_main;
2603   }
2604
2605   @cust_main;
2606 }
2607
2608 =item referral_cust_main_ncancelled
2609
2610 Same as referral_cust_main, except only returns customers with uncancelled
2611 packages.
2612
2613 =cut
2614
2615 sub referral_cust_main_ncancelled {
2616   my $self = shift;
2617   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2618 }
2619
2620 =item referral_cust_pkg [ DEPTH ]
2621
2622 Like referral_cust_main, except returns a flat list of all unsuspended (and
2623 uncancelled) packages for each customer.  The number of items in this list may
2624 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2625
2626 =cut
2627
2628 sub referral_cust_pkg {
2629   my $self = shift;
2630   my $depth = @_ ? shift : 1;
2631
2632   map { $_->unsuspended_pkgs }
2633     grep { $_->unsuspended_pkgs }
2634       $self->referral_cust_main($depth);
2635 }
2636
2637 =item credit AMOUNT, REASON
2638
2639 Applies a credit to this customer.  If there is an error, returns the error,
2640 otherwise returns false.
2641
2642 =cut
2643
2644 sub credit {
2645   my( $self, $amount, $reason ) = @_;
2646   my $cust_credit = new FS::cust_credit {
2647     'custnum' => $self->custnum,
2648     'amount'  => $amount,
2649     'reason'  => $reason,
2650   };
2651   $cust_credit->insert;
2652 }
2653
2654 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2655
2656 Creates a one-time charge for this customer.  If there is an error, returns
2657 the error, otherwise returns false.
2658
2659 =cut
2660
2661 sub charge {
2662   my ( $self, $amount ) = ( shift, shift );
2663   my $pkg      = @_ ? shift : 'One-time charge';
2664   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
2665   my $taxclass = @_ ? shift : '';
2666
2667   local $SIG{HUP} = 'IGNORE';
2668   local $SIG{INT} = 'IGNORE';
2669   local $SIG{QUIT} = 'IGNORE';
2670   local $SIG{TERM} = 'IGNORE';
2671   local $SIG{TSTP} = 'IGNORE';
2672   local $SIG{PIPE} = 'IGNORE';
2673
2674   my $oldAutoCommit = $FS::UID::AutoCommit;
2675   local $FS::UID::AutoCommit = 0;
2676   my $dbh = dbh;
2677
2678   my $part_pkg = new FS::part_pkg ( {
2679     'pkg'      => $pkg,
2680     'comment'  => $comment,
2681     #'setup'    => $amount,
2682     #'recur'    => '0',
2683     'plan'     => 'flat',
2684     'plandata' => "setup_fee=$amount",
2685     'freq'     => 0,
2686     'disabled' => 'Y',
2687     'taxclass' => $taxclass,
2688   } );
2689
2690   my $error = $part_pkg->insert;
2691   if ( $error ) {
2692     $dbh->rollback if $oldAutoCommit;
2693     return $error;
2694   }
2695
2696   my $pkgpart = $part_pkg->pkgpart;
2697   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2698   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2699     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2700     $error = $type_pkgs->insert;
2701     if ( $error ) {
2702       $dbh->rollback if $oldAutoCommit;
2703       return $error;
2704     }
2705   }
2706
2707   my $cust_pkg = new FS::cust_pkg ( {
2708     'custnum' => $self->custnum,
2709     'pkgpart' => $pkgpart,
2710   } );
2711
2712   $error = $cust_pkg->insert;
2713   if ( $error ) {
2714     $dbh->rollback if $oldAutoCommit;
2715     return $error;
2716   }
2717
2718   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2719   '';
2720
2721 }
2722
2723 =item cust_bill
2724
2725 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2726
2727 =cut
2728
2729 sub cust_bill {
2730   my $self = shift;
2731   sort { $a->_date <=> $b->_date }
2732     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2733 }
2734
2735 =item open_cust_bill
2736
2737 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2738 customer.
2739
2740 =cut
2741
2742 sub open_cust_bill {
2743   my $self = shift;
2744   grep { $_->owed > 0 } $self->cust_bill;
2745 }
2746
2747 =item cust_credit
2748
2749 Returns all the credits (see L<FS::cust_credit>) for this customer.
2750
2751 =cut
2752
2753 sub cust_credit {
2754   my $self = shift;
2755   sort { $a->_date <=> $b->_date }
2756     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2757 }
2758
2759 =item cust_pay
2760
2761 Returns all the payments (see L<FS::cust_pay>) for this customer.
2762
2763 =cut
2764
2765 sub cust_pay {
2766   my $self = shift;
2767   sort { $a->_date <=> $b->_date }
2768     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2769 }
2770
2771 =item cust_pay_void
2772
2773 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
2774
2775 =cut
2776
2777 sub cust_pay_void {
2778   my $self = shift;
2779   sort { $a->_date <=> $b->_date }
2780     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
2781 }
2782
2783
2784 =item cust_refund
2785
2786 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2787
2788 =cut
2789
2790 sub cust_refund {
2791   my $self = shift;
2792   sort { $a->_date <=> $b->_date }
2793     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2794 }
2795
2796 =item select_for_update
2797
2798 Selects this record with the SQL "FOR UPDATE" command.  This can be useful as
2799 a mutex.
2800
2801 =cut
2802
2803 sub select_for_update {
2804   my $self = shift;
2805   qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
2806 }
2807
2808 =item name
2809
2810 Returns a name string for this customer, either "Company (Last, First)" or
2811 "Last, First".
2812
2813 =cut
2814
2815 sub name {
2816   my $self = shift;
2817   my $name = $self->get('last'). ', '. $self->first;
2818   $name = $self->company. " ($name)" if $self->company;
2819   $name;
2820 }
2821
2822 =item status
2823
2824 Returns a status string for this customer, currently:
2825
2826 =over 4
2827
2828 =item prospect - No packages have ever been ordered
2829
2830 =item active - One or more recurring packages is active
2831
2832 =item suspended - All non-cancelled recurring packages are suspended
2833
2834 =item cancelled - All recurring packages are cancelled
2835
2836 =back
2837
2838 =cut
2839
2840 sub status {
2841   my $self = shift;
2842   for my $status (qw( prospect active suspended cancelled )) {
2843     my $method = $status.'_sql';
2844     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
2845     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
2846     $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
2847     return $status if $sth->fetchrow_arrayref->[0];
2848   }
2849 }
2850
2851 =item statuscolor
2852
2853 Returns a hex triplet color string for this customer's status.
2854
2855 =cut
2856
2857 my %statuscolor = (
2858   'prospect'  => '000000',
2859   'active'    => '00CC00',
2860   'suspended' => 'FF9900',
2861   'cancelled' => 'FF0000',
2862 );
2863 sub statuscolor {
2864   my $self = shift;
2865   $statuscolor{$self->status};
2866 }
2867
2868 =back
2869
2870 =head1 CLASS METHODS
2871
2872 =over 4
2873
2874 =item prospect_sql
2875
2876 Returns an SQL expression identifying prospective cust_main records (customers
2877 with no packages ever ordered)
2878
2879 =cut
2880
2881 sub prospect_sql { "
2882   0 = ( SELECT COUNT(*) FROM cust_pkg
2883           WHERE cust_pkg.custnum = cust_main.custnum
2884       )
2885 "; }
2886
2887 =item active_sql
2888
2889 Returns an SQL expression identifying active cust_main records.
2890
2891 =cut
2892
2893 sub active_sql { "
2894   0 < ( SELECT COUNT(*) FROM cust_pkg
2895           WHERE cust_pkg.custnum = cust_main.custnum
2896             AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2897             AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
2898       )
2899 "; }
2900
2901 =item susp_sql
2902 =item suspended_sql
2903
2904 Returns an SQL expression identifying suspended cust_main records.
2905
2906 =cut
2907
2908 sub suspended_sql { susp_sql(@_); }
2909 sub susp_sql { "
2910     0 < ( SELECT COUNT(*) FROM cust_pkg
2911             WHERE cust_pkg.custnum = cust_main.custnum
2912               AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2913         )
2914     AND 0 = ( SELECT COUNT(*) FROM cust_pkg
2915                 WHERE cust_pkg.custnum = cust_main.custnum
2916                   AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2917             )
2918 "; }
2919
2920 =item cancel_sql
2921 =item cancelled_sql
2922
2923 Returns an SQL expression identifying cancelled cust_main records.
2924
2925 =cut
2926
2927 sub cancelled_sql { cancel_sql(@_); }
2928 sub cancel_sql { "
2929   0 < ( SELECT COUNT(*) FROM cust_pkg
2930           WHERE cust_pkg.custnum = cust_main.custnum
2931       )
2932   AND 0 = ( SELECT COUNT(*) FROM cust_pkg
2933               WHERE cust_pkg.custnum = cust_main.custnum
2934                 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2935           )
2936 "; }
2937
2938 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
2939
2940 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
2941 records.  Currently, only I<last> or I<company> may be specified (the
2942 appropriate ship_ field is also searched if applicable).
2943
2944 Additional options are the same as FS::Record::qsearch
2945
2946 =cut
2947
2948 sub fuzzy_search {
2949   my( $self, $fuzzy, $hash, @opt) = @_;
2950   #$self
2951   $hash ||= {};
2952   my @cust_main = ();
2953
2954   check_and_rebuild_fuzzyfiles();
2955   foreach my $field ( keys %$fuzzy ) {
2956     my $sub = \&{"all_$field"};
2957     my %match = ();
2958     $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
2959
2960     foreach ( keys %match ) {
2961       push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
2962       push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
2963         if defined dbdef->table('cust_main')->column('ship_last');
2964     }
2965   }
2966
2967   my %saw = ();
2968   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
2969
2970   @cust_main;
2971
2972 }
2973
2974 =back
2975
2976 =head1 SUBROUTINES
2977
2978 =over 4
2979
2980 =item check_and_rebuild_fuzzyfiles
2981
2982 =cut
2983
2984 sub check_and_rebuild_fuzzyfiles {
2985   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2986   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2987     or &rebuild_fuzzyfiles;
2988 }
2989
2990 =item rebuild_fuzzyfiles
2991
2992 =cut
2993
2994 sub rebuild_fuzzyfiles {
2995
2996   use Fcntl qw(:flock);
2997
2998   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2999
3000   #last
3001
3002   open(LASTLOCK,">>$dir/cust_main.last")
3003     or die "can't open $dir/cust_main.last: $!";
3004   flock(LASTLOCK,LOCK_EX)
3005     or die "can't lock $dir/cust_main.last: $!";
3006
3007   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3008   push @all_last,
3009                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3010     if defined dbdef->table('cust_main')->column('ship_last');
3011
3012   open (LASTCACHE,">$dir/cust_main.last.tmp")
3013     or die "can't open $dir/cust_main.last.tmp: $!";
3014   print LASTCACHE join("\n", @all_last), "\n";
3015   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3016
3017   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3018   close LASTLOCK;
3019
3020   #company
3021
3022   open(COMPANYLOCK,">>$dir/cust_main.company")
3023     or die "can't open $dir/cust_main.company: $!";
3024   flock(COMPANYLOCK,LOCK_EX)
3025     or die "can't lock $dir/cust_main.company: $!";
3026
3027   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3028   push @all_company,
3029        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3030     if defined dbdef->table('cust_main')->column('ship_last');
3031
3032   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3033     or die "can't open $dir/cust_main.company.tmp: $!";
3034   print COMPANYCACHE join("\n", @all_company), "\n";
3035   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3036
3037   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3038   close COMPANYLOCK;
3039
3040 }
3041
3042 =item all_last
3043
3044 =cut
3045
3046 sub all_last {
3047   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3048   open(LASTCACHE,"<$dir/cust_main.last")
3049     or die "can't open $dir/cust_main.last: $!";
3050   my @array = map { chomp; $_; } <LASTCACHE>;
3051   close LASTCACHE;
3052   \@array;
3053 }
3054
3055 =item all_company
3056
3057 =cut
3058
3059 sub all_company {
3060   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3061   open(COMPANYCACHE,"<$dir/cust_main.company")
3062     or die "can't open $dir/cust_main.last: $!";
3063   my @array = map { chomp; $_; } <COMPANYCACHE>;
3064   close COMPANYCACHE;
3065   \@array;
3066 }
3067
3068 =item append_fuzzyfiles LASTNAME COMPANY
3069
3070 =cut
3071
3072 sub append_fuzzyfiles {
3073   my( $last, $company ) = @_;
3074
3075   &check_and_rebuild_fuzzyfiles;
3076
3077   use Fcntl qw(:flock);
3078
3079   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3080
3081   if ( $last ) {
3082
3083     open(LAST,">>$dir/cust_main.last")
3084       or die "can't open $dir/cust_main.last: $!";
3085     flock(LAST,LOCK_EX)
3086       or die "can't lock $dir/cust_main.last: $!";
3087
3088     print LAST "$last\n";
3089
3090     flock(LAST,LOCK_UN)
3091       or die "can't unlock $dir/cust_main.last: $!";
3092     close LAST;
3093   }
3094
3095   if ( $company ) {
3096
3097     open(COMPANY,">>$dir/cust_main.company")
3098       or die "can't open $dir/cust_main.company: $!";
3099     flock(COMPANY,LOCK_EX)
3100       or die "can't lock $dir/cust_main.company: $!";
3101
3102     print COMPANY "$company\n";
3103
3104     flock(COMPANY,LOCK_UN)
3105       or die "can't unlock $dir/cust_main.company: $!";
3106
3107     close COMPANY;
3108   }
3109
3110   1;
3111 }
3112
3113 =item batch_import
3114
3115 =cut
3116
3117 sub batch_import {
3118   my $param = shift;
3119   #warn join('-',keys %$param);
3120   my $fh = $param->{filehandle};
3121   my $agentnum = $param->{agentnum};
3122   my $refnum = $param->{refnum};
3123   my $pkgpart = $param->{pkgpart};
3124   my @fields = @{$param->{fields}};
3125
3126   eval "use Date::Parse;";
3127   die $@ if $@;
3128   eval "use Text::CSV_XS;";
3129   die $@ if $@;
3130
3131   my $csv = new Text::CSV_XS;
3132   #warn $csv;
3133   #warn $fh;
3134
3135   my $imported = 0;
3136   #my $columns;
3137
3138   local $SIG{HUP} = 'IGNORE';
3139   local $SIG{INT} = 'IGNORE';
3140   local $SIG{QUIT} = 'IGNORE';
3141   local $SIG{TERM} = 'IGNORE';
3142   local $SIG{TSTP} = 'IGNORE';
3143   local $SIG{PIPE} = 'IGNORE';
3144
3145   my $oldAutoCommit = $FS::UID::AutoCommit;
3146   local $FS::UID::AutoCommit = 0;
3147   my $dbh = dbh;
3148
3149   #while ( $columns = $csv->getline($fh) ) {
3150   my $line;
3151   while ( defined($line=<$fh>) ) {
3152
3153     $csv->parse($line) or do {
3154       $dbh->rollback if $oldAutoCommit;
3155       return "can't parse: ". $csv->error_input();
3156     };
3157
3158     my @columns = $csv->fields();
3159     #warn join('-',@columns);
3160
3161     my %cust_main = (
3162       agentnum => $agentnum,
3163       refnum   => $refnum,
3164       country  => $conf->config('countrydefault') || 'US',
3165       payby    => 'BILL', #default
3166       paydate  => '12/2037', #default
3167     );
3168     my $billtime = time;
3169     my %cust_pkg = ( pkgpart => $pkgpart );
3170     foreach my $field ( @fields ) {
3171       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
3172         #$cust_pkg{$1} = str2time( shift @$columns );
3173         if ( $1 eq 'setup' ) {
3174           $billtime = str2time(shift @columns);
3175         } else {
3176           $cust_pkg{$1} = str2time( shift @columns );
3177         }
3178       } else {
3179         #$cust_main{$field} = shift @$columns;
3180         $cust_main{$field} = shift @columns;
3181       }
3182     }
3183
3184     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
3185     my $cust_main = new FS::cust_main ( \%cust_main );
3186     use Tie::RefHash;
3187     tie my %hash, 'Tie::RefHash'; #this part is important
3188     $hash{$cust_pkg} = [] if $pkgpart;
3189     my $error = $cust_main->insert( \%hash );
3190
3191     if ( $error ) {
3192       $dbh->rollback if $oldAutoCommit;
3193       return "can't insert customer for $line: $error";
3194     }
3195
3196     #false laziness w/bill.cgi
3197     $error = $cust_main->bill( 'time' => $billtime );
3198     if ( $error ) {
3199       $dbh->rollback if $oldAutoCommit;
3200       return "can't bill customer for $line: $error";
3201     }
3202
3203     $cust_main->apply_payments;
3204     $cust_main->apply_credits;
3205
3206     $error = $cust_main->collect();
3207     if ( $error ) {
3208       $dbh->rollback if $oldAutoCommit;
3209       return "can't collect customer for $line: $error";
3210     }
3211
3212     $imported++;
3213   }
3214
3215   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3216
3217   return "Empty file!" unless $imported;
3218
3219   ''; #no error
3220
3221 }
3222
3223 =item batch_charge
3224
3225 =cut
3226
3227 sub batch_charge {
3228   my $param = shift;
3229   #warn join('-',keys %$param);
3230   my $fh = $param->{filehandle};
3231   my @fields = @{$param->{fields}};
3232
3233   eval "use Date::Parse;";
3234   die $@ if $@;
3235   eval "use Text::CSV_XS;";
3236   die $@ if $@;
3237
3238   my $csv = new Text::CSV_XS;
3239   #warn $csv;
3240   #warn $fh;
3241
3242   my $imported = 0;
3243   #my $columns;
3244
3245   local $SIG{HUP} = 'IGNORE';
3246   local $SIG{INT} = 'IGNORE';
3247   local $SIG{QUIT} = 'IGNORE';
3248   local $SIG{TERM} = 'IGNORE';
3249   local $SIG{TSTP} = 'IGNORE';
3250   local $SIG{PIPE} = 'IGNORE';
3251
3252   my $oldAutoCommit = $FS::UID::AutoCommit;
3253   local $FS::UID::AutoCommit = 0;
3254   my $dbh = dbh;
3255
3256   #while ( $columns = $csv->getline($fh) ) {
3257   my $line;
3258   while ( defined($line=<$fh>) ) {
3259
3260     $csv->parse($line) or do {
3261       $dbh->rollback if $oldAutoCommit;
3262       return "can't parse: ". $csv->error_input();
3263     };
3264
3265     my @columns = $csv->fields();
3266     #warn join('-',@columns);
3267
3268     my %row = ();
3269     foreach my $field ( @fields ) {
3270       $row{$field} = shift @columns;
3271     }
3272
3273     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
3274     unless ( $cust_main ) {
3275       $dbh->rollback if $oldAutoCommit;
3276       return "unknown custnum $row{'custnum'}";
3277     }
3278
3279     if ( $row{'amount'} > 0 ) {
3280       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
3281       if ( $error ) {
3282         $dbh->rollback if $oldAutoCommit;
3283         return $error;
3284       }
3285       $imported++;
3286     } elsif ( $row{'amount'} < 0 ) {
3287       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
3288                                       $row{'pkg'}                         );
3289       if ( $error ) {
3290         $dbh->rollback if $oldAutoCommit;
3291         return $error;
3292       }
3293       $imported++;
3294     } else {
3295       #hmm?
3296     }
3297
3298   }
3299
3300   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3301
3302   return "Empty file!" unless $imported;
3303
3304   ''; #no error
3305
3306 }
3307
3308 =back
3309
3310 =head1 BUGS
3311
3312 The delete method.
3313
3314 The delete method should possibly take an FS::cust_main object reference
3315 instead of a scalar customer number.
3316
3317 Bill and collect options should probably be passed as references instead of a
3318 list.
3319
3320 There should probably be a configuration file with a list of allowed credit
3321 card types.
3322
3323 No multiple currency support (probably a larger project than just this module).
3324
3325 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
3326
3327 =head1 SEE ALSO
3328
3329 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
3330 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
3331 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
3332
3333 =cut
3334
3335 1;
3336