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
2279   my $payip = exists($options{'payip'})
2280                 ? $options{'payip'}
2281                 : $self->payip;
2282   $content{customer_ip} = $payip
2283     if length($payip);
2284
2285   if ( $method eq 'CC' ) {
2286
2287     $content{card_number} = $payinfo;
2288     my $paydate = exists($options{'paydate'})
2289                     ? $options{'paydate'}
2290                     : $self->paydate;
2291     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2292     $content{expiration} = "$2/$1";
2293
2294     my $paycvv = exists($options{'paycvv'})
2295                    ? $options{'paycvv'}
2296                    : $self->paycvv;
2297     $content{cvv2} = $self->paycvv
2298       if length($paycvv);
2299
2300     my $paystart_month = exists($options{'paystart_month'})
2301                            ? $options{'paystart_month'}
2302                            : $self->paystart_month;
2303
2304     my $paystart_year  = exists($options{'paystart_year'})
2305                            ? $options{'paystart_year'}
2306                            : $self->paystart_year;
2307
2308     $content{card_start} = "$paystart_month/$paystart_year"
2309       if $paystart_month && $paystart_year;
2310
2311     my $payissue       = exists($options{'payissue'})
2312                            ? $options{'payissue'}
2313                            : $self->payissue;
2314     $content{issue_number} = $payissue if $payissue;
2315
2316     $content{recurring_billing} = 'YES'
2317       if qsearch('cust_pay', { 'custnum' => $self->custnum,
2318                                'payby'   => 'CARD',
2319                                'payinfo' => $payinfo,
2320                              } );
2321
2322   } elsif ( $method eq 'ECHECK' ) {
2323     ( $content{account_number}, $content{routing_code} ) =
2324       split('@', $payinfo);
2325     $content{bank_name} = $o_payname;
2326     $content{account_type} = 'CHECKING';
2327     $content{account_name} = $payname;
2328     $content{customer_org} = $self->company ? 'B' : 'I';
2329     $content{customer_ssn} = exists($options{'ss'})
2330                                ? $options{'ss'}
2331                                : $self->ss;
2332   } elsif ( $method eq 'LEC' ) {
2333     $content{phone} = $payinfo;
2334   }
2335
2336   ###
2337   # run transaction(s)
2338   ###
2339
2340   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
2341
2342   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
2343   $transaction->content(
2344     'type'           => $method,
2345     'login'          => $login,
2346     'password'       => $password,
2347     'action'         => $action1,
2348     'description'    => $options{'description'},
2349     'amount'         => $amount,
2350     'invoice_number' => $options{'invnum'},
2351     'customer_id'    => $self->custnum,
2352     'last_name'      => $paylast,
2353     'first_name'     => $payfirst,
2354     'name'           => $payname,
2355     'address'        => $address,
2356     'city'           => ( exists($options{'city'})
2357                             ? $options{'city'}
2358                             : $self->city          ),
2359     'state'          => ( exists($options{'state'})
2360                             ? $options{'state'}
2361                             : $self->state          ),
2362     'zip'            => ( exists($options{'zip'})
2363                             ? $options{'zip'}
2364                             : $self->zip          ),
2365     'country'        => ( exists($options{'country'})
2366                             ? $options{'country'}
2367                             : $self->country          ),
2368     'referer'        => 'http://cleanwhisker.420.am/',
2369     'email'          => $email,
2370     'phone'          => $self->daytime || $self->night,
2371     %content, #after
2372   );
2373   $transaction->submit();
2374
2375   if ( $transaction->is_success() && $action2 ) {
2376     my $auth = $transaction->authorization;
2377     my $ordernum = $transaction->can('order_number')
2378                    ? $transaction->order_number
2379                    : '';
2380
2381     my $capture =
2382       new Business::OnlinePayment( $processor, @bop_options );
2383
2384     my %capture = (
2385       %content,
2386       type           => $method,
2387       action         => $action2,
2388       login          => $login,
2389       password       => $password,
2390       order_number   => $ordernum,
2391       amount         => $amount,
2392       authorization  => $auth,
2393       description    => $options{'description'},
2394     );
2395
2396     foreach my $field (qw( authorization_source_code returned_ACI                                          transaction_identifier validation_code
2397                            transaction_sequence_num local_transaction_date
2398                            local_transaction_time AVS_result_code          )) {
2399       $capture{$field} = $transaction->$field() if $transaction->can($field);
2400     }
2401
2402     $capture->content( %capture );
2403
2404     $capture->submit();
2405
2406     unless ( $capture->is_success ) {
2407       my $e = "Authorization sucessful but capture failed, custnum #".
2408               $self->custnum. ': '.  $capture->result_code.
2409               ": ". $capture->error_message;
2410       warn $e;
2411       return $e;
2412     }
2413
2414   }
2415
2416   ###
2417   # remove paycvv after initial transaction
2418   ###
2419
2420   #false laziness w/misc/process/payment.cgi - check both to make sure working
2421   # correctly
2422   if ( defined $self->dbdef_table->column('paycvv')
2423        && length($self->paycvv)
2424        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2425   ) {
2426     my $error = $self->remove_cvv;
2427     if ( $error ) {
2428       warn "error removing cvv: $error\n";
2429     }
2430   }
2431
2432   ###
2433   # result handling
2434   ###
2435
2436   if ( $transaction->is_success() ) {
2437
2438     my %method2payby = (
2439       'CC'     => 'CARD',
2440       'ECHECK' => 'CHEK',
2441       'LEC'    => 'LECB',
2442     );
2443
2444     my $paybatch = '';
2445     if ( $payment_gateway ) { # agent override
2446       $paybatch = $payment_gateway->gatewaynum. '-';
2447     }
2448
2449     $paybatch .= "$processor:". $transaction->authorization;
2450
2451     $paybatch .= ':'. $transaction->order_number
2452       if $transaction->can('order_number')
2453       && length($transaction->order_number);
2454
2455     my $cust_pay = new FS::cust_pay ( {
2456        'custnum'  => $self->custnum,
2457        'invnum'   => $options{'invnum'},
2458        'paid'     => $amount,
2459        '_date'     => '',
2460        'payby'    => $method2payby{$method},
2461        'payinfo'  => $payinfo,
2462        'paybatch' => $paybatch,
2463     } );
2464     my $error = $cust_pay->insert;
2465     if ( $error ) {
2466       $cust_pay->invnum(''); #try again with no specific invnum
2467       my $error2 = $cust_pay->insert;
2468       if ( $error2 ) {
2469         # gah, even with transactions.
2470         my $e = 'WARNING: Card/ACH debited but database not updated - '.
2471                 "error inserting payment ($processor): $error2".
2472                 " (previously tried insert with invnum #$options{'invnum'}" .
2473                 ": $error )";
2474         warn $e;
2475         return $e;
2476       }
2477     }
2478     return ''; #no error
2479
2480   } else {
2481
2482     my $perror = "$processor error: ". $transaction->error_message;
2483
2484     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2485          && $conf->exists('emaildecline')
2486          && grep { $_ ne 'POST' } $self->invoicing_list
2487          && ! grep { $transaction->error_message =~ /$_/ }
2488                    $conf->config('emaildecline-exclude')
2489     ) {
2490       my @templ = $conf->config('declinetemplate');
2491       my $template = new Text::Template (
2492         TYPE   => 'ARRAY',
2493         SOURCE => [ map "$_\n", @templ ],
2494       ) or return "($perror) can't create template: $Text::Template::ERROR";
2495       $template->compile()
2496         or return "($perror) can't compile template: $Text::Template::ERROR";
2497
2498       my $templ_hash = { error => $transaction->error_message };
2499
2500       my $error = send_email(
2501         'from'    => $conf->config('invoice_from'),
2502         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2503         'subject' => 'Your payment could not be processed',
2504         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
2505       );
2506
2507       $perror .= " (also received error sending decline notification: $error)"
2508         if $error;
2509
2510     }
2511
2512     return $perror;
2513   }
2514
2515 }
2516
2517 =item default_payment_gateway
2518
2519 =cut
2520
2521 sub default_payment_gateway {
2522   my( $self, $method ) = @_;
2523
2524   die "Real-time processing not enabled\n"
2525     unless $conf->exists('business-onlinepayment');
2526
2527   #load up config
2528   my $bop_config = 'business-onlinepayment';
2529   $bop_config .= '-ach'
2530     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2531   my ( $processor, $login, $password, $action, @bop_options ) =
2532     $conf->config($bop_config);
2533   $action ||= 'normal authorization';
2534   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2535   die "No real-time processor is enabled - ".
2536       "did you set the business-onlinepayment configuration value?\n"
2537     unless $processor;
2538
2539   ( $processor, $login, $password, $action, @bop_options )
2540 }
2541
2542 =item remove_cvv
2543
2544 Removes the I<paycvv> field from the database directly.
2545
2546 If there is an error, returns the error, otherwise returns false.
2547
2548 =cut
2549
2550 sub remove_cvv {
2551   my $self = shift;
2552   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2553     or return dbh->errstr;
2554   $sth->execute($self->custnum)
2555     or return $sth->errstr;
2556   $self->paycvv('');
2557   '';
2558 }
2559
2560 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2561
2562 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2563 via a Business::OnlinePayment realtime gateway.  See
2564 L<http://420.am/business-onlinepayment> for supported gateways.
2565
2566 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2567
2568 Available options are: I<amount>, I<reason>, I<paynum>
2569
2570 Most gateways require a reference to an original payment transaction to refund,
2571 so you probably need to specify a I<paynum>.
2572
2573 I<amount> defaults to the original amount of the payment if not specified.
2574
2575 I<reason> specifies a reason for the refund.
2576
2577 Implementation note: If I<amount> is unspecified or equal to the amount of the
2578 orignal payment, first an attempt is made to "void" the transaction via
2579 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2580 the normal attempt is made to "refund" ("credit") the transaction via the
2581 gateway is attempted.
2582
2583 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2584 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2585 #if set, will override the value from the customer record.
2586
2587 #If an I<invnum> is specified, this payment (if sucessful) is applied to the
2588 #specified invoice.  If you don't specify an I<invnum> you might want to
2589 #call the B<apply_payments> method.
2590
2591 =cut
2592
2593 #some false laziness w/realtime_bop, not enough to make it worth merging
2594 #but some useful small subs should be pulled out
2595 sub realtime_refund_bop {
2596   my( $self, $method, %options ) = @_;
2597   if ( $DEBUG ) {
2598     warn "$self $method refund\n";
2599     warn "  $_ => $options{$_}\n" foreach keys %options;
2600   }
2601
2602   eval "use Business::OnlinePayment";
2603   die $@ if $@;
2604
2605   ###
2606   # look up the original payment and optionally a gateway for that payment
2607   ###
2608
2609   my $cust_pay = '';
2610   my $amount = $options{'amount'};
2611
2612   my( $processor, $login, $password, @bop_options ) ;
2613   my( $auth, $order_number ) = ( '', '', '' );
2614
2615   if ( $options{'paynum'} ) {
2616
2617     warn "FS::cust_main::realtime_bop: paynum: $options{paynum}\n" if $DEBUG;
2618     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2619       or return "Unknown paynum $options{'paynum'}";
2620     $amount ||= $cust_pay->paid;
2621
2622     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/
2623       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2624                 $cust_pay->paybatch;
2625     my $gatewaynum = '';
2626     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
2627
2628     if ( $gatewaynum ) { #gateway for the payment to be refunded
2629
2630       my $payment_gateway =
2631         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
2632       die "payment gateway $gatewaynum not found"
2633         unless $payment_gateway;
2634
2635       $processor   = $payment_gateway->gateway_module;
2636       $login       = $payment_gateway->gateway_username;
2637       $password    = $payment_gateway->gateway_password;
2638       @bop_options = $payment_gateway->options;
2639
2640     } else { #try the default gateway
2641
2642       my( $conf_processor, $unused_action );
2643       ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
2644         $self->default_payment_gateway($method);
2645
2646       return "processor of payment $options{'paynum'} $processor does not".
2647              " match default processor $conf_processor"
2648         unless $processor eq $conf_processor;
2649
2650     }
2651
2652
2653   } else { # didn't specify a paynum, so look for agent gateway overrides
2654            # like a normal transaction
2655
2656     my $cardtype;
2657     if ( $method eq 'CC' ) {
2658       $cardtype = cardtype($self->payinfo);
2659     } elsif ( $method eq 'ECHECK' ) {
2660       $cardtype = 'ACH';
2661     } else {
2662       $cardtype = $method;
2663     }
2664     my $override =
2665            qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2666                                                cardtype => $cardtype,
2667                                                taxclass => '',              } )
2668         || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2669                                                cardtype => '',
2670                                                taxclass => '',              } );
2671
2672     if ( $override ) { #use a payment gateway override
2673
2674       my $payment_gateway = $override->payment_gateway;
2675
2676       $processor   = $payment_gateway->gateway_module;
2677       $login       = $payment_gateway->gateway_username;
2678       $password    = $payment_gateway->gateway_password;
2679       #$action      = $payment_gateway->gateway_action;
2680       @bop_options = $payment_gateway->options;
2681
2682     } else { #use the standard settings from the config
2683
2684       my $unused_action;
2685       ( $processor, $login, $password, $unused_action, @bop_options ) =
2686         $self->default_payment_gateway($method);
2687
2688     }
2689
2690   }
2691   return "neither amount nor paynum specified" unless $amount;
2692
2693   my %content = (
2694     'type'           => $method,
2695     'login'          => $login,
2696     'password'       => $password,
2697     'order_number'   => $order_number,
2698     'amount'         => $amount,
2699     'referer'        => 'http://cleanwhisker.420.am/',
2700   );
2701   $content{authorization} = $auth
2702     if length($auth); #echeck/ACH transactions have an order # but no auth
2703                       #(at least with authorize.net)
2704
2705   #first try void if applicable
2706   if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2707     warn "FS::cust_main::realtime_bop: attempting void\n" if $DEBUG;
2708     my $void = new Business::OnlinePayment( $processor, @bop_options );
2709     $void->content( 'action' => 'void', %content );
2710     $void->submit();
2711     if ( $void->is_success ) {
2712       my $error = $cust_pay->void($options{'reason'});
2713       if ( $error ) {
2714         # gah, even with transactions.
2715         my $e = 'WARNING: Card/ACH voided but database not updated - '.
2716                 "error voiding payment: $error";
2717         warn $e;
2718         return $e;
2719       }
2720       warn "FS::cust_main::realtime_bop: void successful\n" if $DEBUG;
2721       return '';
2722     }
2723   }
2724
2725   warn "FS::cust_main::realtime_bop: void unsuccessful, trying refund\n"
2726     if $DEBUG;
2727
2728   #massage data
2729   my $address = $self->address1;
2730   $address .= ", ". $self->address2 if $self->address2;
2731
2732   my($payname, $payfirst, $paylast);
2733   if ( $self->payname && $method ne 'ECHECK' ) {
2734     $payname = $self->payname;
2735     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2736       or return "Illegal payname $payname";
2737     ($payfirst, $paylast) = ($1, $2);
2738   } else {
2739     $payfirst = $self->getfield('first');
2740     $paylast = $self->getfield('last');
2741     $payname =  "$payfirst $paylast";
2742   }
2743
2744   my $payinfo = '';
2745   if ( $method eq 'CC' ) {
2746
2747     if ( $cust_pay ) {
2748       $content{card_number} = $payinfo = $cust_pay->payinfo;
2749       #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2750       #$content{expiration} = "$2/$1";
2751     } else {
2752       $content{card_number} = $payinfo = $self->payinfo;
2753       $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2754       $content{expiration} = "$2/$1";
2755     }
2756
2757   } elsif ( $method eq 'ECHECK' ) {
2758     ( $content{account_number}, $content{routing_code} ) =
2759       split('@', $payinfo = $self->payinfo);
2760     $content{bank_name} = $self->payname;
2761     $content{account_type} = 'CHECKING';
2762     $content{account_name} = $payname;
2763     $content{customer_org} = $self->company ? 'B' : 'I';
2764     $content{customer_ssn} = $self->ss;
2765   } elsif ( $method eq 'LEC' ) {
2766     $content{phone} = $payinfo = $self->payinfo;
2767   }
2768
2769   #then try refund
2770   my $refund = new Business::OnlinePayment( $processor, @bop_options );
2771   my %sub_content = $refund->content(
2772     'action'         => 'credit',
2773     'customer_id'    => $self->custnum,
2774     'last_name'      => $paylast,
2775     'first_name'     => $payfirst,
2776     'name'           => $payname,
2777     'address'        => $address,
2778     'city'           => $self->city,
2779     'state'          => $self->state,
2780     'zip'            => $self->zip,
2781     'country'        => $self->country,
2782     %content, #after
2783   );
2784   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
2785     if $DEBUG > 1;
2786   $refund->submit();
2787
2788   return "$processor error: ". $refund->error_message
2789     unless $refund->is_success();
2790
2791   my %method2payby = (
2792     'CC'     => 'CARD',
2793     'ECHECK' => 'CHEK',
2794     'LEC'    => 'LECB',
2795   );
2796
2797   my $paybatch = "$processor:". $refund->authorization;
2798   $paybatch .= ':'. $refund->order_number
2799     if $refund->can('order_number') && $refund->order_number;
2800
2801   while ( $cust_pay && $cust_pay->unappled < $amount ) {
2802     my @cust_bill_pay = $cust_pay->cust_bill_pay;
2803     last unless @cust_bill_pay;
2804     my $cust_bill_pay = pop @cust_bill_pay;
2805     my $error = $cust_bill_pay->delete;
2806     last if $error;
2807   }
2808
2809   my $cust_refund = new FS::cust_refund ( {
2810     'custnum'  => $self->custnum,
2811     'paynum'   => $options{'paynum'},
2812     'refund'   => $amount,
2813     '_date'    => '',
2814     'payby'    => $method2payby{$method},
2815     'payinfo'  => $payinfo,
2816     'paybatch' => $paybatch,
2817     'reason'   => $options{'reason'} || 'card or ACH refund',
2818   } );
2819   my $error = $cust_refund->insert;
2820   if ( $error ) {
2821     $cust_refund->paynum(''); #try again with no specific paynum
2822     my $error2 = $cust_refund->insert;
2823     if ( $error2 ) {
2824       # gah, even with transactions.
2825       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2826               "error inserting refund ($processor): $error2".
2827               " (previously tried insert with paynum #$options{'paynum'}" .
2828               ": $error )";
2829       warn $e;
2830       return $e;
2831     }
2832   }
2833
2834   ''; #no error
2835
2836 }
2837
2838 =item total_owed
2839
2840 Returns the total owed for this customer on all invoices
2841 (see L<FS::cust_bill/owed>).
2842
2843 =cut
2844
2845 sub total_owed {
2846   my $self = shift;
2847   $self->total_owed_date(2145859200); #12/31/2037
2848 }
2849
2850 =item total_owed_date TIME
2851
2852 Returns the total owed for this customer on all invoices with date earlier than
2853 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2854 see L<Time::Local> and L<Date::Parse> for conversion functions.
2855
2856 =cut
2857
2858 sub total_owed_date {
2859   my $self = shift;
2860   my $time = shift;
2861   my $total_bill = 0;
2862   foreach my $cust_bill (
2863     grep { $_->_date <= $time }
2864       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2865   ) {
2866     $total_bill += $cust_bill->owed;
2867   }
2868   sprintf( "%.2f", $total_bill );
2869 }
2870
2871 =item apply_credits OPTION => VALUE ...
2872
2873 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2874 to outstanding invoice balances in chronological order (or reverse
2875 chronological order if the I<order> option is set to B<newest>) and returns the
2876 value of any remaining unapplied credits available for refund (see
2877 L<FS::cust_refund>).
2878
2879 =cut
2880
2881 sub apply_credits {
2882   my $self = shift;
2883   my %opt = @_;
2884
2885   return 0 unless $self->total_credited;
2886
2887   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2888       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2889
2890   my @invoices = $self->open_cust_bill;
2891   @invoices = sort { $b->_date <=> $a->_date } @invoices
2892     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2893
2894   my $credit;
2895   foreach my $cust_bill ( @invoices ) {
2896     my $amount;
2897
2898     if ( !defined($credit) || $credit->credited == 0) {
2899       $credit = pop @credits or last;
2900     }
2901
2902     if ($cust_bill->owed >= $credit->credited) {
2903       $amount=$credit->credited;
2904     }else{
2905       $amount=$cust_bill->owed;
2906     }
2907
2908     my $cust_credit_bill = new FS::cust_credit_bill ( {
2909       'crednum' => $credit->crednum,
2910       'invnum'  => $cust_bill->invnum,
2911       'amount'  => $amount,
2912     } );
2913     my $error = $cust_credit_bill->insert;
2914     die $error if $error;
2915
2916     redo if ($cust_bill->owed > 0);
2917
2918   }
2919
2920   return $self->total_credited;
2921 }
2922
2923 =item apply_payments
2924
2925 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2926 to outstanding invoice balances in chronological order.
2927
2928  #and returns the value of any remaining unapplied payments.
2929
2930 =cut
2931
2932 sub apply_payments {
2933   my $self = shift;
2934
2935   #return 0 unless
2936
2937   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2938       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
2939
2940   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2941       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2942
2943   my $payment;
2944
2945   foreach my $cust_bill ( @invoices ) {
2946     my $amount;
2947
2948     if ( !defined($payment) || $payment->unapplied == 0 ) {
2949       $payment = pop @payments or last;
2950     }
2951
2952     if ( $cust_bill->owed >= $payment->unapplied ) {
2953       $amount = $payment->unapplied;
2954     } else {
2955       $amount = $cust_bill->owed;
2956     }
2957
2958     my $cust_bill_pay = new FS::cust_bill_pay ( {
2959       'paynum' => $payment->paynum,
2960       'invnum' => $cust_bill->invnum,
2961       'amount' => $amount,
2962     } );
2963     my $error = $cust_bill_pay->insert;
2964     die $error if $error;
2965
2966     redo if ( $cust_bill->owed > 0);
2967
2968   }
2969
2970   return $self->total_unapplied_payments;
2971 }
2972
2973 =item total_credited
2974
2975 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2976 customer.  See L<FS::cust_credit/credited>.
2977
2978 =cut
2979
2980 sub total_credited {
2981   my $self = shift;
2982   my $total_credit = 0;
2983   foreach my $cust_credit ( qsearch('cust_credit', {
2984     'custnum' => $self->custnum,
2985   } ) ) {
2986     $total_credit += $cust_credit->credited;
2987   }
2988   sprintf( "%.2f", $total_credit );
2989 }
2990
2991 =item total_unapplied_payments
2992
2993 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2994 See L<FS::cust_pay/unapplied>.
2995
2996 =cut
2997
2998 sub total_unapplied_payments {
2999   my $self = shift;
3000   my $total_unapplied = 0;
3001   foreach my $cust_pay ( qsearch('cust_pay', {
3002     'custnum' => $self->custnum,
3003   } ) ) {
3004     $total_unapplied += $cust_pay->unapplied;
3005   }
3006   sprintf( "%.2f", $total_unapplied );
3007 }
3008
3009 =item balance
3010
3011 Returns the balance for this customer (total_owed minus total_credited
3012 minus total_unapplied_payments).
3013
3014 =cut
3015
3016 sub balance {
3017   my $self = shift;
3018   sprintf( "%.2f",
3019     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
3020   );
3021 }
3022
3023 =item balance_date TIME
3024
3025 Returns the balance for this customer, only considering invoices with date
3026 earlier than TIME (total_owed_date minus total_credited minus
3027 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
3028 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
3029 functions.
3030
3031 =cut
3032
3033 sub balance_date {
3034   my $self = shift;
3035   my $time = shift;
3036   sprintf( "%.2f",
3037     $self->total_owed_date($time)
3038       - $self->total_credited
3039       - $self->total_unapplied_payments
3040   );
3041 }
3042
3043 =item paydate_monthyear
3044
3045 Returns a two-element list consisting of the month and year of this customer's
3046 paydate (credit card expiration date for CARD customers)
3047
3048 =cut
3049
3050 sub paydate_monthyear {
3051   my $self = shift;
3052   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3053     ( $2, $1 );
3054   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3055     ( $1, $3 );
3056   } else {
3057     ('', '');
3058   }
3059 }
3060
3061 =item payinfo_masked
3062
3063 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.
3064
3065 Credit Cards - Mask all but the last four characters.
3066 Checks - Mask all but last 2 of account number and bank routing number.
3067 Others - Do nothing, return the unmasked string.
3068
3069 =cut
3070
3071 sub payinfo_masked {
3072   my $self = shift;
3073   return $self->paymask;
3074 }
3075
3076 =item invoicing_list [ ARRAYREF ]
3077
3078 If an arguement is given, sets these email addresses as invoice recipients
3079 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
3080 (except as warnings), so use check_invoicing_list first.
3081
3082 Returns a list of email addresses (with svcnum entries expanded).
3083
3084 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
3085 check it without disturbing anything by passing nothing.
3086
3087 This interface may change in the future.
3088
3089 =cut
3090
3091 sub invoicing_list {
3092   my( $self, $arrayref ) = @_;
3093   if ( $arrayref ) {
3094     my @cust_main_invoice;
3095     if ( $self->custnum ) {
3096       @cust_main_invoice =
3097         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3098     } else {
3099       @cust_main_invoice = ();
3100     }
3101     foreach my $cust_main_invoice ( @cust_main_invoice ) {
3102       #warn $cust_main_invoice->destnum;
3103       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3104         #warn $cust_main_invoice->destnum;
3105         my $error = $cust_main_invoice->delete;
3106         warn $error if $error;
3107       }
3108     }
3109     if ( $self->custnum ) {
3110       @cust_main_invoice =
3111         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3112     } else {
3113       @cust_main_invoice = ();
3114     }
3115     my %seen = map { $_->address => 1 } @cust_main_invoice;
3116     foreach my $address ( @{$arrayref} ) {
3117       next if exists $seen{$address} && $seen{$address};
3118       $seen{$address} = 1;
3119       my $cust_main_invoice = new FS::cust_main_invoice ( {
3120         'custnum' => $self->custnum,
3121         'dest'    => $address,
3122       } );
3123       my $error = $cust_main_invoice->insert;
3124       warn $error if $error;
3125     }
3126   }
3127   if ( $self->custnum ) {
3128     map { $_->address }
3129       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3130   } else {
3131     ();
3132   }
3133 }
3134
3135 =item check_invoicing_list ARRAYREF
3136
3137 Checks these arguements as valid input for the invoicing_list method.  If there
3138 is an error, returns the error, otherwise returns false.
3139
3140 =cut
3141
3142 sub check_invoicing_list {
3143   my( $self, $arrayref ) = @_;
3144   foreach my $address ( @{$arrayref} ) {
3145
3146     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3147       return 'Can\'t add FAX invoice destination with a blank FAX number.';
3148     }
3149
3150     my $cust_main_invoice = new FS::cust_main_invoice ( {
3151       'custnum' => $self->custnum,
3152       'dest'    => $address,
3153     } );
3154     my $error = $self->custnum
3155                 ? $cust_main_invoice->check
3156                 : $cust_main_invoice->checkdest
3157     ;
3158     return $error if $error;
3159   }
3160   '';
3161 }
3162
3163 =item set_default_invoicing_list
3164
3165 Sets the invoicing list to all accounts associated with this customer,
3166 overwriting any previous invoicing list.
3167
3168 =cut
3169
3170 sub set_default_invoicing_list {
3171   my $self = shift;
3172   $self->invoicing_list($self->all_emails);
3173 }
3174
3175 =item all_emails
3176
3177 Returns the email addresses of all accounts provisioned for this customer.
3178
3179 =cut
3180
3181 sub all_emails {
3182   my $self = shift;
3183   my %list;
3184   foreach my $cust_pkg ( $self->all_pkgs ) {
3185     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3186     my @svc_acct =
3187       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3188         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3189           @cust_svc;
3190     $list{$_}=1 foreach map { $_->email } @svc_acct;
3191   }
3192   keys %list;
3193 }
3194
3195 =item invoicing_list_addpost
3196
3197 Adds postal invoicing to this customer.  If this customer is already configured
3198 to receive postal invoices, does nothing.
3199
3200 =cut
3201
3202 sub invoicing_list_addpost {
3203   my $self = shift;
3204   return if grep { $_ eq 'POST' } $self->invoicing_list;
3205   my @invoicing_list = $self->invoicing_list;
3206   push @invoicing_list, 'POST';
3207   $self->invoicing_list(\@invoicing_list);
3208 }
3209
3210 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3211
3212 Returns an array of customers referred by this customer (referral_custnum set
3213 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3214 customers referred by customers referred by this customer and so on, inclusive.
3215 The default behavior is DEPTH 1 (no recursion).
3216
3217 =cut
3218
3219 sub referral_cust_main {
3220   my $self = shift;
3221   my $depth = @_ ? shift : 1;
3222   my $exclude = @_ ? shift : {};
3223
3224   my @cust_main =
3225     map { $exclude->{$_->custnum}++; $_; }
3226       grep { ! $exclude->{ $_->custnum } }
3227         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3228
3229   if ( $depth > 1 ) {
3230     push @cust_main,
3231       map { $_->referral_cust_main($depth-1, $exclude) }
3232         @cust_main;
3233   }
3234
3235   @cust_main;
3236 }
3237
3238 =item referral_cust_main_ncancelled
3239
3240 Same as referral_cust_main, except only returns customers with uncancelled
3241 packages.
3242
3243 =cut
3244
3245 sub referral_cust_main_ncancelled {
3246   my $self = shift;
3247   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3248 }
3249
3250 =item referral_cust_pkg [ DEPTH ]
3251
3252 Like referral_cust_main, except returns a flat list of all unsuspended (and
3253 uncancelled) packages for each customer.  The number of items in this list may
3254 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3255
3256 =cut
3257
3258 sub referral_cust_pkg {
3259   my $self = shift;
3260   my $depth = @_ ? shift : 1;
3261
3262   map { $_->unsuspended_pkgs }
3263     grep { $_->unsuspended_pkgs }
3264       $self->referral_cust_main($depth);
3265 }
3266
3267 =item referring_cust_main
3268
3269 Returns the single cust_main record for the customer who referred this customer
3270 (referral_custnum), or false.
3271
3272 =cut
3273
3274 sub referring_cust_main {
3275   my $self = shift;
3276   return '' unless $self->referral_custnum;
3277   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3278 }
3279
3280 =item credit AMOUNT, REASON
3281
3282 Applies a credit to this customer.  If there is an error, returns the error,
3283 otherwise returns false.
3284
3285 =cut
3286
3287 sub credit {
3288   my( $self, $amount, $reason ) = @_;
3289   my $cust_credit = new FS::cust_credit {
3290     'custnum' => $self->custnum,
3291     'amount'  => $amount,
3292     'reason'  => $reason,
3293   };
3294   $cust_credit->insert;
3295 }
3296
3297 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3298
3299 Creates a one-time charge for this customer.  If there is an error, returns
3300 the error, otherwise returns false.
3301
3302 =cut
3303
3304 sub charge {
3305   my ( $self, $amount ) = ( shift, shift );
3306   my $pkg      = @_ ? shift : 'One-time charge';
3307   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
3308   my $taxclass = @_ ? shift : '';
3309
3310   local $SIG{HUP} = 'IGNORE';
3311   local $SIG{INT} = 'IGNORE';
3312   local $SIG{QUIT} = 'IGNORE';
3313   local $SIG{TERM} = 'IGNORE';
3314   local $SIG{TSTP} = 'IGNORE';
3315   local $SIG{PIPE} = 'IGNORE';
3316
3317   my $oldAutoCommit = $FS::UID::AutoCommit;
3318   local $FS::UID::AutoCommit = 0;
3319   my $dbh = dbh;
3320
3321   my $part_pkg = new FS::part_pkg ( {
3322     'pkg'      => $pkg,
3323     'comment'  => $comment,
3324     #'setup'    => $amount,
3325     #'recur'    => '0',
3326     'plan'     => 'flat',
3327     'plandata' => "setup_fee=$amount",
3328     'freq'     => 0,
3329     'disabled' => 'Y',
3330     'taxclass' => $taxclass,
3331   } );
3332
3333   my $error = $part_pkg->insert;
3334   if ( $error ) {
3335     $dbh->rollback if $oldAutoCommit;
3336     return $error;
3337   }
3338
3339   my $pkgpart = $part_pkg->pkgpart;
3340   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3341   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3342     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3343     $error = $type_pkgs->insert;
3344     if ( $error ) {
3345       $dbh->rollback if $oldAutoCommit;
3346       return $error;
3347     }
3348   }
3349
3350   my $cust_pkg = new FS::cust_pkg ( {
3351     'custnum' => $self->custnum,
3352     'pkgpart' => $pkgpart,
3353   } );
3354
3355   $error = $cust_pkg->insert;
3356   if ( $error ) {
3357     $dbh->rollback if $oldAutoCommit;
3358     return $error;
3359   }
3360
3361   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3362   '';
3363
3364 }
3365
3366 =item cust_bill
3367
3368 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3369
3370 =cut
3371
3372 sub cust_bill {
3373   my $self = shift;
3374   sort { $a->_date <=> $b->_date }
3375     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3376 }
3377
3378 =item open_cust_bill
3379
3380 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3381 customer.
3382
3383 =cut
3384
3385 sub open_cust_bill {
3386   my $self = shift;
3387   grep { $_->owed > 0 } $self->cust_bill;
3388 }
3389
3390 =item cust_credit
3391
3392 Returns all the credits (see L<FS::cust_credit>) for this customer.
3393
3394 =cut
3395
3396 sub cust_credit {
3397   my $self = shift;
3398   sort { $a->_date <=> $b->_date }
3399     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3400 }
3401
3402 =item cust_pay
3403
3404 Returns all the payments (see L<FS::cust_pay>) for this customer.
3405
3406 =cut
3407
3408 sub cust_pay {
3409   my $self = shift;
3410   sort { $a->_date <=> $b->_date }
3411     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3412 }
3413
3414 =item cust_pay_void
3415
3416 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3417
3418 =cut
3419
3420 sub cust_pay_void {
3421   my $self = shift;
3422   sort { $a->_date <=> $b->_date }
3423     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3424 }
3425
3426
3427 =item cust_refund
3428
3429 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3430
3431 =cut
3432
3433 sub cust_refund {
3434   my $self = shift;
3435   sort { $a->_date <=> $b->_date }
3436     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3437 }
3438
3439 =item select_for_update
3440
3441 Selects this record with the SQL "FOR UPDATE" command.  This can be useful as
3442 a mutex.
3443
3444 =cut
3445
3446 sub select_for_update {
3447   my $self = shift;
3448   qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
3449 }
3450
3451 =item name
3452
3453 Returns a name string for this customer, either "Company (Last, First)" or
3454 "Last, First".
3455
3456 =cut
3457
3458 sub name {
3459   my $self = shift;
3460   my $name = $self->contact;
3461   $name = $self->company. " ($name)" if $self->company;
3462   $name;
3463 }
3464
3465 =item ship_name
3466
3467 Returns a name string for this (service/shipping) contact, either
3468 "Company (Last, First)" or "Last, First".
3469
3470 =cut
3471
3472 sub ship_name {
3473   my $self = shift;
3474   if ( $self->get('ship_last') ) {
3475     my $name = $self->ship_contact;
3476     $name = $self->ship_company. " ($name)" if $self->ship_company;
3477     $name;
3478   } else {
3479     $self->name;
3480   }
3481 }
3482
3483 =item contact
3484
3485 Returns this customer's full (billing) contact name only, "Last, First"
3486
3487 =cut
3488
3489 sub contact {
3490   my $self = shift;
3491   $self->get('last'). ', '. $self->first;
3492 }
3493
3494 =item ship_contact
3495
3496 Returns this customer's full (shipping) contact name only, "Last, First"
3497
3498 =cut
3499
3500 sub ship_contact {
3501   my $self = shift;
3502   $self->get('ship_last')
3503     ? $self->get('ship_last'). ', '. $self->ship_first
3504     : $self->contact;
3505 }
3506
3507 =item status
3508
3509 Returns a status string for this customer, currently:
3510
3511 =over 4
3512
3513 =item prospect - No packages have ever been ordered
3514
3515 =item active - One or more recurring packages is active
3516
3517 =item suspended - All non-cancelled recurring packages are suspended
3518
3519 =item cancelled - All recurring packages are cancelled
3520
3521 =back
3522
3523 =cut
3524
3525 sub status {
3526   my $self = shift;
3527   for my $status (qw( prospect active suspended cancelled )) {
3528     my $method = $status.'_sql';
3529     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3530     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3531     $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
3532     return $status if $sth->fetchrow_arrayref->[0];
3533   }
3534 }
3535
3536 =item statuscolor
3537
3538 Returns a hex triplet color string for this customer's status.
3539
3540 =cut
3541
3542 my %statuscolor = (
3543   'prospect'  => '000000',
3544   'active'    => '00CC00',
3545   'suspended' => 'FF9900',
3546   'cancelled' => 'FF0000',
3547 );
3548 sub statuscolor {
3549   my $self = shift;
3550   $statuscolor{$self->status};
3551 }
3552
3553 =back
3554
3555 =head1 CLASS METHODS
3556
3557 =over 4
3558
3559 =item prospect_sql
3560
3561 Returns an SQL expression identifying prospective cust_main records (customers
3562 with no packages ever ordered)
3563
3564 =cut
3565
3566 sub prospect_sql { "
3567   0 = ( SELECT COUNT(*) FROM cust_pkg
3568           WHERE cust_pkg.custnum = cust_main.custnum
3569       )
3570 "; }
3571
3572 =item active_sql
3573
3574 Returns an SQL expression identifying active cust_main records.
3575
3576 =cut
3577
3578 sub active_sql { "
3579   0 < ( SELECT COUNT(*) FROM cust_pkg
3580           WHERE cust_pkg.custnum = cust_main.custnum
3581             AND ". FS::cust_pkg->active_sql. "
3582       )
3583 "; }
3584
3585 =item susp_sql
3586 =item suspended_sql
3587
3588 Returns an SQL expression identifying suspended cust_main records.
3589
3590 =cut
3591
3592 #my $recurring_sql = FS::cust_pkg->recurring_sql;
3593 my $recurring_sql = "
3594   '0' != ( select freq from part_pkg
3595              where cust_pkg.pkgpart = part_pkg.pkgpart )
3596 ";
3597
3598 sub suspended_sql { susp_sql(@_); }
3599 sub susp_sql { "
3600     0 < ( SELECT COUNT(*) FROM cust_pkg
3601             WHERE cust_pkg.custnum = cust_main.custnum
3602               AND $recurring_sql
3603               AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3604         )
3605     AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3606                 WHERE cust_pkg.custnum = cust_main.custnum
3607                   AND ". FS::cust_pkg->active_sql. "
3608             )
3609 "; }
3610
3611 =item cancel_sql
3612 =item cancelled_sql
3613
3614 Returns an SQL expression identifying cancelled cust_main records.
3615
3616 =cut
3617
3618 sub cancelled_sql { cancel_sql(@_); }
3619 sub cancel_sql { "
3620   0 < ( SELECT COUNT(*) FROM cust_pkg
3621           WHERE cust_pkg.custnum = cust_main.custnum
3622       )
3623   AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3624               WHERE cust_pkg.custnum = cust_main.custnum
3625                 AND $recurring_sql
3626                 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3627           )
3628 "; }
3629
3630 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3631
3632 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3633 records.  Currently, only I<last> or I<company> may be specified (the
3634 appropriate ship_ field is also searched if applicable).
3635
3636 Additional options are the same as FS::Record::qsearch
3637
3638 =cut
3639
3640 sub fuzzy_search {
3641   my( $self, $fuzzy, $hash, @opt) = @_;
3642   #$self
3643   $hash ||= {};
3644   my @cust_main = ();
3645
3646   check_and_rebuild_fuzzyfiles();
3647   foreach my $field ( keys %$fuzzy ) {
3648     my $sub = \&{"all_$field"};
3649     my %match = ();
3650     $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
3651
3652     foreach ( keys %match ) {
3653       push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3654       push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
3655         if defined dbdef->table('cust_main')->column('ship_last');
3656     }
3657   }
3658
3659   my %saw = ();
3660   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
3661
3662   @cust_main;
3663
3664 }
3665
3666 =back
3667
3668 =head1 SUBROUTINES
3669
3670 =over 4
3671
3672 =item smart_search OPTION => VALUE ...
3673
3674 Accepts the following options: I<search>, the string to search for.  The string
3675 will be searched for as a customer number, last name or company name, first
3676 searching for an exact match then fuzzy and substring matches.
3677
3678 Any additional options treated as an additional qualifier on the search
3679 (i.e. I<agentnum>).
3680
3681 Returns a (possibly empty) array of FS::cust_main objects.
3682
3683 =cut
3684
3685 sub smart_search {
3686   my %options = @_;
3687   my $search = delete $options{'search'};
3688   my @cust_main = ();
3689
3690   if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3691
3692     push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } );
3693
3694   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3695
3696     my $value = lc($1);
3697     my $q_value = dbh->quote($value);
3698
3699     #exact
3700     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3701     $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3702     $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3703       if defined dbdef->table('cust_main')->column('ship_last');
3704     $sql .= ' )';
3705
3706     push @cust_main, qsearch( 'cust_main', \%options, '', $sql );
3707
3708     unless ( @cust_main ) {  #no exact match, trying substring/fuzzy
3709
3710       #still some false laziness w/ search/cust_main.cgi
3711
3712       #substring
3713       push @cust_main, qsearch( 'cust_main',
3714                                 { 'last'     => { 'op'    => 'ILIKE',
3715                                                   'value' => "%$q_value%" },
3716                                   %options,
3717                                 }
3718                               );
3719       push @cust_main, qsearch( 'cust_main',
3720                                 { 'ship_last' => { 'op'    => 'ILIKE',
3721                                                    'value' => "%$q_value%" },
3722                                   %options,
3723
3724                                 }
3725                               )
3726         if defined dbdef->table('cust_main')->column('ship_last');
3727
3728       push @cust_main, qsearch( 'cust_main',
3729                                 { 'company'  => { 'op'    => 'ILIKE',
3730                                                   'value' => "%$q_value%" },
3731                                   %options,
3732                                 }
3733                               );
3734       push @cust_main, qsearch( 'cust_main',
3735                                 { 'ship_company' => { 'op' => 'ILIKE',
3736                                                    'value' => "%$q_value%" },
3737                                   %options,
3738                                 }
3739                               )
3740         if defined dbdef->table('cust_main')->column('ship_last');
3741
3742       #fuzzy
3743       push @cust_main, FS::cust_main->fuzzy_search(
3744         { 'last'     => $value },
3745         \%options,
3746       );
3747       push @cust_main, FS::cust_main->fuzzy_search(
3748         { 'company'  => $value },
3749         \%options,
3750       );
3751
3752     }
3753
3754   }
3755
3756   @cust_main;
3757
3758 }
3759
3760 =item check_and_rebuild_fuzzyfiles
3761
3762 =cut
3763
3764 sub check_and_rebuild_fuzzyfiles {
3765   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3766   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3767     or &rebuild_fuzzyfiles;
3768 }
3769
3770 =item rebuild_fuzzyfiles
3771
3772 =cut
3773
3774 sub rebuild_fuzzyfiles {
3775
3776   use Fcntl qw(:flock);
3777
3778   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3779
3780   #last
3781
3782   open(LASTLOCK,">>$dir/cust_main.last")
3783     or die "can't open $dir/cust_main.last: $!";
3784   flock(LASTLOCK,LOCK_EX)
3785     or die "can't lock $dir/cust_main.last: $!";
3786
3787   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3788   push @all_last,
3789                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3790     if defined dbdef->table('cust_main')->column('ship_last');
3791
3792   open (LASTCACHE,">$dir/cust_main.last.tmp")
3793     or die "can't open $dir/cust_main.last.tmp: $!";
3794   print LASTCACHE join("\n", @all_last), "\n";
3795   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3796
3797   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3798   close LASTLOCK;
3799
3800   #company
3801
3802   open(COMPANYLOCK,">>$dir/cust_main.company")
3803     or die "can't open $dir/cust_main.company: $!";
3804   flock(COMPANYLOCK,LOCK_EX)
3805     or die "can't lock $dir/cust_main.company: $!";
3806
3807   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3808   push @all_company,
3809        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3810     if defined dbdef->table('cust_main')->column('ship_last');
3811
3812   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3813     or die "can't open $dir/cust_main.company.tmp: $!";
3814   print COMPANYCACHE join("\n", @all_company), "\n";
3815   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3816
3817   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3818   close COMPANYLOCK;
3819
3820 }
3821
3822 =item all_last
3823
3824 =cut
3825
3826 sub all_last {
3827   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3828   open(LASTCACHE,"<$dir/cust_main.last")
3829     or die "can't open $dir/cust_main.last: $!";
3830   my @array = map { chomp; $_; } <LASTCACHE>;
3831   close LASTCACHE;
3832   \@array;
3833 }
3834
3835 =item all_company
3836
3837 =cut
3838
3839 sub all_company {
3840   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3841   open(COMPANYCACHE,"<$dir/cust_main.company")
3842     or die "can't open $dir/cust_main.last: $!";
3843   my @array = map { chomp; $_; } <COMPANYCACHE>;
3844   close COMPANYCACHE;
3845   \@array;
3846 }
3847
3848 =item append_fuzzyfiles LASTNAME COMPANY
3849
3850 =cut
3851
3852 sub append_fuzzyfiles {
3853   my( $last, $company ) = @_;
3854
3855   &check_and_rebuild_fuzzyfiles;
3856
3857   use Fcntl qw(:flock);
3858
3859   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3860
3861   if ( $last ) {
3862
3863     open(LAST,">>$dir/cust_main.last")
3864       or die "can't open $dir/cust_main.last: $!";
3865     flock(LAST,LOCK_EX)
3866       or die "can't lock $dir/cust_main.last: $!";
3867
3868     print LAST "$last\n";
3869
3870     flock(LAST,LOCK_UN)
3871       or die "can't unlock $dir/cust_main.last: $!";
3872     close LAST;
3873   }
3874
3875   if ( $company ) {
3876
3877     open(COMPANY,">>$dir/cust_main.company")
3878       or die "can't open $dir/cust_main.company: $!";
3879     flock(COMPANY,LOCK_EX)
3880       or die "can't lock $dir/cust_main.company: $!";
3881
3882     print COMPANY "$company\n";
3883
3884     flock(COMPANY,LOCK_UN)
3885       or die "can't unlock $dir/cust_main.company: $!";
3886
3887     close COMPANY;
3888   }
3889
3890   1;
3891 }
3892
3893 =item batch_import
3894
3895 =cut
3896
3897 sub batch_import {
3898   my $param = shift;
3899   #warn join('-',keys %$param);
3900   my $fh = $param->{filehandle};
3901   my $agentnum = $param->{agentnum};
3902   my $refnum = $param->{refnum};
3903   my $pkgpart = $param->{pkgpart};
3904   my @fields = @{$param->{fields}};
3905
3906   eval "use Date::Parse;";
3907   die $@ if $@;
3908   eval "use Text::CSV_XS;";
3909   die $@ if $@;
3910
3911   my $csv = new Text::CSV_XS;
3912   #warn $csv;
3913   #warn $fh;
3914
3915   my $imported = 0;
3916   #my $columns;
3917
3918   local $SIG{HUP} = 'IGNORE';
3919   local $SIG{INT} = 'IGNORE';
3920   local $SIG{QUIT} = 'IGNORE';
3921   local $SIG{TERM} = 'IGNORE';
3922   local $SIG{TSTP} = 'IGNORE';
3923   local $SIG{PIPE} = 'IGNORE';
3924
3925   my $oldAutoCommit = $FS::UID::AutoCommit;
3926   local $FS::UID::AutoCommit = 0;
3927   my $dbh = dbh;
3928
3929   #while ( $columns = $csv->getline($fh) ) {
3930   my $line;
3931   while ( defined($line=<$fh>) ) {
3932
3933     $csv->parse($line) or do {
3934       $dbh->rollback if $oldAutoCommit;
3935       return "can't parse: ". $csv->error_input();
3936     };
3937
3938     my @columns = $csv->fields();
3939     #warn join('-',@columns);
3940
3941     my %cust_main = (
3942       agentnum => $agentnum,
3943       refnum   => $refnum,
3944       country  => $conf->config('countrydefault') || 'US',
3945       payby    => 'BILL', #default
3946       paydate  => '12/2037', #default
3947     );
3948     my $billtime = time;
3949     my %cust_pkg = ( pkgpart => $pkgpart );
3950     foreach my $field ( @fields ) {
3951       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
3952         #$cust_pkg{$1} = str2time( shift @$columns );
3953         if ( $1 eq 'setup' ) {
3954           $billtime = str2time(shift @columns);
3955         } else {
3956           $cust_pkg{$1} = str2time( shift @columns );
3957         }
3958       } else {
3959         #$cust_main{$field} = shift @$columns;
3960         $cust_main{$field} = shift @columns;
3961       }
3962     }
3963
3964     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
3965     my $cust_main = new FS::cust_main ( \%cust_main );
3966     use Tie::RefHash;
3967     tie my %hash, 'Tie::RefHash'; #this part is important
3968     $hash{$cust_pkg} = [] if $pkgpart;
3969     my $error = $cust_main->insert( \%hash );
3970
3971     if ( $error ) {
3972       $dbh->rollback if $oldAutoCommit;
3973       return "can't insert customer for $line: $error";
3974     }
3975
3976     #false laziness w/bill.cgi
3977     $error = $cust_main->bill( 'time' => $billtime );
3978     if ( $error ) {
3979       $dbh->rollback if $oldAutoCommit;
3980       return "can't bill customer for $line: $error";
3981     }
3982
3983     $cust_main->apply_payments;
3984     $cust_main->apply_credits;
3985
3986     $error = $cust_main->collect();
3987     if ( $error ) {
3988       $dbh->rollback if $oldAutoCommit;
3989       return "can't collect customer for $line: $error";
3990     }
3991
3992     $imported++;
3993   }
3994
3995   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3996
3997   return "Empty file!" unless $imported;
3998
3999   ''; #no error
4000
4001 }
4002
4003 =item batch_charge
4004
4005 =cut
4006
4007 sub batch_charge {
4008   my $param = shift;
4009   #warn join('-',keys %$param);
4010   my $fh = $param->{filehandle};
4011   my @fields = @{$param->{fields}};
4012
4013   eval "use Date::Parse;";
4014   die $@ if $@;
4015   eval "use Text::CSV_XS;";
4016   die $@ if $@;
4017
4018   my $csv = new Text::CSV_XS;
4019   #warn $csv;
4020   #warn $fh;
4021
4022   my $imported = 0;
4023   #my $columns;
4024
4025   local $SIG{HUP} = 'IGNORE';
4026   local $SIG{INT} = 'IGNORE';
4027   local $SIG{QUIT} = 'IGNORE';
4028   local $SIG{TERM} = 'IGNORE';
4029   local $SIG{TSTP} = 'IGNORE';
4030   local $SIG{PIPE} = 'IGNORE';
4031
4032   my $oldAutoCommit = $FS::UID::AutoCommit;
4033   local $FS::UID::AutoCommit = 0;
4034   my $dbh = dbh;
4035
4036   #while ( $columns = $csv->getline($fh) ) {
4037   my $line;
4038   while ( defined($line=<$fh>) ) {
4039
4040     $csv->parse($line) or do {
4041       $dbh->rollback if $oldAutoCommit;
4042       return "can't parse: ". $csv->error_input();
4043     };
4044
4045     my @columns = $csv->fields();
4046     #warn join('-',@columns);
4047
4048     my %row = ();
4049     foreach my $field ( @fields ) {
4050       $row{$field} = shift @columns;
4051     }
4052
4053     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
4054     unless ( $cust_main ) {
4055       $dbh->rollback if $oldAutoCommit;
4056       return "unknown custnum $row{'custnum'}";
4057     }
4058
4059     if ( $row{'amount'} > 0 ) {
4060       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4061       if ( $error ) {
4062         $dbh->rollback if $oldAutoCommit;
4063         return $error;
4064       }
4065       $imported++;
4066     } elsif ( $row{'amount'} < 0 ) {
4067       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4068                                       $row{'pkg'}                         );
4069       if ( $error ) {
4070         $dbh->rollback if $oldAutoCommit;
4071         return $error;
4072       }
4073       $imported++;
4074     } else {
4075       #hmm?
4076     }
4077
4078   }
4079
4080   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4081
4082   return "Empty file!" unless $imported;
4083
4084   ''; #no error
4085
4086 }
4087
4088 =back
4089
4090 =head1 BUGS
4091
4092 The delete method.
4093
4094 The delete method should possibly take an FS::cust_main object reference
4095 instead of a scalar customer number.
4096
4097 Bill and collect options should probably be passed as references instead of a
4098 list.
4099
4100 There should probably be a configuration file with a list of allowed credit
4101 card types.
4102
4103 No multiple currency support (probably a larger project than just this module).
4104
4105 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4106
4107 =head1 SEE ALSO
4108
4109 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4110 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4111 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
4112
4113 =cut
4114
4115 1;
4116