FS/FS/cust_main.pm

   1 package FS::cust_main;
   2
   3 use strict;
   4 use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields
   5              $import $skip_fuzzyfiles $ignore_expired_card );
   6 use vars qw( $realtime_bop_decline_quiet ); #ugh
   7 use Safe;
   8 use Carp;
   9 use Exporter;
  10 BEGIN {
  11   eval "use Time::Local;";
  12   die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
  13     if $] < 5.006 && !defined($Time::Local::VERSION);
  14   #eval "use Time::Local qw(timelocal timelocal_nocheck);";
  15   eval "use Time::Local qw(timelocal_nocheck);";
  16 }
  17 use Digest::MD5 qw(md5_base64);
  18 use Date::Format;
  19 use Date::Parse;
  20 #use Date::Manip;
  21 use String::Approx qw(amatch);
  22 use Business::CreditCard 0.28;
  23 use Locale::Country;
  24 use FS::UID qw( getotaker dbh );
  25 use FS::Record qw( qsearchs qsearch dbdef );
  26 use FS::Misc qw( send_email );
  27 use FS::Msgcat qw(gettext);
  28 use FS::cust_pkg;
  29 use FS::cust_svc;
  30 use FS::cust_bill;
  31 use FS::cust_bill_pkg;
  32 use FS::cust_pay;
  33 use FS::cust_pay_void;
  34 use FS::cust_credit;
  35 use FS::cust_refund;
  36 use FS::part_referral;
  37 use FS::cust_main_county;
  38 use FS::agent;
  39 use FS::cust_main_invoice;
  40 use FS::cust_credit_bill;
  41 use FS::cust_bill_pay;
  42 use FS::prepay_credit;
  43 use FS::queue;
  44 use FS::part_pkg;
  45 use FS::part_bill_event;
  46 use FS::cust_bill_event;
  47 use FS::cust_tax_exempt;
  48 use FS::cust_tax_exempt_pkg;
  49 use FS::type_pkgs;
  50 use FS::payment_gateway;
  51 use FS::agent_payment_gateway;
  52 use FS::banned_pay;
  53
  54 @ISA = qw( FS::Record );
  55
  56 @EXPORT_OK = qw( smart_search );
  57
  58 $realtime_bop_decline_quiet = 0;
  59
  60 # 1 is mostly method/subroutine entry and options
  61 # 2 traces progress of some operations
  62 # 3 is even more information including possibly sensitive data
  63 $DEBUG = 0;
  64 $me = '[FS::cust_main]';
  65
  66 $import = 0;
  67 $skip_fuzzyfiles = 0;
  68 $ignore_expired_card = 0;
  69
  70 @encrypted_fields = ('payinfo', 'paycvv');
  71
  72 #ask FS::UID to run this stuff for us later
  73 #$FS::UID::callback{'FS::cust_main'} = sub {
  74 install_callback FS::UID sub {
  75   $conf = new FS::Conf;
  76   #yes, need it for stuff below (prolly should be cached)
  77 };
  78
  79 sub _cache {
  80   my $self = shift;
  81   my ( $hashref, $cache ) = @_;
  82   if ( exists $hashref->{'pkgnum'} ) {
  83     #@{ $self->{'_pkgnum'} } = ();
  84     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
  85     $self->{'_pkgnum'} = $subcache;
  86     #push @{ $self->{'_pkgnum'} },
  87     FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
  88   }
  89 }
  90
  91 =head1 NAME
  92
  93 FS::cust_main - Object methods for cust_main records
  94
  95 =head1 SYNOPSIS
  96
  97   use FS::cust_main;
  98
  99   $record = new FS::cust_main \%hash;
 100   $record = new FS::cust_main { 'column' => 'value' };
 101
 102   $error = $record->insert;
 103
 104   $error = $new_record->replace($old_record);
 105
 106   $error = $record->delete;
 107
 108   $error = $record->check;
 109
 110   @cust_pkg = $record->all_pkgs;
 111
 112   @cust_pkg = $record->ncancelled_pkgs;
 113
 114   @cust_pkg = $record->suspended_pkgs;
 115
 116   $error = $record->bill;
 117   $error = $record->bill %options;
 118   $error = $record->bill 'time' => $time;
 119
 120   $error = $record->collect;
 121   $error = $record->collect %options;
 122   $error = $record->collect 'invoice_time'   => $time,
 123                           ;
 124
 125 =head1 DESCRIPTION
 126
 127 An FS::cust_main object represents a customer.  FS::cust_main inherits from
 128 FS::Record.  The following fields are currently supported:
 129
 130 =over 4
 131
 132 =item custnum - primary key (assigned automatically for new customers)
 133
 134 =item agentnum - agent (see L<FS::agent>)
 135
 136 =item refnum - Advertising source (see L<FS::part_referral>)
 137
 138 =item first - name
 139
 140 =item last - name
 141
 142 =item ss - social security number (optional)
 143
 144 =item company - (optional)
 145
 146 =item address1
 147
 148 =item address2 - (optional)
 149
 150 =item city
 151
 152 =item county - (optional, see L<FS::cust_main_county>)
 153
 154 =item state - (see L<FS::cust_main_county>)
 155
 156 =item zip
 157
 158 =item country - (see L<FS::cust_main_county>)
 159
 160 =item daytime - phone (optional)
 161
 162 =item night - phone (optional)
 163
 164 =item fax - phone (optional)
 165
 166 =item ship_first - name
 167
 168 =item ship_last - name
 169
 170 =item ship_company - (optional)
 171
 172 =item ship_address1
 173
 174 =item ship_address2 - (optional)
 175
 176 =item ship_city
 177
 178 =item ship_county - (optional, see L<FS::cust_main_county>)
 179
 180 =item ship_state - (see L<FS::cust_main_county>)
 181
 182 =item ship_zip
 183
 184 =item ship_country - (see L<FS::cust_main_county>)
 185
 186 =item ship_daytime - phone (optional)
 187
 188 =item ship_night - phone (optional)
 189
 190 =item ship_fax - phone (optional)
 191
 192 =item payby
 193
 194 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>)
 195
 196 =item payinfo
 197
 198 Card Number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
 199
 200 =cut
 201
 202 sub payinfo {
 203   my($self,$payinfo) = @_;
 204   if ( defined($payinfo) ) {
 205     $self->paymask($payinfo);
 206     $self->setfield('payinfo', $payinfo); # This is okay since we are the 'setter'
 207   } else {
 208     $payinfo = $self->getfield('payinfo'); # This is okay since we are the 'getter'
 209     return $payinfo;
 210   }
 211 }
 212
 213
 214 =item paycvv
 215
 216 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
 217
 218 =cut
 219
 220 =item paymask - Masked payment type
 221
 222 =over 4
 223
 224 =item Credit Cards
 225
 226 Mask all but the last four characters.
 227
 228 =item Checks
 229
 230 Mask all but last 2 of account number and bank routing number.
 231
 232 =item Others
 233
 234 Do nothing, return the unmasked string.
 235
 236 =back
 237
 238 =cut
 239
 240 sub paymask {
 241   my($self,$value)=@_;
 242
 243   # If it doesn't exist then generate it
 244   my $paymask=$self->getfield('paymask');
 245   if (!defined($value) && (!defined($paymask) || $paymask eq '')) {
 246     $value = $self->payinfo;
 247   }
 248
 249   if ( defined($value) && !$self->is_encrypted($value)) {
 250     my $payinfo = $value;
 251     my $payby = $self->payby;
 252     if ($payby eq 'CARD' || $payby eq 'DCRD') { # Credit Cards (Show last four)
 253       $paymask = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
 254     } elsif ($payby eq 'CHEK' ||
 255              $payby eq 'DCHK' ) { # Checks (Show last 2 @ bank)
 256       my( $account, $aba ) = split('@', $payinfo );
 257       $paymask = 'x'x(length($account)-2). substr($account,(length($account)-2))."@".$aba;
 258     } else { # Tie up loose ends
 259       $paymask = $payinfo;
 260     }
 261     $self->setfield('paymask', $paymask); # This is okay since we are the 'setter'
 262   } elsif (defined($value) && $self->is_encrypted($value)) {
 263     $paymask = 'N/A';
 264   }
 265   return $paymask;
 266 }
 267
 268 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 269
 270 =item paystart_month - start date month (maestro/solo cards only)
 271
 272 =item paystart_year - start date year (maestro/solo cards only)
 273
 274 =item payissue - issue number (maestro/solo cards only)
 275
 276 =item payname - name on card or billing name
 277
 278 =item payip - IP address from which payment information was received
 279
 280 =item tax - tax exempt, empty or `Y'
 281
 282 =item otaker - order taker (assigned automatically, see L<FS::UID>)
 283
 284 =item comments - comments (optional)
 285
 286 =item referral_custnum - referring customer number
 287
 288 =item spool_cdr - Enable individual CDR spooling, empty or `Y'
 289
 290 =back
 291
 292 =head1 METHODS
 293
 294 =over 4
 295
 296 =item new HASHREF
 297
 298 Creates a new customer.  To add the customer to the database, see L<"insert">.
 299
 300 Note that this stores the hash reference, not a distinct copy of the hash it
 301 points to.  You can ask the object for a copy with the I<hash> method.
 302
 303 =cut
 304
 305 sub table { 'cust_main'; }
 306
 307 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
 308
 309 Adds this customer to the database.  If there is an error, returns the error,
 310 otherwise returns false.
 311
 312 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
 313 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
 314 are inserted atomicly, or the transaction is rolled back.  Passing an empty
 315 hash reference is equivalent to not supplying this parameter.  There should be
 316 a better explanation of this, but until then, here's an example:
 317
 318   use Tie::RefHash;
 319   tie %hash, 'Tie::RefHash'; #this part is important
 320   %hash = (
 321     $cust_pkg => [ $svc_acct ],
 322     ...
 323   );
 324   $cust_main->insert( \%hash );
 325
 326 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 327 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 328 expected and rollback the entire transaction; it is not necessary to call
 329 check_invoicing_list first.  The invoicing_list is set after the records in the
 330 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
 331 invoicing_list destination to the newly-created svc_acct.  Here's an example:
 332
 333   $cust_main->insert( {}, [ $email, 'POST' ] );
 334
 335 Currently available options are: I<depend_jobnum> and I<noexport>.
 336
 337 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 338 on the supplied jobnum (they will not run until the specific job completes).
 339 This can be used to defer provisioning until some action completes (such
 340 as running the customer's credit card successfully).
 341
 342 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 343 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 344 the B<reexport> method.)
 345
 346 =cut
 347
 348 sub insert {
 349   my $self = shift;
 350   my $cust_pkgs = @_ ? shift : {};
 351   my $invoicing_list = @_ ? shift : '';
 352   my %options = @_;
 353   warn "$me insert called with options ".
 354        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 355     if $DEBUG;
 356
 357   local $SIG{HUP} = 'IGNORE';
 358   local $SIG{INT} = 'IGNORE';
 359   local $SIG{QUIT} = 'IGNORE';
 360   local $SIG{TERM} = 'IGNORE';
 361   local $SIG{TSTP} = 'IGNORE';
 362   local $SIG{PIPE} = 'IGNORE';
 363
 364   my $oldAutoCommit = $FS::UID::AutoCommit;
 365   local $FS::UID::AutoCommit = 0;
 366   my $dbh = dbh;
 367
 368   my $prepay_identifier = '';
 369   my( $amount, $seconds ) = ( 0, 0 );
 370   my $payby = '';
 371   if ( $self->payby eq 'PREPAY' ) {
 372
 373     $self->payby('BILL');
 374     $prepay_identifier = $self->payinfo;
 375     $self->payinfo('');
 376
 377     warn "  looking up prepaid card $prepay_identifier\n"
 378       if $DEBUG > 1;
 379
 380     my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds);
 381     if ( $error ) {
 382       $dbh->rollback if $oldAutoCommit;
 383       #return "error applying prepaid card (transaction rolled back): $error";
 384       return $error;
 385     }
 386
 387     $payby = 'PREP' if $amount;
 388
 389   } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
 390
 391     $payby = $1;
 392     $self->payby('BILL');
 393     $amount = $self->paid;
 394
 395   }
 396
 397   warn "  inserting $self\n"
 398     if $DEBUG > 1;
 399
 400   my $error = $self->SUPER::insert;
 401   if ( $error ) {
 402     $dbh->rollback if $oldAutoCommit;
 403     #return "inserting cust_main record (transaction rolled back): $error";
 404     return $error;
 405   }
 406
 407   warn "  setting invoicing list\n"
 408     if $DEBUG > 1;
 409
 410   if ( $invoicing_list ) {
 411     $error = $self->check_invoicing_list( $invoicing_list );
 412     if ( $error ) {
 413       $dbh->rollback if $oldAutoCommit;
 414       return "checking invoicing_list (transaction rolled back): $error";
 415     }
 416     $self->invoicing_list( $invoicing_list );
 417   }
 418
 419   warn "  ordering packages\n"
 420     if $DEBUG > 1;
 421
 422   $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
 423   if ( $error ) {
 424     $dbh->rollback if $oldAutoCommit;
 425     return $error;
 426   }
 427
 428   if ( $seconds ) {
 429     $dbh->rollback if $oldAutoCommit;
 430     return "No svc_acct record to apply pre-paid time";
 431   }
 432
 433   if ( $amount ) {
 434     warn "  inserting initial $payby payment of $amount\n"
 435       if $DEBUG > 1;
 436     $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
 437     if ( $error ) {
 438       $dbh->rollback if $oldAutoCommit;
 439       return "inserting payment (transaction rolled back): $error";
 440     }
 441   }
 442
 443   unless ( $import || $skip_fuzzyfiles ) {
 444     warn "  queueing fuzzyfiles update\n"
 445       if $DEBUG > 1;
 446     $error = $self->queue_fuzzyfiles_update;
 447     if ( $error ) {
 448       $dbh->rollback if $oldAutoCommit;
 449       return "updating fuzzy search cache: $error";
 450     }
 451   }
 452
 453   warn "  insert complete; committing transaction\n"
 454     if $DEBUG > 1;
 455
 456   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 457   '';
 458
 459 }
 460
 461 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
 462
 463 Like the insert method on an existing record, this method orders a package
 464 and included services atomicaly.  Pass a Tie::RefHash data structure to this
 465 method containing FS::cust_pkg and FS::svc_I<tablename> objects.  There should
 466 be a better explanation of this, but until then, here's an example:
 467
 468   use Tie::RefHash;
 469   tie %hash, 'Tie::RefHash'; #this part is important
 470   %hash = (
 471     $cust_pkg => [ $svc_acct ],
 472     ...
 473   );
 474   $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
 475
 476 Services can be new, in which case they are inserted, or existing unaudited
 477 services, in which case they are linked to the newly-created package.
 478
 479 Currently available options are: I<depend_jobnum> and I<noexport>.
 480
 481 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 482 on the supplied jobnum (they will not run until the specific job completes).
 483 This can be used to defer provisioning until some action completes (such
 484 as running the customer's credit card successfully).
 485
 486 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 487 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 488 the B<reexport> method for each cust_pkg object.  Using the B<reexport> method
 489 on the cust_main object is not recommended, as existing services will also be
 490 reexported.)
 491
 492 =cut
 493
 494 sub order_pkgs {
 495   my $self = shift;
 496   my $cust_pkgs = shift;
 497   my $seconds = shift;
 498   my %options = @_;
 499   my %svc_options = ();
 500   $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
 501     if exists $options{'depend_jobnum'};
 502   warn "$me order_pkgs called with options ".
 503        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 504     if $DEBUG;
 505
 506   local $SIG{HUP} = 'IGNORE';
 507   local $SIG{INT} = 'IGNORE';
 508   local $SIG{QUIT} = 'IGNORE';
 509   local $SIG{TERM} = 'IGNORE';
 510   local $SIG{TSTP} = 'IGNORE';
 511   local $SIG{PIPE} = 'IGNORE';
 512
 513   my $oldAutoCommit = $FS::UID::AutoCommit;
 514   local $FS::UID::AutoCommit = 0;
 515   my $dbh = dbh;
 516
 517   local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
 518
 519   foreach my $cust_pkg ( keys %$cust_pkgs ) {
 520     $cust_pkg->custnum( $self->custnum );
 521     my $error = $cust_pkg->insert;
 522     if ( $error ) {
 523       $dbh->rollback if $oldAutoCommit;
 524       return "inserting cust_pkg (transaction rolled back): $error";
 525     }
 526     foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
 527       if ( $svc_something->svcnum ) {
 528         my $old_cust_svc = $svc_something->cust_svc;
 529         my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
 530         $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
 531         $error = $new_cust_svc->replace($old_cust_svc);
 532       } else {
 533         $svc_something->pkgnum( $cust_pkg->pkgnum );
 534         if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
 535           $svc_something->seconds( $svc_something->seconds + $$seconds );
 536           $$seconds = 0;
 537         }
 538         $error = $svc_something->insert(%svc_options);
 539       }
 540       if ( $error ) {
 541         $dbh->rollback if $oldAutoCommit;
 542         #return "inserting svc_ (transaction rolled back): $error";
 543         return $error;
 544       }
 545     }
 546   }
 547
 548   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 549   ''; #no error
 550 }
 551
 552 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF ]
 553
 554 Recharges this (existing) customer with the specified prepaid card (see
 555 L<FS::prepay_credit>), specified either by I<identifier> or as an
 556 FS::prepay_credit object.  If there is an error, returns the error, otherwise
 557 returns false.
 558
 559 Optionally, two scalar references can be passed as well.  They will have their
 560 values filled in with the amount and number of seconds applied by this prepaid
 561 card.
 562
 563 =cut
 564
 565 sub recharge_prepay {
 566   my( $self, $prepay_credit, $amountref, $secondsref ) = @_;
 567
 568   local $SIG{HUP} = 'IGNORE';
 569   local $SIG{INT} = 'IGNORE';
 570   local $SIG{QUIT} = 'IGNORE';
 571   local $SIG{TERM} = 'IGNORE';
 572   local $SIG{TSTP} = 'IGNORE';
 573   local $SIG{PIPE} = 'IGNORE';
 574
 575   my $oldAutoCommit = $FS::UID::AutoCommit;
 576   local $FS::UID::AutoCommit = 0;
 577   my $dbh = dbh;
 578
 579   my( $amount, $seconds ) = ( 0, 0 );
 580
 581   my $error = $self->get_prepay($prepay_credit, \$amount, \$seconds)
 582            || $self->increment_seconds($seconds)
 583            || $self->insert_cust_pay_prepay( $amount,
 584                                              ref($prepay_credit)
 585                                                ? $prepay_credit->identifier
 586                                                : $prepay_credit
 587                                            );
 588
 589   if ( $error ) {
 590     $dbh->rollback if $oldAutoCommit;
 591     return $error;
 592   }
 593
 594   if ( defined($amountref)  ) { $$amountref  = $amount;  }
 595   if ( defined($secondsref) ) { $$secondsref = $seconds; }
 596
 597   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 598   '';
 599
 600 }
 601
 602 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF
 603
 604 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
 605 specified either by I<identifier> or as an FS::prepay_credit object.
 606
 607 References to I<amount> and I<seconds> scalars should be passed as arguments
 608 and will be incremented by the values of the prepaid card.
 609
 610 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
 611 check or set this customer's I<agentnum>.
 612
 613 If there is an error, returns the error, otherwise returns false.
 614
 615 =cut
 616
 617
 618 sub get_prepay {
 619   my( $self, $prepay_credit, $amountref, $secondsref ) = @_;
 620
 621   local $SIG{HUP} = 'IGNORE';
 622   local $SIG{INT} = 'IGNORE';
 623   local $SIG{QUIT} = 'IGNORE';
 624   local $SIG{TERM} = 'IGNORE';
 625   local $SIG{TSTP} = 'IGNORE';
 626   local $SIG{PIPE} = 'IGNORE';
 627
 628   my $oldAutoCommit = $FS::UID::AutoCommit;
 629   local $FS::UID::AutoCommit = 0;
 630   my $dbh = dbh;
 631
 632   unless ( ref($prepay_credit) ) {
 633
 634     my $identifier = $prepay_credit;
 635
 636     $prepay_credit = qsearchs(
 637       'prepay_credit',
 638       { 'identifier' => $prepay_credit },
 639       '',
 640       'FOR UPDATE'
 641     );
 642
 643     unless ( $prepay_credit ) {
 644       $dbh->rollback if $oldAutoCommit;
 645       return "Invalid prepaid card: ". $identifier;
 646     }
 647
 648   }
 649
 650   if ( $prepay_credit->agentnum ) {
 651     if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
 652       $dbh->rollback if $oldAutoCommit;
 653       return "prepaid card not valid for agent ". $self->agentnum;
 654     }
 655     $self->agentnum($prepay_credit->agentnum);
 656   }
 657
 658   my $error = $prepay_credit->delete;
 659   if ( $error ) {
 660     $dbh->rollback if $oldAutoCommit;
 661     return "removing prepay_credit (transaction rolled back): $error";
 662   }
 663
 664   $$amountref  += $prepay_credit->amount;
 665   $$secondsref += $prepay_credit->seconds;
 666
 667   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 668   '';
 669
 670 }
 671
 672 =item increment_seconds SECONDS
 673
 674 Updates this customer's single or primary account (see L<FS::svc_acct>) by
 675 the specified number of seconds.  If there is an error, returns the error,
 676 otherwise returns false.
 677
 678 =cut
 679
 680 sub increment_seconds {
 681   my( $self, $seconds ) = @_;
 682   warn "$me increment_seconds called: $seconds seconds\n"
 683     if $DEBUG;
 684
 685   my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
 686                       $self->ncancelled_pkgs;
 687
 688   if ( ! @cust_pkg ) {
 689     return 'No packages with primary or single services found'.
 690            ' to apply pre-paid time';
 691   } elsif ( scalar(@cust_pkg) > 1 ) {
 692     #maybe have a way to specify the package/account?
 693     return 'Multiple packages found to apply pre-paid time';
 694   }
 695
 696   my $cust_pkg = $cust_pkg[0];
 697   warn "  found package pkgnum ". $cust_pkg->pkgnum. "\n"
 698     if $DEBUG > 1;
 699
 700   my @cust_svc =
 701     $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
 702
 703   if ( ! @cust_svc ) {
 704     return 'No account found to apply pre-paid time';
 705   } elsif ( scalar(@cust_svc) > 1 ) {
 706     return 'Multiple accounts found to apply pre-paid time';
 707   }
 708
 709   my $svc_acct = $cust_svc[0]->svc_x;
 710   warn "  found service svcnum ". $svc_acct->pkgnum.
 711        ' ('. $svc_acct->email. ")\n"
 712     if $DEBUG > 1;
 713
 714   $svc_acct->increment_seconds($seconds);
 715
 716 }
 717
 718 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
 719
 720 Inserts a prepayment in the specified amount for this customer.  An optional
 721 second argument can specify the prepayment identifier for tracking purposes.
 722 If there is an error, returns the error, otherwise returns false.
 723
 724 =cut
 725
 726 sub insert_cust_pay_prepay {
 727   shift->insert_cust_pay('PREP', @_);
 728 }
 729
 730 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
 731
 732 Inserts a cash payment in the specified amount for this customer.  An optional
 733 second argument can specify the payment identifier for tracking purposes.
 734 If there is an error, returns the error, otherwise returns false.
 735
 736 =cut
 737
 738 sub insert_cust_pay_cash {
 739   shift->insert_cust_pay('CASH', @_);
 740 }
 741
 742 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
 743
 744 Inserts a Western Union payment in the specified amount for this customer.  An
 745 optional second argument can specify the prepayment identifier for tracking
 746 purposes.  If there is an error, returns the error, otherwise returns false.
 747
 748 =cut
 749
 750 sub insert_cust_pay_west {
 751   shift->insert_cust_pay('WEST', @_);
 752 }
 753
 754 sub insert_cust_pay {
 755   my( $self, $payby, $amount ) = splice(@_, 0, 3);
 756   my $payinfo = scalar(@_) ? shift : '';
 757
 758   my $cust_pay = new FS::cust_pay {
 759     'custnum' => $self->custnum,
 760     'paid'    => sprintf('%.2f', $amount),
 761     #'_date'   => #date the prepaid card was purchased???
 762     'payby'   => $payby,
 763     'payinfo' => $payinfo,
 764   };
 765   $cust_pay->insert;
 766
 767 }
 768
 769 =item reexport
 770
 771 This method is deprecated.  See the I<depend_jobnum> option to the insert and
 772 order_pkgs methods for a better way to defer provisioning.
 773
 774 Re-schedules all exports by calling the B<reexport> method of all associated
 775 packages (see L<FS::cust_pkg>).  If there is an error, returns the error;
 776 otherwise returns false.
 777
 778 =cut
 779
 780 sub reexport {
 781   my $self = shift;
 782
 783   carp "WARNING: FS::cust_main::reexport is deprectated; ".
 784        "use the depend_jobnum option to insert or order_pkgs to delay export";
 785
 786   local $SIG{HUP} = 'IGNORE';
 787   local $SIG{INT} = 'IGNORE';
 788   local $SIG{QUIT} = 'IGNORE';
 789   local $SIG{TERM} = 'IGNORE';
 790   local $SIG{TSTP} = 'IGNORE';
 791   local $SIG{PIPE} = 'IGNORE';
 792
 793   my $oldAutoCommit = $FS::UID::AutoCommit;
 794   local $FS::UID::AutoCommit = 0;
 795   my $dbh = dbh;
 796
 797   foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
 798     my $error = $cust_pkg->reexport;
 799     if ( $error ) {
 800       $dbh->rollback if $oldAutoCommit;
 801       return $error;
 802     }
 803   }
 804
 805   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 806   '';
 807
 808 }
 809
 810 =item delete NEW_CUSTNUM
 811
 812 This deletes the customer.  If there is an error, returns the error, otherwise
 813 returns false.
 814
 815 This will completely remove all traces of the customer record.  This is not
 816 what you want when a customer cancels service; for that, cancel all of the
 817 customer's packages (see L</cancel>).
 818
 819 If the customer has any uncancelled packages, you need to pass a new (valid)
 820 customer number for those packages to be transferred to.  Cancelled packages
 821 will be deleted.  Did I mention that this is NOT what you want when a customer
 822 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
 823
 824 You can't delete a customer with invoices (see L<FS::cust_bill>),
 825 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
 826 refunds (see L<FS::cust_refund>).
 827
 828 =cut
 829
 830 sub delete {
 831   my $self = shift;
 832
 833   local $SIG{HUP} = 'IGNORE';
 834   local $SIG{INT} = 'IGNORE';
 835   local $SIG{QUIT} = 'IGNORE';
 836   local $SIG{TERM} = 'IGNORE';
 837   local $SIG{TSTP} = 'IGNORE';
 838   local $SIG{PIPE} = 'IGNORE';
 839
 840   my $oldAutoCommit = $FS::UID::AutoCommit;
 841   local $FS::UID::AutoCommit = 0;
 842   my $dbh = dbh;
 843
 844   if ( $self->cust_bill ) {
 845     $dbh->rollback if $oldAutoCommit;
 846     return "Can't delete a customer with invoices";
 847   }
 848   if ( $self->cust_credit ) {
 849     $dbh->rollback if $oldAutoCommit;
 850     return "Can't delete a customer with credits";
 851   }
 852   if ( $self->cust_pay ) {
 853     $dbh->rollback if $oldAutoCommit;
 854     return "Can't delete a customer with payments";
 855   }
 856   if ( $self->cust_refund ) {
 857     $dbh->rollback if $oldAutoCommit;
 858     return "Can't delete a customer with refunds";
 859   }
 860
 861   my @cust_pkg = $self->ncancelled_pkgs;
 862   if ( @cust_pkg ) {
 863     my $new_custnum = shift;
 864     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
 865       $dbh->rollback if $oldAutoCommit;
 866       return "Invalid new customer number: $new_custnum";
 867     }
 868     foreach my $cust_pkg ( @cust_pkg ) {
 869       my %hash = $cust_pkg->hash;
 870       $hash{'custnum'} = $new_custnum;
 871       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
 872       my $error = $new_cust_pkg->replace($cust_pkg);
 873       if ( $error ) {
 874         $dbh->rollback if $oldAutoCommit;
 875         return $error;
 876       }
 877     }
 878   }
 879   my @cancelled_cust_pkg = $self->all_pkgs;
 880   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
 881     my $error = $cust_pkg->delete;
 882     if ( $error ) {
 883       $dbh->rollback if $oldAutoCommit;
 884       return $error;
 885     }
 886   }
 887
 888   foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
 889     qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
 890   ) {
 891     my $error = $cust_main_invoice->delete;
 892     if ( $error ) {
 893       $dbh->rollback if $oldAutoCommit;
 894       return $error;
 895     }
 896   }
 897
 898   my $error = $self->SUPER::delete;
 899   if ( $error ) {
 900     $dbh->rollback if $oldAutoCommit;
 901     return $error;
 902   }
 903
 904   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 905   '';
 906
 907 }
 908
 909 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
 910
 911 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 912 returns the error, otherwise returns false.
 913
 914 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 915 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 916 expected and rollback the entire transaction; it is not necessary to call
 917 check_invoicing_list first.  Here's an example:
 918
 919   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
 920
 921 =cut
 922
 923 sub replace {
 924   my $self = shift;
 925   my $old = shift;
 926   my @param = @_;
 927   warn "$me replace called\n"
 928     if $DEBUG;
 929
 930   local $SIG{HUP} = 'IGNORE';
 931   local $SIG{INT} = 'IGNORE';
 932   local $SIG{QUIT} = 'IGNORE';
 933   local $SIG{TERM} = 'IGNORE';
 934   local $SIG{TSTP} = 'IGNORE';
 935   local $SIG{PIPE} = 'IGNORE';
 936
 937   # If the mask is blank then try to set it - if we can...
 938   if (!defined($self->getfield('paymask')) || $self->getfield('paymask') eq '') {
 939     $self->paymask($self->payinfo);
 940   }
 941
 942   # We absolutely have to have an old vs. new record to make this work.
 943   if (!defined($old)) {
 944     $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 945   }
 946
 947   if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
 948        && $conf->config('users-allow_comp')                  ) {
 949     return "You are not permitted to create complimentary accounts."
 950       unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
 951   }
 952
 953   local($ignore_expired_card) = 1
 954     if $old->payby  =~ /^(CARD|DCRD)$/
 955     && $self->payby =~ /^(CARD|DCRD)$/
 956     && $old->payinfo eq $self->payinfo;
 957
 958   my $oldAutoCommit = $FS::UID::AutoCommit;
 959   local $FS::UID::AutoCommit = 0;
 960   my $dbh = dbh;
 961
 962   my $error = $self->SUPER::replace($old);
 963
 964   if ( $error ) {
 965     $dbh->rollback if $oldAutoCommit;
 966     return $error;
 967   }
 968
 969   if ( @param ) { # INVOICING_LIST_ARYREF
 970     my $invoicing_list = shift @param;
 971     $error = $self->check_invoicing_list( $invoicing_list );
 972     if ( $error ) {
 973       $dbh->rollback if $oldAutoCommit;
 974       return $error;
 975     }
 976     $self->invoicing_list( $invoicing_list );
 977   }
 978
 979   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
 980        grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
 981     # card/check/lec info has changed, want to retry realtime_ invoice events
 982     my $error = $self->retry_realtime;
 983     if ( $error ) {
 984       $dbh->rollback if $oldAutoCommit;
 985       return $error;
 986     }
 987   }
 988
 989   unless ( $import || $skip_fuzzyfiles ) {
 990     $error = $self->queue_fuzzyfiles_update;
 991     if ( $error ) {
 992       $dbh->rollback if $oldAutoCommit;
 993       return "updating fuzzy search cache: $error";
 994     }
 995   }
 996
 997   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 998   '';
 999
1000 }
1001
1002 =item queue_fuzzyfiles_update
1003
1004 Used by insert & replace to update the fuzzy search cache
1005
1006 =cut
1007
1008 sub queue_fuzzyfiles_update {
1009   my $self = shift;
1010
1011   local $SIG{HUP} = 'IGNORE';
1012   local $SIG{INT} = 'IGNORE';
1013   local $SIG{QUIT} = 'IGNORE';
1014   local $SIG{TERM} = 'IGNORE';
1015   local $SIG{TSTP} = 'IGNORE';
1016   local $SIG{PIPE} = 'IGNORE';
1017
1018   my $oldAutoCommit = $FS::UID::AutoCommit;
1019   local $FS::UID::AutoCommit = 0;
1020   my $dbh = dbh;
1021
1022   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1023   my $error = $queue->insert($self->getfield('last'), $self->company);
1024   if ( $error ) {
1025     $dbh->rollback if $oldAutoCommit;
1026     return "queueing job (transaction rolled back): $error";
1027   }
1028
1029   if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
1030     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1031     $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
1032     if ( $error ) {
1033       $dbh->rollback if $oldAutoCommit;
1034       return "queueing job (transaction rolled back): $error";
1035     }
1036   }
1037
1038   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1039   '';
1040
1041 }
1042
1043 =item check
1044
1045 Checks all fields to make sure this is a valid customer record.  If there is
1046 an error, returns the error, otherwise returns false.  Called by the insert
1047 and replace methods.
1048
1049 =cut
1050
1051 sub check {
1052   my $self = shift;
1053
1054   warn "$me check BEFORE: \n". $self->_dump
1055     if $DEBUG > 2;
1056
1057   my $error =
1058     $self->ut_numbern('custnum')
1059     || $self->ut_number('agentnum')
1060     || $self->ut_number('refnum')
1061     || $self->ut_name('last')
1062     || $self->ut_name('first')
1063     || $self->ut_textn('company')
1064     || $self->ut_text('address1')
1065     || $self->ut_textn('address2')
1066     || $self->ut_text('city')
1067     || $self->ut_textn('county')
1068     || $self->ut_textn('state')
1069     || $self->ut_country('country')
1070     || $self->ut_anything('comments')
1071     || $self->ut_numbern('referral_custnum')
1072   ;
1073   #barf.  need message catalogs.  i18n.  etc.
1074   $error .= "Please select an advertising source."
1075     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1076   return $error if $error;
1077
1078   return "Unknown agent"
1079     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1080
1081   return "Unknown refnum"
1082     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1083
1084   return "Unknown referring custnum: ". $self->referral_custnum
1085     unless ! $self->referral_custnum
1086            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1087
1088   if ( $self->ss eq '' ) {
1089     $self->ss('');
1090   } else {
1091     my $ss = $self->ss;
1092     $ss =~ s/\D//g;
1093     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1094       or return "Illegal social security number: ". $self->ss;
1095     $self->ss("$1-$2-$3");
1096   }
1097
1098
1099 # bad idea to disable, causes billing to fail because of no tax rates later
1100 #  unless ( $import ) {
1101     unless ( qsearch('cust_main_county', {
1102       'country' => $self->country,
1103       'state'   => '',
1104      } ) ) {
1105       return "Unknown state/county/country: ".
1106         $self->state. "/". $self->county. "/". $self->country
1107         unless qsearch('cust_main_county',{
1108           'state'   => $self->state,
1109           'county'  => $self->county,
1110           'country' => $self->country,
1111         } );
1112     }
1113 #  }
1114
1115   $error =
1116     $self->ut_phonen('daytime', $self->country)
1117     || $self->ut_phonen('night', $self->country)
1118     || $self->ut_phonen('fax', $self->country)
1119     || $self->ut_zip('zip', $self->country)
1120   ;
1121   return $error if $error;
1122
1123   my @addfields = qw(
1124     last first company address1 address2 city county state zip
1125     country daytime night fax
1126   );
1127
1128   if ( defined $self->dbdef_table->column('ship_last') ) {
1129     if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1130                        @addfields )
1131          && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
1132        )
1133     {
1134       my $error =
1135         $self->ut_name('ship_last')
1136         || $self->ut_name('ship_first')
1137         || $self->ut_textn('ship_company')
1138         || $self->ut_text('ship_address1')
1139         || $self->ut_textn('ship_address2')
1140         || $self->ut_text('ship_city')
1141         || $self->ut_textn('ship_county')
1142         || $self->ut_textn('ship_state')
1143         || $self->ut_country('ship_country')
1144       ;
1145       return $error if $error;
1146
1147       #false laziness with above
1148       unless ( qsearchs('cust_main_county', {
1149         'country' => $self->ship_country,
1150         'state'   => '',
1151        } ) ) {
1152         return "Unknown ship_state/ship_county/ship_country: ".
1153           $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1154           unless qsearch('cust_main_county',{
1155             'state'   => $self->ship_state,
1156             'county'  => $self->ship_county,
1157             'country' => $self->ship_country,
1158           } );
1159       }
1160       #eofalse
1161
1162       $error =
1163         $self->ut_phonen('ship_daytime', $self->ship_country)
1164         || $self->ut_phonen('ship_night', $self->ship_country)
1165         || $self->ut_phonen('ship_fax', $self->ship_country)
1166         || $self->ut_zip('ship_zip', $self->ship_country)
1167       ;
1168       return $error if $error;
1169
1170     } else { # ship_ info eq billing info, so don't store dup info in database
1171       $self->setfield("ship_$_", '')
1172         foreach qw( last first company address1 address2 city county state zip
1173                     country daytime night fax );
1174     }
1175   }
1176
1177   $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1178     or return "Illegal payby: ". $self->payby;
1179
1180   $error =    $self->ut_numbern('paystart_month')
1181            || $self->ut_numbern('paystart_year')
1182            || $self->ut_numbern('payissue')
1183   ;
1184   return $error if $error;
1185
1186   if ( $self->payip eq '' ) {
1187     $self->payip('');
1188   } else {
1189     $error = $self->ut_ip('payip');
1190     return $error if $error;
1191   }
1192
1193   # If it is encrypted and the private key is not availaible then we can't
1194   # check the credit card.
1195
1196   my $check_payinfo = 1;
1197
1198   if ($self->is_encrypted($self->payinfo)) {
1199     $check_payinfo = 0;
1200   }
1201
1202   $self->payby($1);
1203
1204   if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1205
1206     my $payinfo = $self->payinfo;
1207     $payinfo =~ s/\D//g;
1208     $payinfo =~ /^(\d{13,16})$/
1209       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1210     $payinfo = $1;
1211     $self->payinfo($payinfo);
1212     validate($payinfo)
1213       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1214
1215     return gettext('unknown_card_type')
1216       if cardtype($self->payinfo) eq "Unknown";
1217
1218     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1219     if ( $ban ) {
1220       return 'Banned credit card: banned on '.
1221              time2str('%a %h %o at %r', $ban->_date).
1222              ' by '. $ban->otaker.
1223              ' (ban# '. $ban->bannum. ')';
1224     }
1225
1226     if ( defined $self->dbdef_table->column('paycvv') ) {
1227       if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1228         if ( cardtype($self->payinfo) eq 'American Express card' ) {
1229           $self->paycvv =~ /^(\d{4})$/
1230             or return "CVV2 (CID) for American Express cards is four digits.";
1231           $self->paycvv($1);
1232         } else {
1233           $self->paycvv =~ /^(\d{3})$/
1234             or return "CVV2 (CVC2/CID) is three digits.";
1235           $self->paycvv($1);
1236         }
1237       } else {
1238         $self->paycvv('');
1239       }
1240     }
1241
1242     my $cardtype = cardtype($payinfo);
1243     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1244
1245       return "Start date or issue number is required for $cardtype cards"
1246         unless $self->paystart_month && $self->paystart_year or $self->payissue;
1247
1248       return "Start month must be between 1 and 12"
1249         if $self->paystart_month
1250            and $self->paystart_month < 1 || $self->paystart_month > 12;
1251
1252       return "Start year must be 1990 or later"
1253         if $self->paystart_year
1254            and $self->paystart_year < 1990;
1255
1256       return "Issue number must be beween 1 and 99"
1257         if $self->payissue
1258           and $self->payissue < 1 || $self->payissue > 99;
1259
1260     } else {
1261       $self->paystart_month('');
1262       $self->paystart_year('');
1263       $self->payissue('');
1264     }
1265
1266   } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1267
1268     my $payinfo = $self->payinfo;
1269     $payinfo =~ s/[^\d\@]//g;
1270     if ( $conf->exists('echeck-nonus') ) {
1271       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1272       $payinfo = "$1\@$2";
1273     } else {
1274       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1275       $payinfo = "$1\@$2";
1276     }
1277     $self->payinfo($payinfo);
1278     $self->paycvv('') if $self->dbdef_table->column('paycvv');
1279
1280     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1281     if ( $ban ) {
1282       return 'Banned ACH account: banned on '.
1283              time2str('%a %h %o at %r', $ban->_date).
1284              ' by '. $ban->otaker.
1285              ' (ban# '. $ban->bannum. ')';
1286     }
1287
1288   } elsif ( $self->payby eq 'LECB' ) {
1289
1290     my $payinfo = $self->payinfo;
1291     $payinfo =~ s/\D//g;
1292     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1293     $payinfo = $1;
1294     $self->payinfo($payinfo);
1295     $self->paycvv('') if $self->dbdef_table->column('paycvv');
1296
1297   } elsif ( $self->payby eq 'BILL' ) {
1298
1299     $error = $self->ut_textn('payinfo');
1300     return "Illegal P.O. number: ". $self->payinfo if $error;
1301     $self->paycvv('') if $self->dbdef_table->column('paycvv');
1302
1303   } elsif ( $self->payby eq 'COMP' ) {
1304
1305     if ( !$self->custnum && $conf->config('users-allow_comp') ) {
1306       return "You are not permitted to create complimentary accounts."
1307         unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
1308     }
1309
1310     $error = $self->ut_textn('payinfo');
1311     return "Illegal comp account issuer: ". $self->payinfo if $error;
1312     $self->paycvv('') if $self->dbdef_table->column('paycvv');
1313
1314   } elsif ( $self->payby eq 'PREPAY' ) {
1315
1316     my $payinfo = $self->payinfo;
1317     $payinfo =~ s/\W//g; #anything else would just confuse things
1318     $self->payinfo($payinfo);
1319     $error = $self->ut_alpha('payinfo');
1320     return "Illegal prepayment identifier: ". $self->payinfo if $error;
1321     return "Unknown prepayment identifier"
1322       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1323     $self->paycvv('') if $self->dbdef_table->column('paycvv');
1324
1325   }
1326
1327   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1328     return "Expiration date required"
1329       unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1330     $self->paydate('');
1331   } else {
1332     my( $m, $y );
1333     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1334       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1335     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1336       ( $m, $y ) = ( $3, "20$2" );
1337     } else {
1338       return "Illegal expiration date: ". $self->paydate;
1339     }
1340     $self->paydate("$y-$m-01");
1341     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1342     return gettext('expired_card')
1343       if !$import
1344       && !$ignore_expired_card
1345       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1346   }
1347
1348   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1349        ( ! $conf->exists('require_cardname')
1350          || $self->payby !~ /^(CARD|DCRD)$/  )
1351   ) {
1352     $self->payname( $self->first. " ". $self->getfield('last') );
1353   } else {
1354     $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1355       or return gettext('illegal_name'). " payname: ". $self->payname;
1356     $self->payname($1);
1357   }
1358
1359   foreach my $flag (qw( tax spool_cdr )) {
1360     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1361     $self->$flag($1);
1362   }
1363
1364   $self->otaker(getotaker) unless $self->otaker;
1365
1366   warn "$me check AFTER: \n". $self->_dump
1367     if $DEBUG > 2;
1368
1369   $self->SUPER::check;
1370 }
1371
1372 =item all_pkgs
1373
1374 Returns all packages (see L<FS::cust_pkg>) for this customer.
1375
1376 =cut
1377
1378 sub all_pkgs {
1379   my $self = shift;
1380   if ( $self->{'_pkgnum'} ) {
1381     values %{ $self->{'_pkgnum'}->cache };
1382   } else {
1383     qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1384   }
1385 }
1386
1387 =item ncancelled_pkgs
1388
1389 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1390
1391 =cut
1392
1393 sub ncancelled_pkgs {
1394   my $self = shift;
1395   if ( $self->{'_pkgnum'} ) {
1396     grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
1397   } else {
1398     @{ [ # force list context
1399       qsearch( 'cust_pkg', {
1400         'custnum' => $self->custnum,
1401         'cancel'  => '',
1402       }),
1403       qsearch( 'cust_pkg', {
1404         'custnum' => $self->custnum,
1405         'cancel'  => 0,
1406       }),
1407     ] };
1408   }
1409 }
1410
1411 =item suspended_pkgs
1412
1413 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1414
1415 =cut
1416
1417 sub suspended_pkgs {
1418   my $self = shift;
1419   grep { $_->susp } $self->ncancelled_pkgs;
1420 }
1421
1422 =item unflagged_suspended_pkgs
1423
1424 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1425 customer (thouse packages without the `manual_flag' set).
1426
1427 =cut
1428
1429 sub unflagged_suspended_pkgs {
1430   my $self = shift;
1431   return $self->suspended_pkgs
1432     unless dbdef->table('cust_pkg')->column('manual_flag');
1433   grep { ! $_->manual_flag } $self->suspended_pkgs;
1434 }
1435
1436 =item unsuspended_pkgs
1437
1438 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1439 this customer.
1440
1441 =cut
1442
1443 sub unsuspended_pkgs {
1444   my $self = shift;
1445   grep { ! $_->susp } $self->ncancelled_pkgs;
1446 }
1447
1448 =item num_cancelled_pkgs
1449
1450 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1451 customer.
1452
1453 =cut
1454
1455 sub num_cancelled_pkgs {
1456   my $self = shift;
1457   $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0");
1458 }
1459
1460 sub num_pkgs {
1461   my( $self, $sql ) = @_;
1462   my $sth = dbh->prepare(
1463     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql"
1464   ) or die dbh->errstr;
1465   $sth->execute($self->custnum) or die $sth->errstr;
1466   $sth->fetchrow_arrayref->[0];
1467 }
1468
1469 =item unsuspend
1470
1471 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1472 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
1473 on success or a list of errors.
1474
1475 =cut
1476
1477 sub unsuspend {
1478   my $self = shift;
1479   grep { $_->unsuspend } $self->suspended_pkgs;
1480 }
1481
1482 =item suspend
1483
1484 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1485
1486 Returns a list: an empty list on success or a list of errors.
1487
1488 =cut
1489
1490 sub suspend {
1491   my $self = shift;
1492   grep { $_->suspend } $self->unsuspended_pkgs;
1493 }
1494
1495 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1496
1497 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1498 PKGPARTs (see L<FS::part_pkg>).
1499
1500 Returns a list: an empty list on success or a list of errors.
1501
1502 =cut
1503
1504 sub suspend_if_pkgpart {
1505   my $self = shift;
1506   my @pkgparts = @_;
1507   grep { $_->suspend }
1508     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1509       $self->unsuspended_pkgs;
1510 }
1511
1512 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1513
1514 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1515 listed PKGPARTs (see L<FS::part_pkg>).
1516
1517 Returns a list: an empty list on success or a list of errors.
1518
1519 =cut
1520
1521 sub suspend_unless_pkgpart {
1522   my $self = shift;
1523   my @pkgparts = @_;
1524   grep { $_->suspend }
1525     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1526       $self->unsuspended_pkgs;
1527 }
1528
1529 =item cancel [ OPTION => VALUE ... ]
1530
1531 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1532
1533 Available options are: I<quiet>, I<reasonnum>, and I<ban>
1534
1535 I<quiet> can be set true to supress email cancellation notices.
1536
1537 # I<reasonnum> can be set to a cancellation reason (see L<FS::cancel_reason>)
1538
1539 I<ban> can be set true to ban this customer's credit card or ACH information,
1540 if present.
1541
1542 Always returns a list: an empty list on success or a list of errors.
1543
1544 =cut
1545
1546 sub cancel {
1547   my $self = shift;
1548   my %opt = @_;
1549
1550   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1551
1552     #should try decryption (we might have the private key)
1553     # and if not maybe queue a job for the server that does?
1554     return ( "Can't (yet) ban encrypted credit cards" )
1555       if $self->is_encrypted($self->payinfo);
1556
1557     my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1558     my $error = $ban->insert;
1559     return ( $error ) if $error;
1560
1561   }
1562
1563   grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1564 }
1565
1566 sub _banned_pay_hashref {
1567   my $self = shift;
1568
1569   my %payby2ban = (
1570     'CARD' => 'CARD',
1571     'DCRD' => 'CARD',
1572     'CHEK' => 'CHEK',
1573     'DCHK' => 'CHEK'
1574   );
1575
1576   {
1577     'payby'   => $payby2ban{$self->payby},
1578     'payinfo' => md5_base64($self->payinfo),
1579     #'reason'  =>
1580   };
1581 }
1582
1583 =item agent
1584
1585 Returns the agent (see L<FS::agent>) for this customer.
1586
1587 =cut
1588
1589 sub agent {
1590   my $self = shift;
1591   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1592 }
1593
1594 =item bill OPTIONS
1595
1596 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
1597 conjunction with the collect method.
1598
1599 Options are passed as name-value pairs.
1600
1601 Currently available options are:
1602
1603 resetup - if set true, re-charges setup fees.
1604
1605 time - bills the customer as if it were that time.  Specified as a UNIX
1606 timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and
1607 L<Date::Parse> for conversion functions.  For example:
1608
1609  use Date::Parse;
1610  ...
1611  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1612
1613
1614 If there is an error, returns the error, otherwise returns false.
1615
1616 =cut
1617
1618 sub bill {
1619   my( $self, %options ) = @_;
1620   return '' if $self->payby eq 'COMP';
1621   warn "$me bill customer ". $self->custnum. "\n"
1622     if $DEBUG;
1623
1624   my $time = $options{'time'} || time;
1625
1626   my $error;
1627
1628   #put below somehow?
1629   local $SIG{HUP} = 'IGNORE';
1630   local $SIG{INT} = 'IGNORE';
1631   local $SIG{QUIT} = 'IGNORE';
1632   local $SIG{TERM} = 'IGNORE';
1633   local $SIG{TSTP} = 'IGNORE';
1634   local $SIG{PIPE} = 'IGNORE';
1635
1636   my $oldAutoCommit = $FS::UID::AutoCommit;
1637   local $FS::UID::AutoCommit = 0;
1638   my $dbh = dbh;
1639
1640   $self->select_for_update; #mutex
1641
1642   #create a new invoice
1643   #(we'll remove it later if it doesn't actually need to be generated [contains
1644   # no line items] and we're inside a transaciton so nothing else will see it)
1645   my $cust_bill = new FS::cust_bill ( {
1646     'custnum' => $self->custnum,
1647     '_date'   => $time,
1648     #'charged' => $charged,
1649     'charged' => 0,
1650   } );
1651   $error = $cust_bill->insert;
1652   if ( $error ) {
1653     $dbh->rollback if $oldAutoCommit;
1654     return "can't create invoice for customer #". $self->custnum. ": $error";
1655   }
1656   my $invnum = $cust_bill->invnum;
1657
1658   ###
1659   # find the packages which are due for billing, find out how much they are
1660   # & generate invoice database.
1661   ###
1662
1663   my( $total_setup, $total_recur ) = ( 0, 0 );
1664   my %tax;
1665   my @precommit_hooks = ();
1666
1667   foreach my $cust_pkg (
1668     qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1669   ) {
1670
1671     #NO!! next if $cust_pkg->cancel;
1672     next if $cust_pkg->getfield('cancel');
1673
1674     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
1675
1676     #? to avoid use of uninitialized value errors... ?
1677     $cust_pkg->setfield('bill', '')
1678       unless defined($cust_pkg->bill);
1679
1680     my $part_pkg = $cust_pkg->part_pkg;
1681
1682     my %hash = $cust_pkg->hash;
1683     my $old_cust_pkg = new FS::cust_pkg \%hash;
1684
1685     my @details = ();
1686
1687     ###
1688     # bill setup
1689     ###
1690
1691     my $setup = 0;
1692     if ( !$cust_pkg->setup || $options{'resetup'} ) {
1693
1694       warn "    bill setup\n" if $DEBUG > 1;
1695
1696       $setup = eval { $cust_pkg->calc_setup( $time ) };
1697       if ( $@ ) {
1698         $dbh->rollback if $oldAutoCommit;
1699         return "$@ running calc_setup for $cust_pkg\n";
1700       }
1701
1702       $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1703     }
1704
1705     ###
1706     # bill recurring fee
1707     ###
1708
1709     my $recur = 0;
1710     my $sdate;
1711     if ( $part_pkg->getfield('freq') ne '0' &&
1712          ! $cust_pkg->getfield('susp') &&
1713          ( $cust_pkg->getfield('bill') || 0 ) <= $time
1714     ) {
1715
1716       warn "    bill recur\n" if $DEBUG > 1;
1717
1718       # XXX shared with $recur_prog
1719       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1720
1721       #over two params!  lets at least switch to a hashref for the rest...
1722       my %param = ( 'precommit_hooks' => \@precommit_hooks, );
1723
1724       $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
1725       if ( $@ ) {
1726         $dbh->rollback if $oldAutoCommit;
1727         return "$@ running calc_recur for $cust_pkg\n";
1728       }
1729
1730       #change this bit to use Date::Manip? CAREFUL with timezones (see
1731       # mailing list archive)
1732       my ($sec,$min,$hour,$mday,$mon,$year) =
1733         (localtime($sdate) )[0,1,2,3,4,5];
1734
1735       #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1736       # only for figuring next bill date, nothing else, so, reset $sdate again
1737       # here
1738       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1739       $cust_pkg->last_bill($sdate)
1740         if $cust_pkg->dbdef_table->column('last_bill');
1741
1742       if ( $part_pkg->freq =~ /^\d+$/ ) {
1743         $mon += $part_pkg->freq;
1744         until ( $mon < 12 ) { $mon -= 12; $year++; }
1745       } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1746         my $weeks = $1;
1747         $mday += $weeks * 7;
1748       } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1749         my $days = $1;
1750         $mday += $days;
1751       } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
1752         my $hours = $1;
1753         $hour += $hours;
1754       } else {
1755         $dbh->rollback if $oldAutoCommit;
1756         return "unparsable frequency: ". $part_pkg->freq;
1757       }
1758       $cust_pkg->setfield('bill',
1759         timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1760     }
1761
1762     warn "\$setup is undefined" unless defined($setup);
1763     warn "\$recur is undefined" unless defined($recur);
1764     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1765
1766     ###
1767     # If $cust_pkg has been modified, update it and create cust_bill_pkg records
1768     ###
1769
1770     if ( $cust_pkg->modified ) {
1771
1772       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
1773         if $DEBUG >1;
1774
1775       $error=$cust_pkg->replace($old_cust_pkg);
1776       if ( $error ) { #just in case
1777         $dbh->rollback if $oldAutoCommit;
1778         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1779       }
1780
1781       $setup = sprintf( "%.2f", $setup );
1782       $recur = sprintf( "%.2f", $recur );
1783       if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1784         $dbh->rollback if $oldAutoCommit;
1785         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1786       }
1787       if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1788         $dbh->rollback if $oldAutoCommit;
1789         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1790       }
1791
1792       if ( $setup != 0 || $recur != 0 ) {
1793
1794         warn "    charges (setup=$setup, recur=$recur); adding line items\n"
1795           if $DEBUG > 1;
1796         my $cust_bill_pkg = new FS::cust_bill_pkg ({
1797           'invnum'  => $invnum,
1798           'pkgnum'  => $cust_pkg->pkgnum,
1799           'setup'   => $setup,
1800           'recur'   => $recur,
1801           'sdate'   => $sdate,
1802           'edate'   => $cust_pkg->bill,
1803           'details' => \@details,
1804         });
1805         $error = $cust_bill_pkg->insert;
1806         if ( $error ) {
1807           $dbh->rollback if $oldAutoCommit;
1808           return "can't create invoice line item for invoice #$invnum: $error";
1809         }
1810         $total_setup += $setup;
1811         $total_recur += $recur;
1812
1813         ###
1814         # handle taxes
1815         ###
1816
1817         unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1818
1819           my $prefix =
1820             ( $conf->exists('tax-ship_address') && length($self->ship_last) )
1821             ? 'ship_'
1822             : '';
1823           my %taxhash = map { $_ => $self->get("$prefix$_") }
1824                             qw( state county country );
1825
1826           $taxhash{'taxclass'} = $part_pkg->taxclass;
1827
1828           my @taxes = qsearch( 'cust_main_county', \%taxhash );
1829
1830           unless ( @taxes ) {
1831             $taxhash{'taxclass'} = '';
1832             @taxes =  qsearch( 'cust_main_county', \%taxhash );
1833           }
1834
1835           #one more try at a whole-country tax rate
1836           unless ( @taxes ) {
1837             $taxhash{$_} = '' foreach qw( state county );
1838             @taxes =  qsearch( 'cust_main_county', \%taxhash );
1839           }
1840
1841           # maybe eliminate this entirely, along with all the 0% records
1842           unless ( @taxes ) {
1843             $dbh->rollback if $oldAutoCommit;
1844             return
1845               "fatal: can't find tax rate for state/county/country/taxclass ".
1846               join('/', ( map $self->get("$prefix$_"),
1847                               qw(state county country)
1848                         ),
1849                         $part_pkg->taxclass ). "\n";
1850           }
1851
1852           foreach my $tax ( @taxes ) {
1853
1854             my $taxable_charged = 0;
1855             $taxable_charged += $setup
1856               unless $part_pkg->setuptax =~ /^Y$/i
1857                   || $tax->setuptax =~ /^Y$/i;
1858             $taxable_charged += $recur
1859               unless $part_pkg->recurtax =~ /^Y$/i
1860                   || $tax->recurtax =~ /^Y$/i;
1861             next unless $taxable_charged;
1862
1863             if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
1864               #my ($mon,$year) = (localtime($sdate) )[4,5];
1865               my ($mon,$year) = (localtime( $sdate || $cust_bill->_date ) )[4,5];
1866               $mon++;
1867               my $freq = $part_pkg->freq || 1;
1868               if ( $freq !~ /(\d+)$/ ) {
1869                 $dbh->rollback if $oldAutoCommit;
1870                 return "daily/weekly package definitions not (yet?)".
1871                        " compatible with monthly tax exemptions";
1872               }
1873               my $taxable_per_month =
1874                 sprintf("%.2f", $taxable_charged / $freq );
1875
1876               #call the whole thing off if this customer has any old
1877               #exemption records...
1878               my @cust_tax_exempt =
1879                 qsearch( 'cust_tax_exempt' => { custnum=> $self->custnum } );
1880               if ( @cust_tax_exempt ) {
1881                 $dbh->rollback if $oldAutoCommit;
1882                 return
1883                   'this customer still has old-style tax exemption records; '.
1884                   'run bin/fs-migrate-cust_tax_exempt?';
1885               }
1886
1887               foreach my $which_month ( 1 .. $freq ) {
1888
1889                 #maintain the new exemption table now
1890                 my $sql = "
1891                   SELECT SUM(amount)
1892                     FROM cust_tax_exempt_pkg
1893                       LEFT JOIN cust_bill_pkg USING ( billpkgnum )
1894                       LEFT JOIN cust_bill     USING ( invnum     )
1895                     WHERE custnum = ?
1896                       AND taxnum  = ?
1897                       AND year    = ?
1898                       AND month   = ?
1899                 ";
1900                 my $sth = dbh->prepare($sql) or do {
1901                   $dbh->rollback if $oldAutoCommit;
1902                   return "fatal: can't lookup exising exemption: ". dbh->errstr;
1903                 };
1904                 $sth->execute(
1905                   $self->custnum,
1906                   $tax->taxnum,
1907                   1900+$year,
1908                   $mon,
1909                 ) or do {
1910                   $dbh->rollback if $oldAutoCommit;
1911                   return "fatal: can't lookup exising exemption: ". dbh->errstr;
1912                 };
1913                 my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0;
1914
1915                 my $remaining_exemption =
1916                   $tax->exempt_amount - $existing_exemption;
1917                 if ( $remaining_exemption > 0 ) {
1918                   my $addl = $remaining_exemption > $taxable_per_month
1919                     ? $taxable_per_month
1920                     : $remaining_exemption;
1921                   $taxable_charged -= $addl;
1922
1923                   my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( {
1924                     'billpkgnum' => $cust_bill_pkg->billpkgnum,
1925                     'taxnum'     => $tax->taxnum,
1926                     'year'       => 1900+$year,
1927                     'month'      => $mon,
1928                     'amount'     => sprintf("%.2f", $addl ),
1929                   } );
1930                   $error = $cust_tax_exempt_pkg->insert;
1931                   if ( $error ) {
1932                     $dbh->rollback if $oldAutoCommit;
1933                     return "fatal: can't insert cust_tax_exempt_pkg: $error";
1934                   }
1935                 } # if $remaining_exemption > 0
1936
1937                 #++
1938                 $mon++;
1939                 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1940                 until ( $mon < 13 ) { $mon -= 12; $year++; }
1941
1942               } #foreach $which_month
1943
1944             } #if $tax->exempt_amount
1945
1946             $taxable_charged = sprintf( "%.2f", $taxable_charged);
1947
1948             #$tax += $taxable_charged * $cust_main_county->tax / 100
1949             $tax{ $tax->taxname || 'Tax' } +=
1950               $taxable_charged * $tax->tax / 100
1951
1952           } #foreach my $tax ( @taxes )
1953
1954         } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1955
1956       } #if $setup != 0 || $recur != 0
1957
1958     } #if $cust_pkg->modified
1959
1960   } #foreach my $cust_pkg
1961
1962   unless ( $cust_bill->cust_bill_pkg ) {
1963     $cust_bill->delete; #don't create an invoice w/o line items
1964     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1965     return '';
1966   }
1967
1968   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1969
1970   foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1971     my $tax = sprintf("%.2f", $tax{$taxname} );
1972     $charged = sprintf( "%.2f", $charged+$tax );
1973
1974     my $cust_bill_pkg = new FS::cust_bill_pkg ({
1975       'invnum'   => $invnum,
1976       'pkgnum'   => 0,
1977       'setup'    => $tax,
1978       'recur'    => 0,
1979       'sdate'    => '',
1980       'edate'    => '',
1981       'itemdesc' => $taxname,
1982     });
1983     $error = $cust_bill_pkg->insert;
1984     if ( $error ) {
1985       $dbh->rollback if $oldAutoCommit;
1986       return "can't create invoice line item for invoice #$invnum: $error";
1987     }
1988     $total_setup += $tax;
1989
1990   }
1991
1992   $cust_bill->charged( sprintf( "%.2f", $total_setup + $total_recur ) );
1993   $error = $cust_bill->replace;
1994   if ( $error ) {
1995     $dbh->rollback if $oldAutoCommit;
1996     return "can't update charged for invoice #$invnum: $error";
1997   }
1998
1999   foreach my $hook ( @precommit_hooks ) {
2000     eval {
2001       &{$hook}; #($self) ?
2002     };
2003     if ( $@ ) {
2004       $dbh->rollback if $oldAutoCommit;
2005       return "$@ running precommit hook $hook\n";
2006     }
2007   }
2008
2009   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2010   ''; #no error
2011 }
2012
2013 =item collect OPTIONS
2014
2015 (Attempt to) collect money for this customer's outstanding invoices (see
2016 L<FS::cust_bill>).  Usually used after the bill method.
2017
2018 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
2019 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
2020 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
2021
2022 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
2023 and the invoice events web interface.
2024
2025 If there is an error, returns the error, otherwise returns false.
2026
2027 Options are passed as name-value pairs.
2028
2029 Currently available options are:
2030
2031 invoice_time - Use this time when deciding when to print invoices and
2032 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>
2033 for conversion functions.
2034
2035 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
2036 events.
2037
2038 quiet - set true to surpress email card/ACH decline notices.
2039
2040 freq - "1d" for the traditional, daily events (the default), or "1m" for the
2041 new monthly events
2042
2043 =cut
2044
2045 sub collect {
2046   my( $self, %options ) = @_;
2047   my $invoice_time = $options{'invoice_time'} || time;
2048
2049   #put below somehow?
2050   local $SIG{HUP} = 'IGNORE';
2051   local $SIG{INT} = 'IGNORE';
2052   local $SIG{QUIT} = 'IGNORE';
2053   local $SIG{TERM} = 'IGNORE';
2054   local $SIG{TSTP} = 'IGNORE';
2055   local $SIG{PIPE} = 'IGNORE';
2056
2057   my $oldAutoCommit = $FS::UID::AutoCommit;
2058   local $FS::UID::AutoCommit = 0;
2059   my $dbh = dbh;
2060
2061   $self->select_for_update; #mutex
2062
2063   my $balance = $self->balance;
2064   warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2065     if $DEBUG;
2066   unless ( $balance > 0 ) { #redundant?????
2067     $dbh->rollback if $oldAutoCommit; #hmm
2068     return '';
2069   }
2070
2071   if ( exists($options{'retry_card'}) ) {
2072     carp 'retry_card option passed to collect is deprecated; use retry';
2073     $options{'retry'} ||= $options{'retry_card'};
2074   }
2075   if ( exists($options{'retry'}) && $options{'retry'} ) {
2076     my $error = $self->retry_realtime;
2077     if ( $error ) {
2078       $dbh->rollback if $oldAutoCommit;
2079       return $error;
2080     }
2081   }
2082
2083   my $extra_sql = '';
2084   if ( defined $options{'freq'} && $options{'freq'} eq '1m' ) {
2085     $extra_sql = " AND freq = '1m' ";
2086   } else {
2087     $extra_sql = " AND ( freq = '1d' OR freq IS NULL OR freq = '' ) ";
2088   }
2089
2090   foreach my $cust_bill ( $self->open_cust_bill ) {
2091
2092     # don't try to charge for the same invoice if it's already in a batch
2093     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
2094
2095     last if $self->balance <= 0;
2096
2097     warn "  invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n"
2098       if $DEBUG > 1;
2099
2100     foreach my $part_bill_event (
2101       sort {    $a->seconds   <=> $b->seconds
2102              || $a->weight    <=> $b->weight
2103              || $a->eventpart <=> $b->eventpart }
2104         grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
2105                && ! qsearch( 'cust_bill_event', {
2106                                 'invnum'    => $cust_bill->invnum,
2107                                 'eventpart' => $_->eventpart,
2108                                 'status'    => 'done',
2109                                                                    } )
2110              }
2111           qsearch( {
2112             'table'     => 'part_bill_event',
2113             'hashref'   => { 'payby'    => $self->payby,
2114                              'disabled' => '',           },
2115             'extra_sql' => $extra_sql,
2116           } )
2117     ) {
2118
2119       last if $cust_bill->owed <= 0  # don't run subsequent events if owed<=0
2120            || $self->balance   <= 0; # or if balance<=0
2121
2122       warn "  calling invoice event (". $part_bill_event->eventcode. ")\n"
2123         if $DEBUG > 1;
2124       my $cust_main = $self; #for callback
2125
2126       my $error;
2127       {
2128         local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2129         local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
2130         $error = eval $part_bill_event->eventcode;
2131       }
2132
2133       my $status = '';
2134       my $statustext = '';
2135       if ( $@ ) {
2136         $status = 'failed';
2137         $statustext = $@;
2138       } elsif ( $error ) {
2139         $status = 'done';
2140         $statustext = $error;
2141       } else {
2142         $status = 'done'
2143       }
2144
2145       #add cust_bill_event
2146       my $cust_bill_event = new FS::cust_bill_event {
2147         'invnum'     => $cust_bill->invnum,
2148         'eventpart'  => $part_bill_event->eventpart,
2149         #'_date'      => $invoice_time,
2150         '_date'      => time,
2151         'status'     => $status,
2152         'statustext' => $statustext,
2153       };
2154       $error = $cust_bill_event->insert;
2155       if ( $error ) {
2156         #$dbh->rollback if $oldAutoCommit;
2157         #return "error: $error";
2158
2159         # gah, even with transactions.
2160         $dbh->commit if $oldAutoCommit; #well.
2161         my $e = 'WARNING: Event run but database not updated - '.
2162                 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
2163                 ', eventpart '. $part_bill_event->eventpart.
2164                 ": $error";
2165         warn $e;
2166         return $e;
2167       }
2168
2169
2170     }
2171
2172   }
2173
2174   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2175   '';
2176
2177 }
2178
2179 =item retry_realtime
2180
2181 Schedules realtime credit card / electronic check / LEC billing events for
2182 for retry.  Useful if card information has changed or manual retry is desired.
2183 The 'collect' method must be called to actually retry the transaction.
2184
2185 Implementation details: For each of this customer's open invoices, changes
2186 the status of the first "done" (with statustext error) realtime processing
2187 event to "failed".
2188
2189 =cut
2190
2191 sub retry_realtime {
2192   my $self = shift;
2193
2194   local $SIG{HUP} = 'IGNORE';
2195   local $SIG{INT} = 'IGNORE';
2196   local $SIG{QUIT} = 'IGNORE';
2197   local $SIG{TERM} = 'IGNORE';
2198   local $SIG{TSTP} = 'IGNORE';
2199   local $SIG{PIPE} = 'IGNORE';
2200
2201   my $oldAutoCommit = $FS::UID::AutoCommit;
2202   local $FS::UID::AutoCommit = 0;
2203   my $dbh = dbh;
2204
2205   foreach my $cust_bill (
2206     grep { $_->cust_bill_event }
2207       $self->open_cust_bill
2208   ) {
2209     my @cust_bill_event =
2210       sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
2211         grep {
2212                #$_->part_bill_event->plan eq 'realtime-card'
2213                $_->part_bill_event->eventcode =~
2214                    /\$cust_bill\->realtime_(card|ach|lec)/
2215                  && $_->status eq 'done'
2216                  && $_->statustext
2217              }
2218           $cust_bill->cust_bill_event;
2219     next unless @cust_bill_event;
2220     my $error = $cust_bill_event[0]->retry;
2221     if ( $error ) {
2222       $dbh->rollback if $oldAutoCommit;
2223       return "error scheduling invoice event for retry: $error";
2224     }
2225
2226   }
2227
2228   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2229   '';
2230
2231 }
2232
2233 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
2234
2235 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
2236 via a Business::OnlinePayment realtime gateway.  See
2237 L<http://420.am/business-onlinepayment> for supported gateways.
2238
2239 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2240
2241 Available options are: I<description>, I<invnum>, I<quiet>
2242
2243 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2244 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2245 if set, will override the value from the customer record.
2246
2247 I<description> is a free-text field passed to the gateway.  It defaults to
2248 "Internet services".
2249
2250 If an I<invnum> is specified, this payment (if successful) is applied to the
2251 specified invoice.  If you don't specify an I<invnum> you might want to
2252 call the B<apply_payments> method.
2253
2254 I<quiet> can be set true to surpress email decline notices.
2255
2256 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
2257
2258 =cut
2259
2260 sub realtime_bop {
2261   my( $self, $method, $amount, %options ) = @_;
2262   if ( $DEBUG ) {
2263     warn "$me realtime_bop: $method $amount\n";
2264     warn "  $_ => $options{$_}\n" foreach keys %options;
2265   }
2266
2267   $options{'description'} ||= 'Internet services';
2268
2269   eval "use Business::OnlinePayment";
2270   die $@ if $@;
2271
2272   my $payinfo = exists($options{'payinfo'})
2273                   ? $options{'payinfo'}
2274                   : $self->payinfo;
2275
2276   ###
2277   # select a gateway
2278   ###
2279
2280   my $taxclass = '';
2281   if ( $options{'invnum'} ) {
2282     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
2283     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
2284     my @taxclasses =
2285       map  { $_->part_pkg->taxclass }
2286       grep { $_ }
2287       map  { $_->cust_pkg }
2288       $cust_bill->cust_bill_pkg;
2289     unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
2290                                                            #different taxclasses
2291       $taxclass = $taxclasses[0];
2292     }
2293   }
2294
2295   #look for an agent gateway override first
2296   my $cardtype;
2297   if ( $method eq 'CC' ) {
2298     $cardtype = cardtype($payinfo);
2299   } elsif ( $method eq 'ECHECK' ) {
2300     $cardtype = 'ACH';
2301   } else {
2302     $cardtype = $method;
2303   }
2304
2305   my $override =
2306        qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2307                                            cardtype => $cardtype,
2308                                            taxclass => $taxclass,       } )
2309     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2310                                            cardtype => '',
2311                                            taxclass => $taxclass,       } )
2312     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2313                                            cardtype => $cardtype,
2314                                            taxclass => '',              } )
2315     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2316                                            cardtype => '',
2317                                            taxclass => '',              } );
2318
2319   my $payment_gateway = '';
2320   my( $processor, $login, $password, $action, @bop_options );
2321   if ( $override ) { #use a payment gateway override
2322
2323     $payment_gateway = $override->payment_gateway;
2324
2325     $processor   = $payment_gateway->gateway_module;
2326     $login       = $payment_gateway->gateway_username;
2327     $password    = $payment_gateway->gateway_password;
2328     $action      = $payment_gateway->gateway_action;
2329     @bop_options = $payment_gateway->options;
2330
2331   } else { #use the standard settings from the config
2332
2333     ( $processor, $login, $password, $action, @bop_options ) =
2334       $self->default_payment_gateway($method);
2335
2336   }
2337
2338   ###
2339   # massage data
2340   ###
2341
2342   my $address = exists($options{'address1'})
2343                     ? $options{'address1'}
2344                     : $self->address1;
2345   my $address2 = exists($options{'address2'})
2346                     ? $options{'address2'}
2347                     : $self->address2;
2348   $address .= ", ". $address2 if length($address2);
2349
2350   my $o_payname = exists($options{'payname'})
2351                     ? $options{'payname'}
2352                     : $self->payname;
2353   my($payname, $payfirst, $paylast);
2354   if ( $o_payname && $method ne 'ECHECK' ) {
2355     ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2356       or return "Illegal payname $payname";
2357     ($payfirst, $paylast) = ($1, $2);
2358   } else {
2359     $payfirst = $self->getfield('first');
2360     $paylast = $self->getfield('last');
2361     $payname =  "$payfirst $paylast";
2362   }
2363
2364   my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
2365   if ( $conf->exists('emailinvoiceauto')
2366        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
2367     push @invoicing_list, $self->all_emails;
2368   }
2369
2370   my $email = ($conf->exists('business-onlinepayment-email-override'))
2371               ? $conf->config('business-onlinepayment-email-override')
2372               : $invoicing_list[0];
2373
2374   my %content = ();
2375
2376   my $payip = exists($options{'payip'})
2377                 ? $options{'payip'}
2378                 : $self->payip;
2379   $content{customer_ip} = $payip
2380     if length($payip);
2381
2382   if ( $method eq 'CC' ) {
2383
2384     $content{card_number} = $payinfo;
2385     my $paydate = exists($options{'paydate'})
2386                     ? $options{'paydate'}
2387                     : $self->paydate;
2388     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2389     $content{expiration} = "$2/$1";
2390
2391     my $paycvv = exists($options{'paycvv'})
2392                    ? $options{'paycvv'}
2393                    : $self->paycvv;
2394     $content{cvv2} = $self->paycvv
2395       if length($paycvv);
2396
2397     my $paystart_month = exists($options{'paystart_month'})
2398                            ? $options{'paystart_month'}
2399                            : $self->paystart_month;
2400
2401     my $paystart_year  = exists($options{'paystart_year'})
2402                            ? $options{'paystart_year'}
2403                            : $self->paystart_year;
2404
2405     $content{card_start} = "$paystart_month/$paystart_year"
2406       if $paystart_month && $paystart_year;
2407
2408     my $payissue       = exists($options{'payissue'})
2409                            ? $options{'payissue'}
2410                            : $self->payissue;
2411     $content{issue_number} = $payissue if $payissue;
2412
2413     $content{recurring_billing} = 'YES'
2414       if qsearch('cust_pay', { 'custnum' => $self->custnum,
2415                                'payby'   => 'CARD',
2416                                'payinfo' => $payinfo,
2417                              } );
2418
2419   } elsif ( $method eq 'ECHECK' ) {
2420     ( $content{account_number}, $content{routing_code} ) =
2421       split('@', $payinfo);
2422     $content{bank_name} = $o_payname;
2423     $content{account_type} = 'CHECKING';
2424     $content{account_name} = $payname;
2425     $content{customer_org} = $self->company ? 'B' : 'I';
2426     $content{customer_ssn} = exists($options{'ss'})
2427                                ? $options{'ss'}
2428                                : $self->ss;
2429   } elsif ( $method eq 'LEC' ) {
2430     $content{phone} = $payinfo;
2431   }
2432
2433   ###
2434   # run transaction(s)
2435   ###
2436
2437   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
2438
2439   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
2440   $transaction->content(
2441     'type'           => $method,
2442     'login'          => $login,
2443     'password'       => $password,
2444     'action'         => $action1,
2445     'description'    => $options{'description'},
2446     'amount'         => $amount,
2447     'invoice_number' => $options{'invnum'},
2448     'customer_id'    => $self->custnum,
2449     'last_name'      => $paylast,
2450     'first_name'     => $payfirst,
2451     'name'           => $payname,
2452     'address'        => $address,
2453     'city'           => ( exists($options{'city'})
2454                             ? $options{'city'}
2455                             : $self->city          ),
2456     'state'          => ( exists($options{'state'})
2457                             ? $options{'state'}
2458                             : $self->state          ),
2459     'zip'            => ( exists($options{'zip'})
2460                             ? $options{'zip'}
2461                             : $self->zip          ),
2462     'country'        => ( exists($options{'country'})
2463                             ? $options{'country'}
2464                             : $self->country          ),
2465     'referer'        => 'http://cleanwhisker.420.am/',
2466     'email'          => $email,
2467     'phone'          => $self->daytime || $self->night,
2468     %content, #after
2469   );
2470   $transaction->submit();
2471
2472   if ( $transaction->is_success() && $action2 ) {
2473     my $auth = $transaction->authorization;
2474     my $ordernum = $transaction->can('order_number')
2475                    ? $transaction->order_number
2476                    : '';
2477
2478     my $capture =
2479       new Business::OnlinePayment( $processor, @bop_options );
2480
2481     my %capture = (
2482       %content,
2483       type           => $method,
2484       action         => $action2,
2485       login          => $login,
2486       password       => $password,
2487       order_number   => $ordernum,
2488       amount         => $amount,
2489       authorization  => $auth,
2490       description    => $options{'description'},
2491     );
2492
2493     foreach my $field (qw( authorization_source_code returned_ACI                                          transaction_identifier validation_code
2494                            transaction_sequence_num local_transaction_date
2495                            local_transaction_time AVS_result_code          )) {
2496       $capture{$field} = $transaction->$field() if $transaction->can($field);
2497     }
2498
2499     $capture->content( %capture );
2500
2501     $capture->submit();
2502
2503     unless ( $capture->is_success ) {
2504       my $e = "Authorization successful but capture failed, custnum #".
2505               $self->custnum. ': '.  $capture->result_code.
2506               ": ". $capture->error_message;
2507       warn $e;
2508       return $e;
2509     }
2510
2511   }
2512
2513   ###
2514   # remove paycvv after initial transaction
2515   ###
2516
2517   #false laziness w/misc/process/payment.cgi - check both to make sure working
2518   # correctly
2519   if ( defined $self->dbdef_table->column('paycvv')
2520        && length($self->paycvv)
2521        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2522   ) {
2523     my $error = $self->remove_cvv;
2524     if ( $error ) {
2525       warn "WARNING: error removing cvv: $error\n";
2526     }
2527   }
2528
2529   ###
2530   # result handling
2531   ###
2532
2533   if ( $transaction->is_success() ) {
2534
2535     my %method2payby = (
2536       'CC'     => 'CARD',
2537       'ECHECK' => 'CHEK',
2538       'LEC'    => 'LECB',
2539     );
2540
2541     my $paybatch = '';
2542     if ( $payment_gateway ) { # agent override
2543       $paybatch = $payment_gateway->gatewaynum. '-';
2544     }
2545
2546     $paybatch .= "$processor:". $transaction->authorization;
2547
2548     $paybatch .= ':'. $transaction->order_number
2549       if $transaction->can('order_number')
2550       && length($transaction->order_number);
2551
2552     my $cust_pay = new FS::cust_pay ( {
2553        'custnum'  => $self->custnum,
2554        'invnum'   => $options{'invnum'},
2555        'paid'     => $amount,
2556        '_date'     => '',
2557        'payby'    => $method2payby{$method},
2558        'payinfo'  => $payinfo,
2559        'paybatch' => $paybatch,
2560     } );
2561     my $error = $cust_pay->insert;
2562     if ( $error ) {
2563       $cust_pay->invnum(''); #try again with no specific invnum
2564       my $error2 = $cust_pay->insert;
2565       if ( $error2 ) {
2566         # gah, even with transactions.
2567         my $e = 'WARNING: Card/ACH debited but database not updated - '.
2568                 "error inserting payment ($processor): $error2".
2569                 " (previously tried insert with invnum #$options{'invnum'}" .
2570                 ": $error )";
2571         warn $e;
2572         return $e;
2573       }
2574     }
2575     return ''; #no error
2576
2577   } else {
2578
2579     my $perror = "$processor error: ". $transaction->error_message;
2580
2581     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2582          && $conf->exists('emaildecline')
2583          && grep { $_ ne 'POST' } $self->invoicing_list
2584          && ! grep { $transaction->error_message =~ /$_/ }
2585                    $conf->config('emaildecline-exclude')
2586     ) {
2587       my @templ = $conf->config('declinetemplate');
2588       my $template = new Text::Template (
2589         TYPE   => 'ARRAY',
2590         SOURCE => [ map "$_\n", @templ ],
2591       ) or return "($perror) can't create template: $Text::Template::ERROR";
2592       $template->compile()
2593         or return "($perror) can't compile template: $Text::Template::ERROR";
2594
2595       my $templ_hash = { error => $transaction->error_message };
2596
2597       my $error = send_email(
2598         'from'    => $conf->config('invoice_from'),
2599         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2600         'subject' => 'Your payment could not be processed',
2601         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
2602       );
2603
2604       $perror .= " (also received error sending decline notification: $error)"
2605         if $error;
2606
2607     }
2608
2609     return $perror;
2610   }
2611
2612 }
2613
2614 =item default_payment_gateway
2615
2616 =cut
2617
2618 sub default_payment_gateway {
2619   my( $self, $method ) = @_;
2620
2621   die "Real-time processing not enabled\n"
2622     unless $conf->exists('business-onlinepayment');
2623
2624   #load up config
2625   my $bop_config = 'business-onlinepayment';
2626   $bop_config .= '-ach'
2627     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2628   my ( $processor, $login, $password, $action, @bop_options ) =
2629     $conf->config($bop_config);
2630   $action ||= 'normal authorization';
2631   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2632   die "No real-time processor is enabled - ".
2633       "did you set the business-onlinepayment configuration value?\n"
2634     unless $processor;
2635
2636   ( $processor, $login, $password, $action, @bop_options )
2637 }
2638
2639 =item remove_cvv
2640
2641 Removes the I<paycvv> field from the database directly.
2642
2643 If there is an error, returns the error, otherwise returns false.
2644
2645 =cut
2646
2647 sub remove_cvv {
2648   my $self = shift;
2649   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2650     or return dbh->errstr;
2651   $sth->execute($self->custnum)
2652     or return $sth->errstr;
2653   $self->paycvv('');
2654   '';
2655 }
2656
2657 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2658
2659 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2660 via a Business::OnlinePayment realtime gateway.  See
2661 L<http://420.am/business-onlinepayment> for supported gateways.
2662
2663 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2664
2665 Available options are: I<amount>, I<reason>, I<paynum>
2666
2667 Most gateways require a reference to an original payment transaction to refund,
2668 so you probably need to specify a I<paynum>.
2669
2670 I<amount> defaults to the original amount of the payment if not specified.
2671
2672 I<reason> specifies a reason for the refund.
2673
2674 Implementation note: If I<amount> is unspecified or equal to the amount of the
2675 orignal payment, first an attempt is made to "void" the transaction via
2676 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2677 the normal attempt is made to "refund" ("credit") the transaction via the
2678 gateway is attempted.
2679
2680 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2681 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2682 #if set, will override the value from the customer record.
2683
2684 #If an I<invnum> is specified, this payment (if successful) is applied to the
2685 #specified invoice.  If you don't specify an I<invnum> you might want to
2686 #call the B<apply_payments> method.
2687
2688 =cut
2689
2690 #some false laziness w/realtime_bop, not enough to make it worth merging
2691 #but some useful small subs should be pulled out
2692 sub realtime_refund_bop {
2693   my( $self, $method, %options ) = @_;
2694   if ( $DEBUG ) {
2695     warn "$me realtime_refund_bop: $method refund\n";
2696     warn "  $_ => $options{$_}\n" foreach keys %options;
2697   }
2698
2699   eval "use Business::OnlinePayment";
2700   die $@ if $@;
2701
2702   ###
2703   # look up the original payment and optionally a gateway for that payment
2704   ###
2705
2706   my $cust_pay = '';
2707   my $amount = $options{'amount'};
2708
2709   my( $processor, $login, $password, @bop_options ) ;
2710   my( $auth, $order_number ) = ( '', '', '' );
2711
2712   if ( $options{'paynum'} ) {
2713
2714     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
2715     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2716       or return "Unknown paynum $options{'paynum'}";
2717     $amount ||= $cust_pay->paid;
2718
2719     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/
2720       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2721                 $cust_pay->paybatch;
2722     my $gatewaynum = '';
2723     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
2724
2725     if ( $gatewaynum ) { #gateway for the payment to be refunded
2726
2727       my $payment_gateway =
2728         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
2729       die "payment gateway $gatewaynum not found"
2730         unless $payment_gateway;
2731
2732       $processor   = $payment_gateway->gateway_module;
2733       $login       = $payment_gateway->gateway_username;
2734       $password    = $payment_gateway->gateway_password;
2735       @bop_options = $payment_gateway->options;
2736
2737     } else { #try the default gateway
2738
2739       my( $conf_processor, $unused_action );
2740       ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
2741         $self->default_payment_gateway($method);
2742
2743       return "processor of payment $options{'paynum'} $processor does not".
2744              " match default processor $conf_processor"
2745         unless $processor eq $conf_processor;
2746
2747     }
2748
2749
2750   } else { # didn't specify a paynum, so look for agent gateway overrides
2751            # like a normal transaction
2752
2753     my $cardtype;
2754     if ( $method eq 'CC' ) {
2755       $cardtype = cardtype($self->payinfo);
2756     } elsif ( $method eq 'ECHECK' ) {
2757       $cardtype = 'ACH';
2758     } else {
2759       $cardtype = $method;
2760     }
2761     my $override =
2762            qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2763                                                cardtype => $cardtype,
2764                                                taxclass => '',              } )
2765         || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2766                                                cardtype => '',
2767                                                taxclass => '',              } );
2768
2769     if ( $override ) { #use a payment gateway override
2770
2771       my $payment_gateway = $override->payment_gateway;
2772
2773       $processor   = $payment_gateway->gateway_module;
2774       $login       = $payment_gateway->gateway_username;
2775       $password    = $payment_gateway->gateway_password;
2776       #$action      = $payment_gateway->gateway_action;
2777       @bop_options = $payment_gateway->options;
2778
2779     } else { #use the standard settings from the config
2780
2781       my $unused_action;
2782       ( $processor, $login, $password, $unused_action, @bop_options ) =
2783         $self->default_payment_gateway($method);
2784
2785     }
2786
2787   }
2788   return "neither amount nor paynum specified" unless $amount;
2789
2790   my %content = (
2791     'type'           => $method,
2792     'login'          => $login,
2793     'password'       => $password,
2794     'order_number'   => $order_number,
2795     'amount'         => $amount,
2796     'referer'        => 'http://cleanwhisker.420.am/',
2797   );
2798   $content{authorization} = $auth
2799     if length($auth); #echeck/ACH transactions have an order # but no auth
2800                       #(at least with authorize.net)
2801
2802   #first try void if applicable
2803   if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2804     warn "  attempting void\n" if $DEBUG > 1;
2805     my $void = new Business::OnlinePayment( $processor, @bop_options );
2806     $void->content( 'action' => 'void', %content );
2807     $void->submit();
2808     if ( $void->is_success ) {
2809       my $error = $cust_pay->void($options{'reason'});
2810       if ( $error ) {
2811         # gah, even with transactions.
2812         my $e = 'WARNING: Card/ACH voided but database not updated - '.
2813                 "error voiding payment: $error";
2814         warn $e;
2815         return $e;
2816       }
2817       warn "  void successful\n" if $DEBUG > 1;
2818       return '';
2819     }
2820   }
2821
2822   warn "  void unsuccessful, trying refund\n"
2823     if $DEBUG > 1;
2824
2825   #massage data
2826   my $address = $self->address1;
2827   $address .= ", ". $self->address2 if $self->address2;
2828
2829   my($payname, $payfirst, $paylast);
2830   if ( $self->payname && $method ne 'ECHECK' ) {
2831     $payname = $self->payname;
2832     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2833       or return "Illegal payname $payname";
2834     ($payfirst, $paylast) = ($1, $2);
2835   } else {
2836     $payfirst = $self->getfield('first');
2837     $paylast = $self->getfield('last');
2838     $payname =  "$payfirst $paylast";
2839   }
2840
2841   my $payinfo = '';
2842   if ( $method eq 'CC' ) {
2843
2844     if ( $cust_pay ) {
2845       $content{card_number} = $payinfo = $cust_pay->payinfo;
2846       #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2847       #$content{expiration} = "$2/$1";
2848     } else {
2849       $content{card_number} = $payinfo = $self->payinfo;
2850       $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2851       $content{expiration} = "$2/$1";
2852     }
2853
2854   } elsif ( $method eq 'ECHECK' ) {
2855     ( $content{account_number}, $content{routing_code} ) =
2856       split('@', $payinfo = $self->payinfo);
2857     $content{bank_name} = $self->payname;
2858     $content{account_type} = 'CHECKING';
2859     $content{account_name} = $payname;
2860     $content{customer_org} = $self->company ? 'B' : 'I';
2861     $content{customer_ssn} = $self->ss;
2862   } elsif ( $method eq 'LEC' ) {
2863     $content{phone} = $payinfo = $self->payinfo;
2864   }
2865
2866   #then try refund
2867   my $refund = new Business::OnlinePayment( $processor, @bop_options );
2868   my %sub_content = $refund->content(
2869     'action'         => 'credit',
2870     'customer_id'    => $self->custnum,
2871     'last_name'      => $paylast,
2872     'first_name'     => $payfirst,
2873     'name'           => $payname,
2874     'address'        => $address,
2875     'city'           => $self->city,
2876     'state'          => $self->state,
2877     'zip'            => $self->zip,
2878     'country'        => $self->country,
2879     %content, #after
2880   );
2881   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
2882     if $DEBUG > 1;
2883   $refund->submit();
2884
2885   return "$processor error: ". $refund->error_message
2886     unless $refund->is_success();
2887
2888   my %method2payby = (
2889     'CC'     => 'CARD',
2890     'ECHECK' => 'CHEK',
2891     'LEC'    => 'LECB',
2892   );
2893
2894   my $paybatch = "$processor:". $refund->authorization;
2895   $paybatch .= ':'. $refund->order_number
2896     if $refund->can('order_number') && $refund->order_number;
2897
2898   while ( $cust_pay && $cust_pay->unappled < $amount ) {
2899     my @cust_bill_pay = $cust_pay->cust_bill_pay;
2900     last unless @cust_bill_pay;
2901     my $cust_bill_pay = pop @cust_bill_pay;
2902     my $error = $cust_bill_pay->delete;
2903     last if $error;
2904   }
2905
2906   my $cust_refund = new FS::cust_refund ( {
2907     'custnum'  => $self->custnum,
2908     'paynum'   => $options{'paynum'},
2909     'refund'   => $amount,
2910     '_date'    => '',
2911     'payby'    => $method2payby{$method},
2912     'payinfo'  => $payinfo,
2913     'paybatch' => $paybatch,
2914     'reason'   => $options{'reason'} || 'card or ACH refund',
2915   } );
2916   my $error = $cust_refund->insert;
2917   if ( $error ) {
2918     $cust_refund->paynum(''); #try again with no specific paynum
2919     my $error2 = $cust_refund->insert;
2920     if ( $error2 ) {
2921       # gah, even with transactions.
2922       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2923               "error inserting refund ($processor): $error2".
2924               " (previously tried insert with paynum #$options{'paynum'}" .
2925               ": $error )";
2926       warn $e;
2927       return $e;
2928     }
2929   }
2930
2931   ''; #no error
2932
2933 }
2934
2935 =item total_owed
2936
2937 Returns the total owed for this customer on all invoices
2938 (see L<FS::cust_bill/owed>).
2939
2940 =cut
2941
2942 sub total_owed {
2943   my $self = shift;
2944   $self->total_owed_date(2145859200); #12/31/2037
2945 }
2946
2947 =item total_owed_date TIME
2948
2949 Returns the total owed for this customer on all invoices with date earlier than
2950 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2951 see L<Time::Local> and L<Date::Parse> for conversion functions.
2952
2953 =cut
2954
2955 sub total_owed_date {
2956   my $self = shift;
2957   my $time = shift;
2958   my $total_bill = 0;
2959   foreach my $cust_bill (
2960     grep { $_->_date <= $time }
2961       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2962   ) {
2963     $total_bill += $cust_bill->owed;
2964   }
2965   sprintf( "%.2f", $total_bill );
2966 }
2967
2968 =item apply_credits OPTION => VALUE ...
2969
2970 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2971 to outstanding invoice balances in chronological order (or reverse
2972 chronological order if the I<order> option is set to B<newest>) and returns the
2973 value of any remaining unapplied credits available for refund (see
2974 L<FS::cust_refund>).
2975
2976 =cut
2977
2978 sub apply_credits {
2979   my $self = shift;
2980   my %opt = @_;
2981
2982   return 0 unless $self->total_credited;
2983
2984   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2985       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2986
2987   my @invoices = $self->open_cust_bill;
2988   @invoices = sort { $b->_date <=> $a->_date } @invoices
2989     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2990
2991   my $credit;
2992   foreach my $cust_bill ( @invoices ) {
2993     my $amount;
2994
2995     if ( !defined($credit) || $credit->credited == 0) {
2996       $credit = pop @credits or last;
2997     }
2998
2999     if ($cust_bill->owed >= $credit->credited) {
3000       $amount=$credit->credited;
3001     }else{
3002       $amount=$cust_bill->owed;
3003     }
3004
3005     my $cust_credit_bill = new FS::cust_credit_bill ( {
3006       'crednum' => $credit->crednum,
3007       'invnum'  => $cust_bill->invnum,
3008       'amount'  => $amount,
3009     } );
3010     my $error = $cust_credit_bill->insert;
3011     die $error if $error;
3012
3013     redo if ($cust_bill->owed > 0);
3014
3015   }
3016
3017   return $self->total_credited;
3018 }
3019
3020 =item apply_payments
3021
3022 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
3023 to outstanding invoice balances in chronological order.
3024
3025  #and returns the value of any remaining unapplied payments.
3026
3027 =cut
3028
3029 sub apply_payments {
3030   my $self = shift;
3031
3032   #return 0 unless
3033
3034   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
3035       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
3036
3037   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
3038       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
3039
3040   my $payment;
3041
3042   foreach my $cust_bill ( @invoices ) {
3043     my $amount;
3044
3045     if ( !defined($payment) || $payment->unapplied == 0 ) {
3046       $payment = pop @payments or last;
3047     }
3048
3049     if ( $cust_bill->owed >= $payment->unapplied ) {
3050       $amount = $payment->unapplied;
3051     } else {
3052       $amount = $cust_bill->owed;
3053     }
3054
3055     my $cust_bill_pay = new FS::cust_bill_pay ( {
3056       'paynum' => $payment->paynum,
3057       'invnum' => $cust_bill->invnum,
3058       'amount' => $amount,
3059     } );
3060     my $error = $cust_bill_pay->insert;
3061     die $error if $error;
3062
3063     redo if ( $cust_bill->owed > 0);
3064
3065   }
3066
3067   return $self->total_unapplied_payments;
3068 }
3069
3070 =item total_credited
3071
3072 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3073 customer.  See L<FS::cust_credit/credited>.
3074
3075 =cut
3076
3077 sub total_credited {
3078   my $self = shift;
3079   my $total_credit = 0;
3080   foreach my $cust_credit ( qsearch('cust_credit', {
3081     'custnum' => $self->custnum,
3082   } ) ) {
3083     $total_credit += $cust_credit->credited;
3084   }
3085   sprintf( "%.2f", $total_credit );
3086 }
3087
3088 =item total_unapplied_payments
3089
3090 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3091 See L<FS::cust_pay/unapplied>.
3092
3093 =cut
3094
3095 sub total_unapplied_payments {
3096   my $self = shift;
3097   my $total_unapplied = 0;
3098   foreach my $cust_pay ( qsearch('cust_pay', {
3099     'custnum' => $self->custnum,
3100   } ) ) {
3101     $total_unapplied += $cust_pay->unapplied;
3102   }
3103   sprintf( "%.2f", $total_unapplied );
3104 }
3105
3106 =item balance
3107
3108 Returns the balance for this customer (total_owed minus total_credited
3109 minus total_unapplied_payments).
3110
3111 =cut
3112
3113 sub balance {
3114   my $self = shift;
3115   sprintf( "%.2f",
3116     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
3117   );
3118 }
3119
3120 =item balance_date TIME
3121
3122 Returns the balance for this customer, only considering invoices with date
3123 earlier than TIME (total_owed_date minus total_credited minus
3124 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
3125 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
3126 functions.
3127
3128 =cut
3129
3130 sub balance_date {
3131   my $self = shift;
3132   my $time = shift;
3133   sprintf( "%.2f",
3134     $self->total_owed_date($time)
3135       - $self->total_credited
3136       - $self->total_unapplied_payments
3137   );
3138 }
3139
3140 =item paydate_monthyear
3141
3142 Returns a two-element list consisting of the month and year of this customer's
3143 paydate (credit card expiration date for CARD customers)
3144
3145 =cut
3146
3147 sub paydate_monthyear {
3148   my $self = shift;
3149   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3150     ( $2, $1 );
3151   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3152     ( $1, $3 );
3153   } else {
3154     ('', '');
3155   }
3156 }
3157
3158 =item payinfo_masked
3159
3160 Returns a "masked" payinfo field appropriate to the payment type.  Masked characters are replaced by 'x'es.  Use this to display publicly accessable account Information.
3161
3162 Credit Cards - Mask all but the last four characters.
3163 Checks - Mask all but last 2 of account number and bank routing number.
3164 Others - Do nothing, return the unmasked string.
3165
3166 =cut
3167
3168 sub payinfo_masked {
3169   my $self = shift;
3170   return $self->paymask;
3171 }
3172
3173 =item invoicing_list [ ARRAYREF ]
3174
3175 If an arguement is given, sets these email addresses as invoice recipients
3176 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
3177 (except as warnings), so use check_invoicing_list first.
3178
3179 Returns a list of email addresses (with svcnum entries expanded).
3180
3181 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
3182 check it without disturbing anything by passing nothing.
3183
3184 This interface may change in the future.
3185
3186 =cut
3187
3188 sub invoicing_list {
3189   my( $self, $arrayref ) = @_;
3190
3191   if ( $arrayref ) {
3192     my @cust_main_invoice;
3193     if ( $self->custnum ) {
3194       @cust_main_invoice =
3195         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3196     } else {
3197       @cust_main_invoice = ();
3198     }
3199     foreach my $cust_main_invoice ( @cust_main_invoice ) {
3200       #warn $cust_main_invoice->destnum;
3201       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3202         #warn $cust_main_invoice->destnum;
3203         my $error = $cust_main_invoice->delete;
3204         warn $error if $error;
3205       }
3206     }
3207     if ( $self->custnum ) {
3208       @cust_main_invoice =
3209         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3210     } else {
3211       @cust_main_invoice = ();
3212     }
3213     my %seen = map { $_->address => 1 } @cust_main_invoice;
3214     foreach my $address ( @{$arrayref} ) {
3215       next if exists $seen{$address} && $seen{$address};
3216       $seen{$address} = 1;
3217       my $cust_main_invoice = new FS::cust_main_invoice ( {
3218         'custnum' => $self->custnum,
3219         'dest'    => $address,
3220       } );
3221       my $error = $cust_main_invoice->insert;
3222       warn $error if $error;
3223     }
3224   }
3225
3226   if ( $self->custnum ) {
3227     map { $_->address }
3228       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3229   } else {
3230     ();
3231   }
3232
3233 }
3234
3235 =item check_invoicing_list ARRAYREF
3236
3237 Checks these arguements as valid input for the invoicing_list method.  If there
3238 is an error, returns the error, otherwise returns false.
3239
3240 =cut
3241
3242 sub check_invoicing_list {
3243   my( $self, $arrayref ) = @_;
3244   foreach my $address ( @{$arrayref} ) {
3245
3246     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3247       return 'Can\'t add FAX invoice destination with a blank FAX number.';
3248     }
3249
3250     my $cust_main_invoice = new FS::cust_main_invoice ( {
3251       'custnum' => $self->custnum,
3252       'dest'    => $address,
3253     } );
3254     my $error = $self->custnum
3255                 ? $cust_main_invoice->check
3256                 : $cust_main_invoice->checkdest
3257     ;
3258     return $error if $error;
3259   }
3260   '';
3261 }
3262
3263 =item set_default_invoicing_list
3264
3265 Sets the invoicing list to all accounts associated with this customer,
3266 overwriting any previous invoicing list.
3267
3268 =cut
3269
3270 sub set_default_invoicing_list {
3271   my $self = shift;
3272   $self->invoicing_list($self->all_emails);
3273 }
3274
3275 =item all_emails
3276
3277 Returns the email addresses of all accounts provisioned for this customer.
3278
3279 =cut
3280
3281 sub all_emails {
3282   my $self = shift;
3283   my %list;
3284   foreach my $cust_pkg ( $self->all_pkgs ) {
3285     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3286     my @svc_acct =
3287       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3288         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3289           @cust_svc;
3290     $list{$_}=1 foreach map { $_->email } @svc_acct;
3291   }
3292   keys %list;
3293 }
3294
3295 =item invoicing_list_addpost
3296
3297 Adds postal invoicing to this customer.  If this customer is already configured
3298 to receive postal invoices, does nothing.
3299
3300 =cut
3301
3302 sub invoicing_list_addpost {
3303   my $self = shift;
3304   return if grep { $_ eq 'POST' } $self->invoicing_list;
3305   my @invoicing_list = $self->invoicing_list;
3306   push @invoicing_list, 'POST';
3307   $self->invoicing_list(\@invoicing_list);
3308 }
3309
3310 =item invoicing_list_emailonly
3311
3312 Returns the list of email invoice recipients (invoicing_list without non-email
3313 destinations such as POST and FAX).
3314
3315 =cut
3316
3317 sub invoicing_list_emailonly {
3318   my $self = shift;
3319   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3320 }
3321
3322 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3323
3324 Returns an array of customers referred by this customer (referral_custnum set
3325 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3326 customers referred by customers referred by this customer and so on, inclusive.
3327 The default behavior is DEPTH 1 (no recursion).
3328
3329 =cut
3330
3331 sub referral_cust_main {
3332   my $self = shift;
3333   my $depth = @_ ? shift : 1;
3334   my $exclude = @_ ? shift : {};
3335
3336   my @cust_main =
3337     map { $exclude->{$_->custnum}++; $_; }
3338       grep { ! $exclude->{ $_->custnum } }
3339         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3340
3341   if ( $depth > 1 ) {
3342     push @cust_main,
3343       map { $_->referral_cust_main($depth-1, $exclude) }
3344         @cust_main;
3345   }
3346
3347   @cust_main;
3348 }
3349
3350 =item referral_cust_main_ncancelled
3351
3352 Same as referral_cust_main, except only returns customers with uncancelled
3353 packages.
3354
3355 =cut
3356
3357 sub referral_cust_main_ncancelled {
3358   my $self = shift;
3359   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3360 }
3361
3362 =item referral_cust_pkg [ DEPTH ]
3363
3364 Like referral_cust_main, except returns a flat list of all unsuspended (and
3365 uncancelled) packages for each customer.  The number of items in this list may
3366 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3367
3368 =cut
3369
3370 sub referral_cust_pkg {
3371   my $self = shift;
3372   my $depth = @_ ? shift : 1;
3373
3374   map { $_->unsuspended_pkgs }
3375     grep { $_->unsuspended_pkgs }
3376       $self->referral_cust_main($depth);
3377 }
3378
3379 =item referring_cust_main
3380
3381 Returns the single cust_main record for the customer who referred this customer
3382 (referral_custnum), or false.
3383
3384 =cut
3385
3386 sub referring_cust_main {
3387   my $self = shift;
3388   return '' unless $self->referral_custnum;
3389   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3390 }
3391
3392 =item credit AMOUNT, REASON
3393
3394 Applies a credit to this customer.  If there is an error, returns the error,
3395 otherwise returns false.
3396
3397 =cut
3398
3399 sub credit {
3400   my( $self, $amount, $reason ) = @_;
3401   my $cust_credit = new FS::cust_credit {
3402     'custnum' => $self->custnum,
3403     'amount'  => $amount,
3404     'reason'  => $reason,
3405   };
3406   $cust_credit->insert;
3407 }
3408
3409 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3410
3411 Creates a one-time charge for this customer.  If there is an error, returns
3412 the error, otherwise returns false.
3413
3414 =cut
3415
3416 sub charge {
3417   my ( $self, $amount ) = ( shift, shift );
3418   my $pkg      = @_ ? shift : 'One-time charge';
3419   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
3420   my $taxclass = @_ ? shift : '';
3421
3422   local $SIG{HUP} = 'IGNORE';
3423   local $SIG{INT} = 'IGNORE';
3424   local $SIG{QUIT} = 'IGNORE';
3425   local $SIG{TERM} = 'IGNORE';
3426   local $SIG{TSTP} = 'IGNORE';
3427   local $SIG{PIPE} = 'IGNORE';
3428
3429   my $oldAutoCommit = $FS::UID::AutoCommit;
3430   local $FS::UID::AutoCommit = 0;
3431   my $dbh = dbh;
3432
3433   my $part_pkg = new FS::part_pkg ( {
3434     'pkg'      => $pkg,
3435     'comment'  => $comment,
3436     #'setup'    => $amount,
3437     #'recur'    => '0',
3438     'plan'     => 'flat',
3439     'plandata' => "setup_fee=$amount",
3440     'freq'     => 0,
3441     'disabled' => 'Y',
3442     'taxclass' => $taxclass,
3443   } );
3444
3445   my $error = $part_pkg->insert;
3446   if ( $error ) {
3447     $dbh->rollback if $oldAutoCommit;
3448     return $error;
3449   }
3450
3451   my $pkgpart = $part_pkg->pkgpart;
3452   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3453   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3454     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3455     $error = $type_pkgs->insert;
3456     if ( $error ) {
3457       $dbh->rollback if $oldAutoCommit;
3458       return $error;
3459     }
3460   }
3461
3462   my $cust_pkg = new FS::cust_pkg ( {
3463     'custnum' => $self->custnum,
3464     'pkgpart' => $pkgpart,
3465   } );
3466
3467   $error = $cust_pkg->insert;
3468   if ( $error ) {
3469     $dbh->rollback if $oldAutoCommit;
3470     return $error;
3471   }
3472
3473   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3474   '';
3475
3476 }
3477
3478 =item cust_bill
3479
3480 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3481
3482 =cut
3483
3484 sub cust_bill {
3485   my $self = shift;
3486   sort { $a->_date <=> $b->_date }
3487     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3488 }
3489
3490 =item open_cust_bill
3491
3492 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3493 customer.
3494
3495 =cut
3496
3497 sub open_cust_bill {
3498   my $self = shift;
3499   grep { $_->owed > 0 } $self->cust_bill;
3500 }
3501
3502 =item cust_credit
3503
3504 Returns all the credits (see L<FS::cust_credit>) for this customer.
3505
3506 =cut
3507
3508 sub cust_credit {
3509   my $self = shift;
3510   sort { $a->_date <=> $b->_date }
3511     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3512 }
3513
3514 =item cust_pay
3515
3516 Returns all the payments (see L<FS::cust_pay>) for this customer.
3517
3518 =cut
3519
3520 sub cust_pay {
3521   my $self = shift;
3522   sort { $a->_date <=> $b->_date }
3523     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3524 }
3525
3526 =item cust_pay_void
3527
3528 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3529
3530 =cut
3531
3532 sub cust_pay_void {
3533   my $self = shift;
3534   sort { $a->_date <=> $b->_date }
3535     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3536 }
3537
3538
3539 =item cust_refund
3540
3541 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3542
3543 =cut
3544
3545 sub cust_refund {
3546   my $self = shift;
3547   sort { $a->_date <=> $b->_date }
3548     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3549 }
3550
3551 =item select_for_update
3552
3553 Selects this record with the SQL "FOR UPDATE" command.  This can be useful as
3554 a mutex.
3555
3556 =cut
3557
3558 sub select_for_update {
3559   my $self = shift;
3560   qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
3561 }
3562
3563 =item name
3564
3565 Returns a name string for this customer, either "Company (Last, First)" or
3566 "Last, First".
3567
3568 =cut
3569
3570 sub name {
3571   my $self = shift;
3572   my $name = $self->contact;
3573   $name = $self->company. " ($name)" if $self->company;
3574   $name;
3575 }
3576
3577 =item ship_name
3578
3579 Returns a name string for this (service/shipping) contact, either
3580 "Company (Last, First)" or "Last, First".
3581
3582 =cut
3583
3584 sub ship_name {
3585   my $self = shift;
3586   if ( $self->get('ship_last') ) {
3587     my $name = $self->ship_contact;
3588     $name = $self->ship_company. " ($name)" if $self->ship_company;
3589     $name;
3590   } else {
3591     $self->name;
3592   }
3593 }
3594
3595 =item contact
3596
3597 Returns this customer's full (billing) contact name only, "Last, First"
3598
3599 =cut
3600
3601 sub contact {
3602   my $self = shift;
3603   $self->get('last'). ', '. $self->first;
3604 }
3605
3606 =item ship_contact
3607
3608 Returns this customer's full (shipping) contact name only, "Last, First"
3609
3610 =cut
3611
3612 sub ship_contact {
3613   my $self = shift;
3614   $self->get('ship_last')
3615     ? $self->get('ship_last'). ', '. $self->ship_first
3616     : $self->contact;
3617 }
3618
3619 =item country_full
3620
3621 Returns this customer's full country name
3622
3623 =cut
3624
3625 sub country_full {
3626   my $self = shift;
3627   code2country($self->country);
3628 }
3629
3630 =item status
3631
3632 Returns a status string for this customer, currently:
3633
3634 =over 4
3635
3636 =item prospect - No packages have ever been ordered
3637
3638 =item active - One or more recurring packages is active
3639
3640 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
3641
3642 =item suspended - All non-cancelled recurring packages are suspended
3643
3644 =item cancelled - All recurring packages are cancelled
3645
3646 =back
3647
3648 =cut
3649
3650 sub status {
3651   my $self = shift;
3652   for my $status (qw( prospect active inactive suspended cancelled )) {
3653     my $method = $status.'_sql';
3654     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3655     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3656     $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
3657     return $status if $sth->fetchrow_arrayref->[0];
3658   }
3659 }
3660
3661 =item statuscolor
3662
3663 Returns a hex triplet color string for this customer's status.
3664
3665 =cut
3666
3667
3668 sub statuscolor {
3669   my $self = shift;
3670
3671   my %statuscolor = (
3672     'prospect'  => '7e0079', #'000000', #black?  naw, purple
3673     'active'    => '00CC00', #green
3674     'inactive'  => '0000CC', #blue
3675     'suspended' => 'FF9900', #yellow
3676     'cancelled' => 'FF0000', #red
3677   );
3678
3679   $statuscolor{$self->status};
3680 }
3681
3682 =back
3683
3684 =head1 CLASS METHODS
3685
3686 =over 4
3687
3688 =item prospect_sql
3689
3690 Returns an SQL expression identifying prospective cust_main records (customers
3691 with no packages ever ordered)
3692
3693 =cut
3694
3695 use vars qw($select_count_pkgs);
3696 $select_count_pkgs =
3697   "SELECT COUNT(*) FROM cust_pkg
3698     WHERE cust_pkg.custnum = cust_main.custnum";
3699
3700 sub prospect_sql { "
3701   0 = ( $select_count_pkgs )
3702 "; }
3703
3704 =item active_sql
3705
3706 Returns an SQL expression identifying active cust_main records (customers with
3707 no active recurring packages, but otherwise unsuspended/uncancelled).
3708
3709 =cut
3710
3711 sub active_sql { "
3712   0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
3713       )
3714 "; }
3715
3716 =item inactive_sql
3717
3718 Returns an SQL expression identifying inactive cust_main records (customers with
3719 active recurring packages).
3720
3721 =cut
3722
3723 sub inactive_sql { "
3724   0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
3725   AND
3726   0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
3727 "; }
3728
3729 =item susp_sql
3730 =item suspended_sql
3731
3732 Returns an SQL expression identifying suspended cust_main records.
3733
3734 =cut
3735
3736
3737 sub suspended_sql { susp_sql(@_); }
3738 sub susp_sql { "
3739     0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
3740     AND
3741     0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
3742 "; }
3743
3744 =item cancel_sql
3745 =item cancelled_sql
3746
3747 Returns an SQL expression identifying cancelled cust_main records.
3748
3749 =cut
3750
3751 sub cancelled_sql { cancel_sql(@_); }
3752 sub cancel_sql {
3753
3754   my $recurring_sql = FS::cust_pkg->recurring_sql;
3755   #my $recurring_sql = "
3756   #  '0' != ( select freq from part_pkg
3757   #             where cust_pkg.pkgpart = part_pkg.pkgpart )
3758   #";
3759
3760   "
3761     0 < ( $select_count_pkgs )
3762     AND 0 = ( $select_count_pkgs AND $recurring_sql
3763                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3764             )
3765   ";
3766 }
3767
3768 =item uncancel_sql
3769 =item uncancelled_sql
3770
3771 Returns an SQL expression identifying un-cancelled cust_main records.
3772
3773 =cut
3774
3775 sub uncancelled_sql { uncancel_sql(@_); }
3776 sub uncancel_sql { "
3777   ( 0 < ( $select_count_pkgs
3778                    AND ( cust_pkg.cancel IS NULL
3779                          OR cust_pkg.cancel = 0
3780                        )
3781         )
3782     OR 0 = ( $select_count_pkgs )
3783   )
3784 "; }
3785
3786 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3787
3788 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3789 records.  Currently, only I<last> or I<company> may be specified (the
3790 appropriate ship_ field is also searched if applicable).
3791
3792 Additional options are the same as FS::Record::qsearch
3793
3794 =cut
3795
3796 sub fuzzy_search {
3797   my( $self, $fuzzy, $hash, @opt) = @_;
3798   #$self
3799   $hash ||= {};
3800   my @cust_main = ();
3801
3802   check_and_rebuild_fuzzyfiles();
3803   foreach my $field ( keys %$fuzzy ) {
3804     my $sub = \&{"all_$field"};
3805     my %match = ();
3806     $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
3807
3808     foreach ( keys %match ) {
3809       push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3810       push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
3811         if defined dbdef->table('cust_main')->column('ship_last');
3812     }
3813   }
3814
3815   my %saw = ();
3816   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
3817
3818   @cust_main;
3819
3820 }
3821
3822 =back
3823
3824 =head1 SUBROUTINES
3825
3826 =over 4
3827
3828 =item smart_search OPTION => VALUE ...
3829
3830 Accepts the following options: I<search>, the string to search for.  The string
3831 will be searched for as a customer number, last name or company name, first
3832 searching for an exact match then fuzzy and substring matches.
3833
3834 Any additional options treated as an additional qualifier on the search
3835 (i.e. I<agentnum>).
3836
3837 Returns a (possibly empty) array of FS::cust_main objects.
3838
3839 =cut
3840
3841 sub smart_search {
3842   my %options = @_;
3843   my $search = delete $options{'search'};
3844
3845   #here is the agent virtualization
3846   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
3847
3848   my @cust_main = ();
3849   if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3850
3851     push @cust_main, qsearch( {
3852       'table'     => 'cust_main',
3853       'hashref'   => { 'custnum' => $1, %options },
3854       'extra_sql' => " AND $agentnums_sql", #agent virtualization
3855     } );
3856
3857   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3858
3859     my $value = lc($1);
3860     my $q_value = dbh->quote($value);
3861
3862     #exact
3863     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3864     $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3865     $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3866       if defined dbdef->table('cust_main')->column('ship_last');
3867     $sql .= ' )';
3868
3869     push @cust_main, qsearch( {
3870       'table'     => 'cust_main',
3871       'hashref'   => \%options,
3872       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
3873     } );
3874
3875     unless ( @cust_main ) {  #no exact match, trying substring/fuzzy
3876
3877       #still some false laziness w/ search/cust_main.cgi
3878
3879       #substring
3880       push @cust_main, qsearch( {
3881         'table'     => 'cust_main',
3882         'hashref'   => { 'last'     => { 'op'    => 'ILIKE',
3883                                          'value' => "%$q_value%" },
3884                          %options,
3885                        },
3886         'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
3887       } );
3888       push @cust_main, qsearch( {
3889         'table'     => 'cust_main',
3890         'hashref'   => { 'ship_last' => { 'op'     => 'ILIKE',
3891                                           'value' => "%$q_value%" },
3892                          %options,
3893                        },
3894         'extra_sql' => " AND $agentnums_sql", #agent virtualization
3895       } )
3896         if defined dbdef->table('cust_main')->column('ship_last');
3897
3898       push @cust_main, qsearch( {
3899         'table'     => 'cust_main',
3900         'hashref'   => { 'company'  => { 'op'    => 'ILIKE',
3901                                          'value' => "%$q_value%" },
3902                          %options,
3903                        },
3904         'extra_sql' => " AND $agentnums_sql", #agent virtualization
3905       } );
3906       push @cust_main, qsearch(  {
3907         'table'     => 'cust_main',
3908         'hashref'   => { 'ship_company' => { 'op'    => 'ILIKE',
3909                                              'value' => "%$q_value%" },
3910                          %options,
3911                        },
3912         'extra_sql' => " AND $agentnums_sql", #agent virtualization
3913       } )
3914         if defined dbdef->table('cust_main')->column('ship_last');
3915
3916       #fuzzy
3917       push @cust_main, FS::cust_main->fuzzy_search(
3918         { 'last'     => $value }, #fuzzy hashref
3919         \%options,                #hashref
3920         '',                       #select
3921         " AND $agentnums_sql",    #extra_sql  #agent virtualization
3922       );
3923       push @cust_main, FS::cust_main->fuzzy_search(
3924         { 'company'  => $value }, #fuzzy hashref
3925         \%options,                #hashref
3926         '',                       #select
3927         " AND $agentnums_sql",    #extra_sql  #agent virtualization
3928       );
3929
3930     }
3931
3932   }
3933
3934   @cust_main;
3935
3936 }
3937
3938 =item check_and_rebuild_fuzzyfiles
3939
3940 =cut
3941
3942 sub check_and_rebuild_fuzzyfiles {
3943   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3944   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3945     or &rebuild_fuzzyfiles;
3946 }
3947
3948 =item rebuild_fuzzyfiles
3949
3950 =cut
3951
3952 sub rebuild_fuzzyfiles {
3953
3954   use Fcntl qw(:flock);
3955
3956   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3957   mkdir $dir, 0700 unless -d $dir;
3958
3959   #last
3960
3961   open(LASTLOCK,">>$dir/cust_main.last")
3962     or die "can't open $dir/cust_main.last: $!";
3963   flock(LASTLOCK,LOCK_EX)
3964     or die "can't lock $dir/cust_main.last: $!";
3965
3966   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3967   push @all_last,
3968                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3969     if defined dbdef->table('cust_main')->column('ship_last');
3970
3971   open (LASTCACHE,">$dir/cust_main.last.tmp")
3972     or die "can't open $dir/cust_main.last.tmp: $!";
3973   print LASTCACHE join("\n", @all_last), "\n";
3974   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3975
3976   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3977   close LASTLOCK;
3978
3979   #company
3980
3981   open(COMPANYLOCK,">>$dir/cust_main.company")
3982     or die "can't open $dir/cust_main.company: $!";
3983   flock(COMPANYLOCK,LOCK_EX)
3984     or die "can't lock $dir/cust_main.company: $!";
3985
3986   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3987   push @all_company,
3988        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3989     if defined dbdef->table('cust_main')->column('ship_last');
3990
3991   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3992     or die "can't open $dir/cust_main.company.tmp: $!";
3993   print COMPANYCACHE join("\n", @all_company), "\n";
3994   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3995
3996   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3997   close COMPANYLOCK;
3998
3999 }
4000
4001 =item all_last
4002
4003 =cut
4004
4005 sub all_last {
4006   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4007   open(LASTCACHE,"<$dir/cust_main.last")
4008     or die "can't open $dir/cust_main.last: $!";
4009   my @array = map { chomp; $_; } <LASTCACHE>;
4010   close LASTCACHE;
4011   \@array;
4012 }
4013
4014 =item all_company
4015
4016 =cut
4017
4018 sub all_company {
4019   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4020   open(COMPANYCACHE,"<$dir/cust_main.company")
4021     or die "can't open $dir/cust_main.last: $!";
4022   my @array = map { chomp; $_; } <COMPANYCACHE>;
4023   close COMPANYCACHE;
4024   \@array;
4025 }
4026
4027 =item append_fuzzyfiles LASTNAME COMPANY
4028
4029 =cut
4030
4031 sub append_fuzzyfiles {
4032   my( $last, $company ) = @_;
4033
4034   &check_and_rebuild_fuzzyfiles;
4035
4036   use Fcntl qw(:flock);
4037
4038   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4039
4040   if ( $last ) {
4041
4042     open(LAST,">>$dir/cust_main.last")
4043       or die "can't open $dir/cust_main.last: $!";
4044     flock(LAST,LOCK_EX)
4045       or die "can't lock $dir/cust_main.last: $!";
4046
4047     print LAST "$last\n";
4048
4049     flock(LAST,LOCK_UN)
4050       or die "can't unlock $dir/cust_main.last: $!";
4051     close LAST;
4052   }
4053
4054   if ( $company ) {
4055
4056     open(COMPANY,">>$dir/cust_main.company")
4057       or die "can't open $dir/cust_main.company: $!";
4058     flock(COMPANY,LOCK_EX)
4059       or die "can't lock $dir/cust_main.company: $!";
4060
4061     print COMPANY "$company\n";
4062
4063     flock(COMPANY,LOCK_UN)
4064       or die "can't unlock $dir/cust_main.company: $!";
4065
4066     close COMPANY;
4067   }
4068
4069   1;
4070 }
4071
4072 =item batch_import
4073
4074 =cut
4075
4076 sub batch_import {
4077   my $param = shift;
4078   #warn join('-',keys %$param);
4079   my $fh = $param->{filehandle};
4080   my $agentnum = $param->{agentnum};
4081   my $refnum = $param->{refnum};
4082   my $pkgpart = $param->{pkgpart};
4083   my @fields = @{$param->{fields}};
4084
4085   eval "use Text::CSV_XS;";
4086   die $@ if $@;
4087
4088   my $csv = new Text::CSV_XS;
4089   #warn $csv;
4090   #warn $fh;
4091
4092   my $imported = 0;
4093   #my $columns;
4094
4095   local $SIG{HUP} = 'IGNORE';
4096   local $SIG{INT} = 'IGNORE';
4097   local $SIG{QUIT} = 'IGNORE';
4098   local $SIG{TERM} = 'IGNORE';
4099   local $SIG{TSTP} = 'IGNORE';
4100   local $SIG{PIPE} = 'IGNORE';
4101
4102   my $oldAutoCommit = $FS::UID::AutoCommit;
4103   local $FS::UID::AutoCommit = 0;
4104   my $dbh = dbh;
4105
4106   #while ( $columns = $csv->getline($fh) ) {
4107   my $line;
4108   while ( defined($line=<$fh>) ) {
4109
4110     $csv->parse($line) or do {
4111       $dbh->rollback if $oldAutoCommit;
4112       return "can't parse: ". $csv->error_input();
4113     };
4114
4115     my @columns = $csv->fields();
4116     #warn join('-',@columns);
4117
4118     my %cust_main = (
4119       agentnum => $agentnum,
4120       refnum   => $refnum,
4121       country  => $conf->config('countrydefault') || 'US',
4122       payby    => 'BILL', #default
4123       paydate  => '12/2037', #default
4124     );
4125     my $billtime = time;
4126     my %cust_pkg = ( pkgpart => $pkgpart );
4127     foreach my $field ( @fields ) {
4128       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
4129         #$cust_pkg{$1} = str2time( shift @$columns );
4130         if ( $1 eq 'setup' ) {
4131           $billtime = str2time(shift @columns);
4132         } else {
4133           $cust_pkg{$1} = str2time( shift @columns );
4134         }
4135       } else {
4136         #$cust_main{$field} = shift @$columns;
4137         $cust_main{$field} = shift @columns;
4138       }
4139     }
4140
4141     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
4142     my $cust_main = new FS::cust_main ( \%cust_main );
4143     use Tie::RefHash;
4144     tie my %hash, 'Tie::RefHash'; #this part is important
4145     $hash{$cust_pkg} = [] if $pkgpart;
4146     my $error = $cust_main->insert( \%hash );
4147
4148     if ( $error ) {
4149       $dbh->rollback if $oldAutoCommit;
4150       return "can't insert customer for $line: $error";
4151     }
4152
4153     #false laziness w/bill.cgi
4154     $error = $cust_main->bill( 'time' => $billtime );
4155     if ( $error ) {
4156       $dbh->rollback if $oldAutoCommit;
4157       return "can't bill customer for $line: $error";
4158     }
4159
4160     $cust_main->apply_payments;
4161     $cust_main->apply_credits;
4162
4163     $error = $cust_main->collect();
4164     if ( $error ) {
4165       $dbh->rollback if $oldAutoCommit;
4166       return "can't collect customer for $line: $error";
4167     }
4168
4169     $imported++;
4170   }
4171
4172   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4173
4174   return "Empty file!" unless $imported;
4175
4176   ''; #no error
4177
4178 }
4179
4180 =item batch_charge
4181
4182 =cut
4183
4184 sub batch_charge {
4185   my $param = shift;
4186   #warn join('-',keys %$param);
4187   my $fh = $param->{filehandle};
4188   my @fields = @{$param->{fields}};
4189
4190   eval "use Text::CSV_XS;";
4191   die $@ if $@;
4192
4193   my $csv = new Text::CSV_XS;
4194   #warn $csv;
4195   #warn $fh;
4196
4197   my $imported = 0;
4198   #my $columns;
4199
4200   local $SIG{HUP} = 'IGNORE';
4201   local $SIG{INT} = 'IGNORE';
4202   local $SIG{QUIT} = 'IGNORE';
4203   local $SIG{TERM} = 'IGNORE';
4204   local $SIG{TSTP} = 'IGNORE';
4205   local $SIG{PIPE} = 'IGNORE';
4206
4207   my $oldAutoCommit = $FS::UID::AutoCommit;
4208   local $FS::UID::AutoCommit = 0;
4209   my $dbh = dbh;
4210
4211   #while ( $columns = $csv->getline($fh) ) {
4212   my $line;
4213   while ( defined($line=<$fh>) ) {
4214
4215     $csv->parse($line) or do {
4216       $dbh->rollback if $oldAutoCommit;
4217       return "can't parse: ". $csv->error_input();
4218     };
4219
4220     my @columns = $csv->fields();
4221     #warn join('-',@columns);
4222
4223     my %row = ();
4224     foreach my $field ( @fields ) {
4225       $row{$field} = shift @columns;
4226     }
4227
4228     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
4229     unless ( $cust_main ) {
4230       $dbh->rollback if $oldAutoCommit;
4231       return "unknown custnum $row{'custnum'}";
4232     }
4233
4234     if ( $row{'amount'} > 0 ) {
4235       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4236       if ( $error ) {
4237         $dbh->rollback if $oldAutoCommit;
4238         return $error;
4239       }
4240       $imported++;
4241     } elsif ( $row{'amount'} < 0 ) {
4242       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4243                                       $row{'pkg'}                         );
4244       if ( $error ) {
4245         $dbh->rollback if $oldAutoCommit;
4246         return $error;
4247       }
4248       $imported++;
4249     } else {
4250       #hmm?
4251     }
4252
4253   }
4254
4255   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4256
4257   return "Empty file!" unless $imported;
4258
4259   ''; #no error
4260
4261 }
4262
4263 =back
4264
4265 =head1 BUGS
4266
4267 The delete method.
4268
4269 The delete method should possibly take an FS::cust_main object reference
4270 instead of a scalar customer number.
4271
4272 Bill and collect options should probably be passed as references instead of a
4273 list.
4274
4275 There should probably be a configuration file with a list of allowed credit
4276 card types.
4277
4278 No multiple currency support (probably a larger project than just this module).
4279
4280 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4281
4282 =head1 SEE ALSO
4283
4284 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4285 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4286 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
4287
4288 =cut
4289
4290 1;
4291