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