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