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