FS/FS/cust_main.pm

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