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::Parse;
  20 #use Date::Manip;
  21 use String::Approx qw(amatch);
  22 use Business::CreditCard 0.28;
  23 use FS::UID qw( getotaker dbh );
  24 use FS::Record qw( qsearchs qsearch dbdef );
  25 use FS::Misc qw( send_email );
  26 use FS::Msgcat qw(gettext);
  27 use FS::cust_pkg;
  28 use FS::cust_svc;
  29 use FS::cust_bill;
  30 use FS::cust_bill_pkg;
  31 use FS::cust_pay;
  32 use FS::cust_pay_void;
  33 use FS::cust_credit;
  34 use FS::cust_refund;
  35 use FS::part_referral;
  36 use FS::cust_main_county;
  37 use FS::agent;
  38 use FS::cust_main_invoice;
  39 use FS::cust_credit_bill;
  40 use FS::cust_bill_pay;
  41 use FS::prepay_credit;
  42 use FS::queue;
  43 use FS::part_pkg;
  44 use FS::part_bill_event;
  45 use FS::cust_bill_event;
  46 use FS::cust_tax_exempt;
  47 use FS::cust_tax_exempt_pkg;
  48 use FS::type_pkgs;
  49 use FS::payment_gateway;
  50 use FS::agent_payment_gateway;
  51 use FS::banned_pay;
  52
  53 @ISA = qw( FS::Record );
  54
  55 @EXPORT_OK = qw( smart_search );
  56
  57 $realtime_bop_decline_quiet = 0;
  58
  59 # 1 is mostly method/subroutine entry and options
  60 # 2 traces progress of some operations
  61 # 3 is even more information including possibly sensitive data
  62 $DEBUG = 0;
  63 $me = '[FS::cust_main]';
  64
  65 $import = 0;
  66 $skip_fuzzyfiles = 0;
  67 $ignore_expired_card = 0;
  68
  69 @encrypted_fields = ('payinfo', 'paycvv');
  70
  71 #ask FS::UID to run this stuff for us later
  72 #$FS::UID::callback{'FS::cust_main'} = sub {
  73 install_callback FS::UID sub {
  74   $conf = new FS::Conf;
  75   #yes, need it for stuff below (prolly should be cached)
  76 };
  77
  78 sub _cache {
  79   my $self = shift;
  80   my ( $hashref, $cache ) = @_;
  81   if ( exists $hashref->{'pkgnum'} ) {
  82 #    #@{ $self->{'_pkgnum'} } = ();
  83     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
  84     $self->{'_pkgnum'} = $subcache;
  85     #push @{ $self->{'_pkgnum'} },
  86     FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
  87   }
  88 }
  89
  90 =head1 NAME
  91
  92 FS::cust_main - Object methods for cust_main records
  93
  94 =head1 SYNOPSIS
  95
  96   use FS::cust_main;
  97
  98   $record = new FS::cust_main \%hash;
  99   $record = new FS::cust_main { 'column' => 'value' };
 100
 101   $error = $record->insert;
 102
 103   $error = $new_record->replace($old_record);
 104
 105   $error = $record->delete;
 106
 107   $error = $record->check;
 108
 109   @cust_pkg = $record->all_pkgs;
 110
 111   @cust_pkg = $record->ncancelled_pkgs;
 112
 113   @cust_pkg = $record->suspended_pkgs;
 114
 115   $error = $record->bill;
 116   $error = $record->bill %options;
 117   $error = $record->bill 'time' => $time;
 118
 119   $error = $record->collect;
 120   $error = $record->collect %options;
 121   $error = $record->collect 'invoice_time'   => $time,
 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
1464 Returns a list: an empty list on success or a list of errors.
1465
1466 =cut
1467
1468 sub suspend {
1469   my $self = shift;
1470   grep { $_->suspend } $self->unsuspended_pkgs;
1471 }
1472
1473 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1474
1475 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1476 PKGPARTs (see L<FS::part_pkg>).
1477
1478 Returns a list: an empty list on success or a list of errors.
1479
1480 =cut
1481
1482 sub suspend_if_pkgpart {
1483   my $self = shift;
1484   my @pkgparts = @_;
1485   grep { $_->suspend }
1486     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1487       $self->unsuspended_pkgs;
1488 }
1489
1490 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1491
1492 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1493 listed PKGPARTs (see L<FS::part_pkg>).
1494
1495 Returns a list: an empty list on success or a list of errors.
1496
1497 =cut
1498
1499 sub suspend_unless_pkgpart {
1500   my $self = shift;
1501   my @pkgparts = @_;
1502   grep { $_->suspend }
1503     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1504       $self->unsuspended_pkgs;
1505 }
1506
1507 =item cancel [ OPTION => VALUE ... ]
1508
1509 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1510
1511 Available options are: I<quiet>, I<reasonnum>, and I<ban>
1512
1513 I<quiet> can be set true to supress email cancellation notices.
1514
1515 # I<reasonnum> can be set to a cancellation reason (see L<FS::cancel_reason>)
1516
1517 I<ban> can be set true to ban this customer's credit card or ACH information,
1518 if present.
1519
1520 Always returns a list: an empty list on success or a list of errors.
1521
1522 =cut
1523
1524 sub cancel {
1525   my $self = shift;
1526   my %opt = @_;
1527
1528   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1529
1530     #should try decryption (we might have the private key)
1531     # and if not maybe queue a job for the server that does?
1532     return ( "Can't (yet) ban encrypted credit cards" )
1533       if $self->is_encrypted($self->payinfo);
1534
1535     my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1536     my $error = $ban->insert;
1537     return ( $error ) if $error;
1538
1539   }
1540
1541   grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1542 }
1543
1544 sub _banned_pay_hashref {
1545   my $self = shift;
1546
1547   my %payby2ban = (
1548     'CARD' => 'CARD',
1549     'DCRD' => 'CARD',
1550     'CHEK' => 'CHEK',
1551     'DCHK' => 'CHEK'
1552   );
1553
1554   {
1555     'payby'   => $payby2ban{$self->payby},
1556     'payinfo' => md5_base64($self->payinfo),
1557     #'reason'  =>
1558   };
1559 }
1560
1561 =item agent
1562
1563 Returns the agent (see L<FS::agent>) for this customer.
1564
1565 =cut
1566
1567 sub agent {
1568   my $self = shift;
1569   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1570 }
1571
1572 =item bill OPTIONS
1573
1574 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
1575 conjunction with the collect method.
1576
1577 Options are passed as name-value pairs.
1578
1579 Currently available options are:
1580
1581 resetup - if set true, re-charges setup fees.
1582
1583 time - bills the customer as if it were that time.  Specified as a UNIX
1584 timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and
1585 L<Date::Parse> for conversion functions.  For example:
1586
1587  use Date::Parse;
1588  ...
1589  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1590
1591
1592 If there is an error, returns the error, otherwise returns false.
1593
1594 =cut
1595
1596 sub bill {
1597   my( $self, %options ) = @_;
1598   return '' if $self->payby eq 'COMP';
1599   warn "$me bill customer ". $self->custnum. "\n"
1600     if $DEBUG;
1601
1602   my $time = $options{'time'} || time;
1603
1604   my $error;
1605
1606   #put below somehow?
1607   local $SIG{HUP} = 'IGNORE';
1608   local $SIG{INT} = 'IGNORE';
1609   local $SIG{QUIT} = 'IGNORE';
1610   local $SIG{TERM} = 'IGNORE';
1611   local $SIG{TSTP} = 'IGNORE';
1612   local $SIG{PIPE} = 'IGNORE';
1613
1614   my $oldAutoCommit = $FS::UID::AutoCommit;
1615   local $FS::UID::AutoCommit = 0;
1616   my $dbh = dbh;
1617
1618   $self->select_for_update; #mutex
1619
1620   #create a new invoice
1621   #(we'll remove it later if it doesn't actually need to be generated [contains
1622   # no line items] and we're inside a transaciton so nothing else will see it)
1623   my $cust_bill = new FS::cust_bill ( {
1624     'custnum' => $self->custnum,
1625     '_date'   => $time,
1626     #'charged' => $charged,
1627     'charged' => 0,
1628   } );
1629   $error = $cust_bill->insert;
1630   if ( $error ) {
1631     $dbh->rollback if $oldAutoCommit;
1632     return "can't create invoice for customer #". $self->custnum. ": $error";
1633   }
1634   my $invnum = $cust_bill->invnum;
1635
1636   ###
1637   # find the packages which are due for billing, find out how much they are
1638   # & generate invoice database.
1639   ###
1640
1641   my( $total_setup, $total_recur ) = ( 0, 0 );
1642   my %tax;
1643
1644   foreach my $cust_pkg (
1645     qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1646   ) {
1647
1648     #NO!! next if $cust_pkg->cancel;
1649     next if $cust_pkg->getfield('cancel');
1650
1651     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
1652
1653     #? to avoid use of uninitialized value errors... ?
1654     $cust_pkg->setfield('bill', '')
1655       unless defined($cust_pkg->bill);
1656
1657     my $part_pkg = $cust_pkg->part_pkg;
1658
1659     my %hash = $cust_pkg->hash;
1660     my $old_cust_pkg = new FS::cust_pkg \%hash;
1661
1662     my @details = ();
1663
1664     ###
1665     # bill setup
1666     ###
1667
1668     my $setup = 0;
1669     if ( !$cust_pkg->setup || $options{'resetup'} ) {
1670
1671       warn "    bill setup\n" if $DEBUG > 1;
1672
1673       $setup = eval { $cust_pkg->calc_setup( $time ) };
1674       if ( $@ ) {
1675         $dbh->rollback if $oldAutoCommit;
1676         return $@;
1677       }
1678
1679       $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1680     }
1681
1682     ###
1683     # bill recurring fee
1684     ###
1685
1686     my $recur = 0;
1687     my $sdate;
1688     if ( $part_pkg->getfield('freq') ne '0' &&
1689          ! $cust_pkg->getfield('susp') &&
1690          ( $cust_pkg->getfield('bill') || 0 ) <= $time
1691     ) {
1692
1693       warn "    bill recur\n" if $DEBUG > 1;
1694
1695       # XXX shared with $recur_prog
1696       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1697
1698       $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details ) };
1699       if ( $@ ) {
1700         $dbh->rollback if $oldAutoCommit;
1701         return $@;
1702       }
1703
1704       #change this bit to use Date::Manip? CAREFUL with timezones (see
1705       # mailing list archive)
1706       my ($sec,$min,$hour,$mday,$mon,$year) =
1707         (localtime($sdate) )[0,1,2,3,4,5];
1708
1709       #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1710       # only for figuring next bill date, nothing else, so, reset $sdate again
1711       # here
1712       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1713       $cust_pkg->last_bill($sdate)
1714         if $cust_pkg->dbdef_table->column('last_bill');
1715
1716       if ( $part_pkg->freq =~ /^\d+$/ ) {
1717         $mon += $part_pkg->freq;
1718         until ( $mon < 12 ) { $mon -= 12; $year++; }
1719       } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1720         my $weeks = $1;
1721         $mday += $weeks * 7;
1722       } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1723         my $days = $1;
1724         $mday += $days;
1725       } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
1726         my $hours = $1;
1727         $hour += $hours;
1728       } else {
1729         $dbh->rollback if $oldAutoCommit;
1730         return "unparsable frequency: ". $part_pkg->freq;
1731       }
1732       $cust_pkg->setfield('bill',
1733         timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1734     }
1735
1736     warn "\$setup is undefined" unless defined($setup);
1737     warn "\$recur is undefined" unless defined($recur);
1738     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1739
1740     ###
1741     # If $cust_pkg has been modified, update it and create cust_bill_pkg records
1742     ###
1743
1744     if ( $cust_pkg->modified ) {
1745
1746       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
1747         if $DEBUG >1;
1748
1749       $error=$cust_pkg->replace($old_cust_pkg);
1750       if ( $error ) { #just in case
1751         $dbh->rollback if $oldAutoCommit;
1752         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1753       }
1754
1755       $setup = sprintf( "%.2f", $setup );
1756       $recur = sprintf( "%.2f", $recur );
1757       if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1758         $dbh->rollback if $oldAutoCommit;
1759         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1760       }
1761       if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1762         $dbh->rollback if $oldAutoCommit;
1763         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1764       }
1765
1766       if ( $setup != 0 || $recur != 0 ) {
1767
1768         warn "    charges (setup=$setup, recur=$recur); adding line items\n"
1769           if $DEBUG > 1;
1770         my $cust_bill_pkg = new FS::cust_bill_pkg ({
1771           'invnum'  => $invnum,
1772           'pkgnum'  => $cust_pkg->pkgnum,
1773           'setup'   => $setup,
1774           'recur'   => $recur,
1775           'sdate'   => $sdate,
1776           'edate'   => $cust_pkg->bill,
1777           'details' => \@details,
1778         });
1779         $error = $cust_bill_pkg->insert;
1780         if ( $error ) {
1781           $dbh->rollback if $oldAutoCommit;
1782           return "can't create invoice line item for invoice #$invnum: $error";
1783         }
1784         $total_setup += $setup;
1785         $total_recur += $recur;
1786
1787         ###
1788         # handle taxes
1789         ###
1790
1791         unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1792
1793           my @taxes = qsearch( 'cust_main_county', {
1794                                  'state'    => $self->state,
1795                                  'county'   => $self->county,
1796                                  'country'  => $self->country,
1797                                  'taxclass' => $part_pkg->taxclass,
1798                                                                       } );
1799           unless ( @taxes ) {
1800             @taxes =  qsearch( 'cust_main_county', {
1801                                   'state'    => $self->state,
1802                                   'county'   => $self->county,
1803                                   'country'  => $self->country,
1804                                   'taxclass' => '',
1805                                                                       } );
1806           }
1807
1808           #one more try at a whole-country tax rate
1809           unless ( @taxes ) {
1810             @taxes =  qsearch( 'cust_main_county', {
1811                                   'state'    => '',
1812                                   'county'   => '',
1813                                   'country'  => $self->country,
1814                                   'taxclass' => '',
1815                                                                       } );
1816           }
1817
1818           # maybe eliminate this entirely, along with all the 0% records
1819           unless ( @taxes ) {
1820             $dbh->rollback if $oldAutoCommit;
1821             return
1822               "fatal: can't find tax rate for state/county/country/taxclass ".
1823               join('/', ( map $self->$_(), qw(state county country) ),
1824                         $part_pkg->taxclass ).  "\n";
1825           }
1826
1827           foreach my $tax ( @taxes ) {
1828
1829             my $taxable_charged = 0;
1830             $taxable_charged += $setup
1831               unless $part_pkg->setuptax =~ /^Y$/i
1832                   || $tax->setuptax =~ /^Y$/i;
1833             $taxable_charged += $recur
1834               unless $part_pkg->recurtax =~ /^Y$/i
1835                   || $tax->recurtax =~ /^Y$/i;
1836             next unless $taxable_charged;
1837
1838             if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
1839               #my ($mon,$year) = (localtime($sdate) )[4,5];
1840               my ($mon,$year) = (localtime( $sdate || $cust_bill->_date ) )[4,5];
1841               $mon++;
1842               my $freq = $part_pkg->freq || 1;
1843               if ( $freq !~ /(\d+)$/ ) {
1844                 $dbh->rollback if $oldAutoCommit;
1845                 return "daily/weekly package definitions not (yet?)".
1846                        " compatible with monthly tax exemptions";
1847               }
1848               my $taxable_per_month =
1849                 sprintf("%.2f", $taxable_charged / $freq );
1850
1851               #call the whole thing off if this customer has any old
1852               #exemption records...
1853               my @cust_tax_exempt =
1854                 qsearch( 'cust_tax_exempt' => { custnum=> $self->custnum } );
1855               if ( @cust_tax_exempt ) {
1856                 $dbh->rollback if $oldAutoCommit;
1857                 return
1858                   'this customer still has old-style tax exemption records; '.
1859                   'run bin/fs-migrate-cust_tax_exempt?';
1860               }
1861
1862               foreach my $which_month ( 1 .. $freq ) {
1863
1864                 #maintain the new exemption table now
1865                 my $sql = "
1866                   SELECT SUM(amount)
1867                     FROM cust_tax_exempt_pkg
1868                       LEFT JOIN cust_bill_pkg USING ( billpkgnum )
1869                       LEFT JOIN cust_bill     USING ( invnum     )
1870                     WHERE custnum = ?
1871                       AND taxnum  = ?
1872                       AND year    = ?
1873                       AND month   = ?
1874                 ";
1875                 my $sth = dbh->prepare($sql) or do {
1876                   $dbh->rollback if $oldAutoCommit;
1877                   return "fatal: can't lookup exising exemption: ". dbh->errstr;
1878                 };
1879                 $sth->execute(
1880                   $self->custnum,
1881                   $tax->taxnum,
1882                   1900+$year,
1883                   $mon,
1884                 ) or do {
1885                   $dbh->rollback if $oldAutoCommit;
1886                   return "fatal: can't lookup exising exemption: ". dbh->errstr;
1887                 };
1888                 my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0;
1889
1890                 my $remaining_exemption =
1891                   $tax->exempt_amount - $existing_exemption;
1892                 if ( $remaining_exemption > 0 ) {
1893                   my $addl = $remaining_exemption > $taxable_per_month
1894                     ? $taxable_per_month
1895                     : $remaining_exemption;
1896                   $taxable_charged -= $addl;
1897
1898                   my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( {
1899                     'billpkgnum' => $cust_bill_pkg->billpkgnum,
1900                     'taxnum'     => $tax->taxnum,
1901                     'year'       => 1900+$year,
1902                     'month'      => $mon,
1903                     'amount'     => sprintf("%.2f", $addl ),
1904                   } );
1905                   $error = $cust_tax_exempt_pkg->insert;
1906                   if ( $error ) {
1907                     $dbh->rollback if $oldAutoCommit;
1908                     return "fatal: can't insert cust_tax_exempt_pkg: $error";
1909                   }
1910                 } # if $remaining_exemption > 0
1911
1912                 #++
1913                 $mon++;
1914                 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1915                 until ( $mon < 13 ) { $mon -= 12; $year++; }
1916
1917               } #foreach $which_month
1918
1919             } #if $tax->exempt_amount
1920
1921             $taxable_charged = sprintf( "%.2f", $taxable_charged);
1922
1923             #$tax += $taxable_charged * $cust_main_county->tax / 100
1924             $tax{ $tax->taxname || 'Tax' } +=
1925               $taxable_charged * $tax->tax / 100
1926
1927           } #foreach my $tax ( @taxes )
1928
1929         } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1930
1931       } #if $setup != 0 || $recur != 0
1932
1933     } #if $cust_pkg->modified
1934
1935   } #foreach my $cust_pkg
1936
1937   unless ( $cust_bill->cust_bill_pkg ) {
1938     $cust_bill->delete; #don't create an invoice w/o line items
1939     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1940     return '';
1941   }
1942
1943   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1944
1945   foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1946     my $tax = sprintf("%.2f", $tax{$taxname} );
1947     $charged = sprintf( "%.2f", $charged+$tax );
1948
1949     my $cust_bill_pkg = new FS::cust_bill_pkg ({
1950       'invnum'   => $invnum,
1951       'pkgnum'   => 0,
1952       'setup'    => $tax,
1953       'recur'    => 0,
1954       'sdate'    => '',
1955       'edate'    => '',
1956       'itemdesc' => $taxname,
1957     });
1958     $error = $cust_bill_pkg->insert;
1959     if ( $error ) {
1960       $dbh->rollback if $oldAutoCommit;
1961       return "can't create invoice line item for invoice #$invnum: $error";
1962     }
1963     $total_setup += $tax;
1964
1965   }
1966
1967   $cust_bill->charged( sprintf( "%.2f", $total_setup + $total_recur ) );
1968   $error = $cust_bill->replace;
1969   if ( $error ) {
1970     $dbh->rollback if $oldAutoCommit;
1971     return "can't update charged for invoice #$invnum: $error";
1972   }
1973
1974   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1975   ''; #no error
1976 }
1977
1978 =item collect OPTIONS
1979
1980 (Attempt to) collect money for this customer's outstanding invoices (see
1981 L<FS::cust_bill>).  Usually used after the bill method.
1982
1983 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1984 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1985 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1986
1987 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1988 and the invoice events web interface.
1989
1990 If there is an error, returns the error, otherwise returns false.
1991
1992 Options are passed as name-value pairs.
1993
1994 Currently available options are:
1995
1996 invoice_time - Use this time when deciding when to print invoices and
1997 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>
1998 for conversion functions.
1999
2000 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
2001 events.
2002
2003 quiet - set true to surpress email card/ACH decline notices.
2004
2005 freq - "1d" for the traditional, daily events (the default), or "1m" for the
2006 new monthly events
2007
2008 =cut
2009
2010 sub collect {
2011   my( $self, %options ) = @_;
2012   my $invoice_time = $options{'invoice_time'} || time;
2013
2014   #put below somehow?
2015   local $SIG{HUP} = 'IGNORE';
2016   local $SIG{INT} = 'IGNORE';
2017   local $SIG{QUIT} = 'IGNORE';
2018   local $SIG{TERM} = 'IGNORE';
2019   local $SIG{TSTP} = 'IGNORE';
2020   local $SIG{PIPE} = 'IGNORE';
2021
2022   my $oldAutoCommit = $FS::UID::AutoCommit;
2023   local $FS::UID::AutoCommit = 0;
2024   my $dbh = dbh;
2025
2026   $self->select_for_update; #mutex
2027
2028   my $balance = $self->balance;
2029   warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2030     if $DEBUG;
2031   unless ( $balance > 0 ) { #redundant?????
2032     $dbh->rollback if $oldAutoCommit; #hmm
2033     return '';
2034   }
2035
2036   if ( exists($options{'retry_card'}) ) {
2037     carp 'retry_card option passed to collect is deprecated; use retry';
2038     $options{'retry'} ||= $options{'retry_card'};
2039   }
2040   if ( exists($options{'retry'}) && $options{'retry'} ) {
2041     my $error = $self->retry_realtime;
2042     if ( $error ) {
2043       $dbh->rollback if $oldAutoCommit;
2044       return $error;
2045     }
2046   }
2047
2048   my $extra_sql = '';
2049   if ( defined $options{'freq'} && $options{'freq'} eq '1m' ) {
2050     $extra_sql = " AND freq = '1m' ";
2051   } else {
2052     $extra_sql = " AND ( freq = '1d' OR freq IS NULL OR freq = '' ) ";
2053   }
2054
2055   foreach my $cust_bill ( $self->open_cust_bill ) {
2056
2057     # don't try to charge for the same invoice if it's already in a batch
2058     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
2059
2060     last if $self->balance <= 0;
2061
2062     warn "  invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n"
2063       if $DEBUG > 1;
2064
2065     foreach my $part_bill_event (
2066       sort {    $a->seconds   <=> $b->seconds
2067              || $a->weight    <=> $b->weight
2068              || $a->eventpart <=> $b->eventpart }
2069         grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
2070                && ! qsearch( 'cust_bill_event', {
2071                                 'invnum'    => $cust_bill->invnum,
2072                                 'eventpart' => $_->eventpart,
2073                                 'status'    => 'done',
2074                                                                    } )
2075              }
2076           qsearch( {
2077             'table'     => 'part_bill_event',
2078             'hashref'   => { 'payby'    => $self->payby,
2079                              'disabled' => '',           },
2080             'extra_sql' => $extra_sql,
2081           } )
2082     ) {
2083
2084       last if $cust_bill->owed <= 0  # don't run subsequent events if owed<=0
2085            || $self->balance   <= 0; # or if balance<=0
2086
2087       warn "  calling invoice event (". $part_bill_event->eventcode. ")\n"
2088         if $DEBUG > 1;
2089       my $cust_main = $self; #for callback
2090
2091       my $error;
2092       {
2093         local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2094         local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
2095         $error = eval $part_bill_event->eventcode;
2096       }
2097
2098       my $status = '';
2099       my $statustext = '';
2100       if ( $@ ) {
2101         $status = 'failed';
2102         $statustext = $@;
2103       } elsif ( $error ) {
2104         $status = 'done';
2105         $statustext = $error;
2106       } else {
2107         $status = 'done'
2108       }
2109
2110       #add cust_bill_event
2111       my $cust_bill_event = new FS::cust_bill_event {
2112         'invnum'     => $cust_bill->invnum,
2113         'eventpart'  => $part_bill_event->eventpart,
2114         #'_date'      => $invoice_time,
2115         '_date'      => time,
2116         'status'     => $status,
2117         'statustext' => $statustext,
2118       };
2119       $error = $cust_bill_event->insert;
2120       if ( $error ) {
2121         #$dbh->rollback if $oldAutoCommit;
2122         #return "error: $error";
2123
2124         # gah, even with transactions.
2125         $dbh->commit if $oldAutoCommit; #well.
2126         my $e = 'WARNING: Event run but database not updated - '.
2127                 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
2128                 ', eventpart '. $part_bill_event->eventpart.
2129                 ": $error";
2130         warn $e;
2131         return $e;
2132       }
2133
2134
2135     }
2136
2137   }
2138
2139   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2140   '';
2141
2142 }
2143
2144 =item retry_realtime
2145
2146 Schedules realtime credit card / electronic check / LEC billing events for
2147 for retry.  Useful if card information has changed or manual retry is desired.
2148 The 'collect' method must be called to actually retry the transaction.
2149
2150 Implementation details: For each of this customer's open invoices, changes
2151 the status of the first "done" (with statustext error) realtime processing
2152 event to "failed".
2153
2154 =cut
2155
2156 sub retry_realtime {
2157   my $self = shift;
2158
2159   local $SIG{HUP} = 'IGNORE';
2160   local $SIG{INT} = 'IGNORE';
2161   local $SIG{QUIT} = 'IGNORE';
2162   local $SIG{TERM} = 'IGNORE';
2163   local $SIG{TSTP} = 'IGNORE';
2164   local $SIG{PIPE} = 'IGNORE';
2165
2166   my $oldAutoCommit = $FS::UID::AutoCommit;
2167   local $FS::UID::AutoCommit = 0;
2168   my $dbh = dbh;
2169
2170   foreach my $cust_bill (
2171     grep { $_->cust_bill_event }
2172       $self->open_cust_bill
2173   ) {
2174     my @cust_bill_event =
2175       sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
2176         grep {
2177                #$_->part_bill_event->plan eq 'realtime-card'
2178                $_->part_bill_event->eventcode =~
2179                    /\$cust_bill\->realtime_(card|ach|lec)/
2180                  && $_->status eq 'done'
2181                  && $_->statustext
2182              }
2183           $cust_bill->cust_bill_event;
2184     next unless @cust_bill_event;
2185     my $error = $cust_bill_event[0]->retry;
2186     if ( $error ) {
2187       $dbh->rollback if $oldAutoCommit;
2188       return "error scheduling invoice event for retry: $error";
2189     }
2190
2191   }
2192
2193   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2194   '';
2195
2196 }
2197
2198 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
2199
2200 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
2201 via a Business::OnlinePayment realtime gateway.  See
2202 L<http://420.am/business-onlinepayment> for supported gateways.
2203
2204 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2205
2206 Available options are: I<description>, I<invnum>, I<quiet>
2207
2208 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2209 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2210 if set, will override the value from the customer record.
2211
2212 I<description> is a free-text field passed to the gateway.  It defaults to
2213 "Internet services".
2214
2215 If an I<invnum> is specified, this payment (if sucessful) is applied to the
2216 specified invoice.  If you don't specify an I<invnum> you might want to
2217 call the B<apply_payments> method.
2218
2219 I<quiet> can be set true to surpress email decline notices.
2220
2221 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
2222
2223 =cut
2224
2225 sub realtime_bop {
2226   my( $self, $method, $amount, %options ) = @_;
2227   if ( $DEBUG ) {
2228     warn "$me realtime_bop: $method $amount\n";
2229     warn "  $_ => $options{$_}\n" foreach keys %options;
2230   }
2231
2232   $options{'description'} ||= 'Internet services';
2233
2234   eval "use Business::OnlinePayment";
2235   die $@ if $@;
2236
2237   my $payinfo = exists($options{'payinfo'})
2238                   ? $options{'payinfo'}
2239                   : $self->payinfo;
2240
2241   ###
2242   # select a gateway
2243   ###
2244
2245   my $taxclass = '';
2246   if ( $options{'invnum'} ) {
2247     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
2248     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
2249     my @taxclasses =
2250       map  { $_->part_pkg->taxclass }
2251       grep { $_ }
2252       map  { $_->cust_pkg }
2253       $cust_bill->cust_bill_pkg;
2254     unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
2255                                                            #different taxclasses
2256       $taxclass = $taxclasses[0];
2257     }
2258   }
2259
2260   #look for an agent gateway override first
2261   my $cardtype;
2262   if ( $method eq 'CC' ) {
2263     $cardtype = cardtype($payinfo);
2264   } elsif ( $method eq 'ECHECK' ) {
2265     $cardtype = 'ACH';
2266   } else {
2267     $cardtype = $method;
2268   }
2269
2270   my $override =
2271        qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2272                                            cardtype => $cardtype,
2273                                            taxclass => $taxclass,       } )
2274     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2275                                            cardtype => '',
2276                                            taxclass => $taxclass,       } )
2277     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2278                                            cardtype => $cardtype,
2279                                            taxclass => '',              } )
2280     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2281                                            cardtype => '',
2282                                            taxclass => '',              } );
2283
2284   my $payment_gateway = '';
2285   my( $processor, $login, $password, $action, @bop_options );
2286   if ( $override ) { #use a payment gateway override
2287
2288     $payment_gateway = $override->payment_gateway;
2289
2290     $processor   = $payment_gateway->gateway_module;
2291     $login       = $payment_gateway->gateway_username;
2292     $password    = $payment_gateway->gateway_password;
2293     $action      = $payment_gateway->gateway_action;
2294     @bop_options = $payment_gateway->options;
2295
2296   } else { #use the standard settings from the config
2297
2298     ( $processor, $login, $password, $action, @bop_options ) =
2299       $self->default_payment_gateway($method);
2300
2301   }
2302
2303   ###
2304   # massage data
2305   ###
2306
2307   my $address = exists($options{'address1'})
2308                     ? $options{'address1'}
2309                     : $self->address1;
2310   my $address2 = exists($options{'address2'})
2311                     ? $options{'address2'}
2312                     : $self->address2;
2313   $address .= ", ". $address2 if length($address2);
2314
2315   my $o_payname = exists($options{'payname'})
2316                     ? $options{'payname'}
2317                     : $self->payname;
2318   my($payname, $payfirst, $paylast);
2319   if ( $o_payname && $method ne 'ECHECK' ) {
2320     ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2321       or return "Illegal payname $payname";
2322     ($payfirst, $paylast) = ($1, $2);
2323   } else {
2324     $payfirst = $self->getfield('first');
2325     $paylast = $self->getfield('last');
2326     $payname =  "$payfirst $paylast";
2327   }
2328
2329   my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
2330   if ( $conf->exists('emailinvoiceauto')
2331        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
2332     push @invoicing_list, $self->all_emails;
2333   }
2334
2335   my $email = ($conf->exists('business-onlinepayment-email-override'))
2336               ? $conf->config('business-onlinepayment-email-override')
2337               : $invoicing_list[0];
2338
2339   my %content = ();
2340
2341   my $payip = exists($options{'payip'})
2342                 ? $options{'payip'}
2343                 : $self->payip;
2344   $content{customer_ip} = $payip
2345     if length($payip);
2346
2347   if ( $method eq 'CC' ) {
2348
2349     $content{card_number} = $payinfo;
2350     my $paydate = exists($options{'paydate'})
2351                     ? $options{'paydate'}
2352                     : $self->paydate;
2353     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2354     $content{expiration} = "$2/$1";
2355
2356     my $paycvv = exists($options{'paycvv'})
2357                    ? $options{'paycvv'}
2358                    : $self->paycvv;
2359     $content{cvv2} = $self->paycvv
2360       if length($paycvv);
2361
2362     my $paystart_month = exists($options{'paystart_month'})
2363                            ? $options{'paystart_month'}
2364                            : $self->paystart_month;
2365
2366     my $paystart_year  = exists($options{'paystart_year'})
2367                            ? $options{'paystart_year'}
2368                            : $self->paystart_year;
2369
2370     $content{card_start} = "$paystart_month/$paystart_year"
2371       if $paystart_month && $paystart_year;
2372
2373     my $payissue       = exists($options{'payissue'})
2374                            ? $options{'payissue'}
2375                            : $self->payissue;
2376     $content{issue_number} = $payissue if $payissue;
2377
2378     $content{recurring_billing} = 'YES'
2379       if qsearch('cust_pay', { 'custnum' => $self->custnum,
2380                                'payby'   => 'CARD',
2381                                'payinfo' => $payinfo,
2382                              } );
2383
2384   } elsif ( $method eq 'ECHECK' ) {
2385     ( $content{account_number}, $content{routing_code} ) =
2386       split('@', $payinfo);
2387     $content{bank_name} = $o_payname;
2388     $content{account_type} = 'CHECKING';
2389     $content{account_name} = $payname;
2390     $content{customer_org} = $self->company ? 'B' : 'I';
2391     $content{customer_ssn} = exists($options{'ss'})
2392                                ? $options{'ss'}
2393                                : $self->ss;
2394   } elsif ( $method eq 'LEC' ) {
2395     $content{phone} = $payinfo;
2396   }
2397
2398   ###
2399   # run transaction(s)
2400   ###
2401
2402   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
2403
2404   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
2405   $transaction->content(
2406     'type'           => $method,
2407     'login'          => $login,
2408     'password'       => $password,
2409     'action'         => $action1,
2410     'description'    => $options{'description'},
2411     'amount'         => $amount,
2412     'invoice_number' => $options{'invnum'},
2413     'customer_id'    => $self->custnum,
2414     'last_name'      => $paylast,
2415     'first_name'     => $payfirst,
2416     'name'           => $payname,
2417     'address'        => $address,
2418     'city'           => ( exists($options{'city'})
2419                             ? $options{'city'}
2420                             : $self->city          ),
2421     'state'          => ( exists($options{'state'})
2422                             ? $options{'state'}
2423                             : $self->state          ),
2424     'zip'            => ( exists($options{'zip'})
2425                             ? $options{'zip'}
2426                             : $self->zip          ),
2427     'country'        => ( exists($options{'country'})
2428                             ? $options{'country'}
2429                             : $self->country          ),
2430     'referer'        => 'http://cleanwhisker.420.am/',
2431     'email'          => $email,
2432     'phone'          => $self->daytime || $self->night,
2433     %content, #after
2434   );
2435   $transaction->submit();
2436
2437   if ( $transaction->is_success() && $action2 ) {
2438     my $auth = $transaction->authorization;
2439     my $ordernum = $transaction->can('order_number')
2440                    ? $transaction->order_number
2441                    : '';
2442
2443     my $capture =
2444       new Business::OnlinePayment( $processor, @bop_options );
2445
2446     my %capture = (
2447       %content,
2448       type           => $method,
2449       action         => $action2,
2450       login          => $login,
2451       password       => $password,
2452       order_number   => $ordernum,
2453       amount         => $amount,
2454       authorization  => $auth,
2455       description    => $options{'description'},
2456     );
2457
2458     foreach my $field (qw( authorization_source_code returned_ACI                                          transaction_identifier validation_code
2459                            transaction_sequence_num local_transaction_date
2460                            local_transaction_time AVS_result_code          )) {
2461       $capture{$field} = $transaction->$field() if $transaction->can($field);
2462     }
2463
2464     $capture->content( %capture );
2465
2466     $capture->submit();
2467
2468     unless ( $capture->is_success ) {
2469       my $e = "Authorization sucessful but capture failed, custnum #".
2470               $self->custnum. ': '.  $capture->result_code.
2471               ": ". $capture->error_message;
2472       warn $e;
2473       return $e;
2474     }
2475
2476   }
2477
2478   ###
2479   # remove paycvv after initial transaction
2480   ###
2481
2482   #false laziness w/misc/process/payment.cgi - check both to make sure working
2483   # correctly
2484   if ( defined $self->dbdef_table->column('paycvv')
2485        && length($self->paycvv)
2486        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2487   ) {
2488     my $error = $self->remove_cvv;
2489     if ( $error ) {
2490       warn "WARNING: error removing cvv: $error\n";
2491     }
2492   }
2493
2494   ###
2495   # result handling
2496   ###
2497
2498   if ( $transaction->is_success() ) {
2499
2500     my %method2payby = (
2501       'CC'     => 'CARD',
2502       'ECHECK' => 'CHEK',
2503       'LEC'    => 'LECB',
2504     );
2505
2506     my $paybatch = '';
2507     if ( $payment_gateway ) { # agent override
2508       $paybatch = $payment_gateway->gatewaynum. '-';
2509     }
2510
2511     $paybatch .= "$processor:". $transaction->authorization;
2512
2513     $paybatch .= ':'. $transaction->order_number
2514       if $transaction->can('order_number')
2515       && length($transaction->order_number);
2516
2517     my $cust_pay = new FS::cust_pay ( {
2518        'custnum'  => $self->custnum,
2519        'invnum'   => $options{'invnum'},
2520        'paid'     => $amount,
2521        '_date'     => '',
2522        'payby'    => $method2payby{$method},
2523        'payinfo'  => $payinfo,
2524        'paybatch' => $paybatch,
2525     } );
2526     my $error = $cust_pay->insert;
2527     if ( $error ) {
2528       $cust_pay->invnum(''); #try again with no specific invnum
2529       my $error2 = $cust_pay->insert;
2530       if ( $error2 ) {
2531         # gah, even with transactions.
2532         my $e = 'WARNING: Card/ACH debited but database not updated - '.
2533                 "error inserting payment ($processor): $error2".
2534                 " (previously tried insert with invnum #$options{'invnum'}" .
2535                 ": $error )";
2536         warn $e;
2537         return $e;
2538       }
2539     }
2540     return ''; #no error
2541
2542   } else {
2543
2544     my $perror = "$processor error: ". $transaction->error_message;
2545
2546     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2547          && $conf->exists('emaildecline')
2548          && grep { $_ ne 'POST' } $self->invoicing_list
2549          && ! grep { $transaction->error_message =~ /$_/ }
2550                    $conf->config('emaildecline-exclude')
2551     ) {
2552       my @templ = $conf->config('declinetemplate');
2553       my $template = new Text::Template (
2554         TYPE   => 'ARRAY',
2555         SOURCE => [ map "$_\n", @templ ],
2556       ) or return "($perror) can't create template: $Text::Template::ERROR";
2557       $template->compile()
2558         or return "($perror) can't compile template: $Text::Template::ERROR";
2559
2560       my $templ_hash = { error => $transaction->error_message };
2561
2562       my $error = send_email(
2563         'from'    => $conf->config('invoice_from'),
2564         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2565         'subject' => 'Your payment could not be processed',
2566         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
2567       );
2568
2569       $perror .= " (also received error sending decline notification: $error)"
2570         if $error;
2571
2572     }
2573
2574     return $perror;
2575   }
2576
2577 }
2578
2579 =item default_payment_gateway
2580
2581 =cut
2582
2583 sub default_payment_gateway {
2584   my( $self, $method ) = @_;
2585
2586   die "Real-time processing not enabled\n"
2587     unless $conf->exists('business-onlinepayment');
2588
2589   #load up config
2590   my $bop_config = 'business-onlinepayment';
2591   $bop_config .= '-ach'
2592     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2593   my ( $processor, $login, $password, $action, @bop_options ) =
2594     $conf->config($bop_config);
2595   $action ||= 'normal authorization';
2596   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2597   die "No real-time processor is enabled - ".
2598       "did you set the business-onlinepayment configuration value?\n"
2599     unless $processor;
2600
2601   ( $processor, $login, $password, $action, @bop_options )
2602 }
2603
2604 =item remove_cvv
2605
2606 Removes the I<paycvv> field from the database directly.
2607
2608 If there is an error, returns the error, otherwise returns false.
2609
2610 =cut
2611
2612 sub remove_cvv {
2613   my $self = shift;
2614   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2615     or return dbh->errstr;
2616   $sth->execute($self->custnum)
2617     or return $sth->errstr;
2618   $self->paycvv('');
2619   '';
2620 }
2621
2622 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2623
2624 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2625 via a Business::OnlinePayment realtime gateway.  See
2626 L<http://420.am/business-onlinepayment> for supported gateways.
2627
2628 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2629
2630 Available options are: I<amount>, I<reason>, I<paynum>
2631
2632 Most gateways require a reference to an original payment transaction to refund,
2633 so you probably need to specify a I<paynum>.
2634
2635 I<amount> defaults to the original amount of the payment if not specified.
2636
2637 I<reason> specifies a reason for the refund.
2638
2639 Implementation note: If I<amount> is unspecified or equal to the amount of the
2640 orignal payment, first an attempt is made to "void" the transaction via
2641 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2642 the normal attempt is made to "refund" ("credit") the transaction via the
2643 gateway is attempted.
2644
2645 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2646 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2647 #if set, will override the value from the customer record.
2648
2649 #If an I<invnum> is specified, this payment (if sucessful) is applied to the
2650 #specified invoice.  If you don't specify an I<invnum> you might want to
2651 #call the B<apply_payments> method.
2652
2653 =cut
2654
2655 #some false laziness w/realtime_bop, not enough to make it worth merging
2656 #but some useful small subs should be pulled out
2657 sub realtime_refund_bop {
2658   my( $self, $method, %options ) = @_;
2659   if ( $DEBUG ) {
2660     warn "$me realtime_refund_bop: $method refund\n";
2661     warn "  $_ => $options{$_}\n" foreach keys %options;
2662   }
2663
2664   eval "use Business::OnlinePayment";
2665   die $@ if $@;
2666
2667   ###
2668   # look up the original payment and optionally a gateway for that payment
2669   ###
2670
2671   my $cust_pay = '';
2672   my $amount = $options{'amount'};
2673
2674   my( $processor, $login, $password, @bop_options ) ;
2675   my( $auth, $order_number ) = ( '', '', '' );
2676
2677   if ( $options{'paynum'} ) {
2678
2679     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
2680     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2681       or return "Unknown paynum $options{'paynum'}";
2682     $amount ||= $cust_pay->paid;
2683
2684     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/
2685       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2686                 $cust_pay->paybatch;
2687     my $gatewaynum = '';
2688     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
2689
2690     if ( $gatewaynum ) { #gateway for the payment to be refunded
2691
2692       my $payment_gateway =
2693         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
2694       die "payment gateway $gatewaynum not found"
2695         unless $payment_gateway;
2696
2697       $processor   = $payment_gateway->gateway_module;
2698       $login       = $payment_gateway->gateway_username;
2699       $password    = $payment_gateway->gateway_password;
2700       @bop_options = $payment_gateway->options;
2701
2702     } else { #try the default gateway
2703
2704       my( $conf_processor, $unused_action );
2705       ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
2706         $self->default_payment_gateway($method);
2707
2708       return "processor of payment $options{'paynum'} $processor does not".
2709              " match default processor $conf_processor"
2710         unless $processor eq $conf_processor;
2711
2712     }
2713
2714
2715   } else { # didn't specify a paynum, so look for agent gateway overrides
2716            # like a normal transaction
2717
2718     my $cardtype;
2719     if ( $method eq 'CC' ) {
2720       $cardtype = cardtype($self->payinfo);
2721     } elsif ( $method eq 'ECHECK' ) {
2722       $cardtype = 'ACH';
2723     } else {
2724       $cardtype = $method;
2725     }
2726     my $override =
2727            qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2728                                                cardtype => $cardtype,
2729                                                taxclass => '',              } )
2730         || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2731                                                cardtype => '',
2732                                                taxclass => '',              } );
2733
2734     if ( $override ) { #use a payment gateway override
2735
2736       my $payment_gateway = $override->payment_gateway;
2737
2738       $processor   = $payment_gateway->gateway_module;
2739       $login       = $payment_gateway->gateway_username;
2740       $password    = $payment_gateway->gateway_password;
2741       #$action      = $payment_gateway->gateway_action;
2742       @bop_options = $payment_gateway->options;
2743
2744     } else { #use the standard settings from the config
2745
2746       my $unused_action;
2747       ( $processor, $login, $password, $unused_action, @bop_options ) =
2748         $self->default_payment_gateway($method);
2749
2750     }
2751
2752   }
2753   return "neither amount nor paynum specified" unless $amount;
2754
2755   my %content = (
2756     'type'           => $method,
2757     'login'          => $login,
2758     'password'       => $password,
2759     'order_number'   => $order_number,
2760     'amount'         => $amount,
2761     'referer'        => 'http://cleanwhisker.420.am/',
2762   );
2763   $content{authorization} = $auth
2764     if length($auth); #echeck/ACH transactions have an order # but no auth
2765                       #(at least with authorize.net)
2766
2767   #first try void if applicable
2768   if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2769     warn "  attempting void\n" if $DEBUG > 1;
2770     my $void = new Business::OnlinePayment( $processor, @bop_options );
2771     $void->content( 'action' => 'void', %content );
2772     $void->submit();
2773     if ( $void->is_success ) {
2774       my $error = $cust_pay->void($options{'reason'});
2775       if ( $error ) {
2776         # gah, even with transactions.
2777         my $e = 'WARNING: Card/ACH voided but database not updated - '.
2778                 "error voiding payment: $error";
2779         warn $e;
2780         return $e;
2781       }
2782       warn "  void successful\n" if $DEBUG > 1;
2783       return '';
2784     }
2785   }
2786
2787   warn "  void unsuccessful, trying refund\n"
2788     if $DEBUG > 1;
2789
2790   #massage data
2791   my $address = $self->address1;
2792   $address .= ", ". $self->address2 if $self->address2;
2793
2794   my($payname, $payfirst, $paylast);
2795   if ( $self->payname && $method ne 'ECHECK' ) {
2796     $payname = $self->payname;
2797     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2798       or return "Illegal payname $payname";
2799     ($payfirst, $paylast) = ($1, $2);
2800   } else {
2801     $payfirst = $self->getfield('first');
2802     $paylast = $self->getfield('last');
2803     $payname =  "$payfirst $paylast";
2804   }
2805
2806   my $payinfo = '';
2807   if ( $method eq 'CC' ) {
2808
2809     if ( $cust_pay ) {
2810       $content{card_number} = $payinfo = $cust_pay->payinfo;
2811       #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2812       #$content{expiration} = "$2/$1";
2813     } else {
2814       $content{card_number} = $payinfo = $self->payinfo;
2815       $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2816       $content{expiration} = "$2/$1";
2817     }
2818
2819   } elsif ( $method eq 'ECHECK' ) {
2820     ( $content{account_number}, $content{routing_code} ) =
2821       split('@', $payinfo = $self->payinfo);
2822     $content{bank_name} = $self->payname;
2823     $content{account_type} = 'CHECKING';
2824     $content{account_name} = $payname;
2825     $content{customer_org} = $self->company ? 'B' : 'I';
2826     $content{customer_ssn} = $self->ss;
2827   } elsif ( $method eq 'LEC' ) {
2828     $content{phone} = $payinfo = $self->payinfo;
2829   }
2830
2831   #then try refund
2832   my $refund = new Business::OnlinePayment( $processor, @bop_options );
2833   my %sub_content = $refund->content(
2834     'action'         => 'credit',
2835     'customer_id'    => $self->custnum,
2836     'last_name'      => $paylast,
2837     'first_name'     => $payfirst,
2838     'name'           => $payname,
2839     'address'        => $address,
2840     'city'           => $self->city,
2841     'state'          => $self->state,
2842     'zip'            => $self->zip,
2843     'country'        => $self->country,
2844     %content, #after
2845   );
2846   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
2847     if $DEBUG > 1;
2848   $refund->submit();
2849
2850   return "$processor error: ". $refund->error_message
2851     unless $refund->is_success();
2852
2853   my %method2payby = (
2854     'CC'     => 'CARD',
2855     'ECHECK' => 'CHEK',
2856     'LEC'    => 'LECB',
2857   );
2858
2859   my $paybatch = "$processor:". $refund->authorization;
2860   $paybatch .= ':'. $refund->order_number
2861     if $refund->can('order_number') && $refund->order_number;
2862
2863   while ( $cust_pay && $cust_pay->unappled < $amount ) {
2864     my @cust_bill_pay = $cust_pay->cust_bill_pay;
2865     last unless @cust_bill_pay;
2866     my $cust_bill_pay = pop @cust_bill_pay;
2867     my $error = $cust_bill_pay->delete;
2868     last if $error;
2869   }
2870
2871   my $cust_refund = new FS::cust_refund ( {
2872     'custnum'  => $self->custnum,
2873     'paynum'   => $options{'paynum'},
2874     'refund'   => $amount,
2875     '_date'    => '',
2876     'payby'    => $method2payby{$method},
2877     'payinfo'  => $payinfo,
2878     'paybatch' => $paybatch,
2879     'reason'   => $options{'reason'} || 'card or ACH refund',
2880   } );
2881   my $error = $cust_refund->insert;
2882   if ( $error ) {
2883     $cust_refund->paynum(''); #try again with no specific paynum
2884     my $error2 = $cust_refund->insert;
2885     if ( $error2 ) {
2886       # gah, even with transactions.
2887       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2888               "error inserting refund ($processor): $error2".
2889               " (previously tried insert with paynum #$options{'paynum'}" .
2890               ": $error )";
2891       warn $e;
2892       return $e;
2893     }
2894   }
2895
2896   ''; #no error
2897
2898 }
2899
2900 =item total_owed
2901
2902 Returns the total owed for this customer on all invoices
2903 (see L<FS::cust_bill/owed>).
2904
2905 =cut
2906
2907 sub total_owed {
2908   my $self = shift;
2909   $self->total_owed_date(2145859200); #12/31/2037
2910 }
2911
2912 =item total_owed_date TIME
2913
2914 Returns the total owed for this customer on all invoices with date earlier than
2915 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2916 see L<Time::Local> and L<Date::Parse> for conversion functions.
2917
2918 =cut
2919
2920 sub total_owed_date {
2921   my $self = shift;
2922   my $time = shift;
2923   my $total_bill = 0;
2924   foreach my $cust_bill (
2925     grep { $_->_date <= $time }
2926       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2927   ) {
2928     $total_bill += $cust_bill->owed;
2929   }
2930   sprintf( "%.2f", $total_bill );
2931 }
2932
2933 =item apply_credits OPTION => VALUE ...
2934
2935 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2936 to outstanding invoice balances in chronological order (or reverse
2937 chronological order if the I<order> option is set to B<newest>) and returns the
2938 value of any remaining unapplied credits available for refund (see
2939 L<FS::cust_refund>).
2940
2941 =cut
2942
2943 sub apply_credits {
2944   my $self = shift;
2945   my %opt = @_;
2946
2947   return 0 unless $self->total_credited;
2948
2949   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2950       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2951
2952   my @invoices = $self->open_cust_bill;
2953   @invoices = sort { $b->_date <=> $a->_date } @invoices
2954     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2955
2956   my $credit;
2957   foreach my $cust_bill ( @invoices ) {
2958     my $amount;
2959
2960     if ( !defined($credit) || $credit->credited == 0) {
2961       $credit = pop @credits or last;
2962     }
2963
2964     if ($cust_bill->owed >= $credit->credited) {
2965       $amount=$credit->credited;
2966     }else{
2967       $amount=$cust_bill->owed;
2968     }
2969
2970     my $cust_credit_bill = new FS::cust_credit_bill ( {
2971       'crednum' => $credit->crednum,
2972       'invnum'  => $cust_bill->invnum,
2973       'amount'  => $amount,
2974     } );
2975     my $error = $cust_credit_bill->insert;
2976     die $error if $error;
2977
2978     redo if ($cust_bill->owed > 0);
2979
2980   }
2981
2982   return $self->total_credited;
2983 }
2984
2985 =item apply_payments
2986
2987 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2988 to outstanding invoice balances in chronological order.
2989
2990  #and returns the value of any remaining unapplied payments.
2991
2992 =cut
2993
2994 sub apply_payments {
2995   my $self = shift;
2996
2997   #return 0 unless
2998
2999   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
3000       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
3001
3002   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
3003       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
3004
3005   my $payment;
3006
3007   foreach my $cust_bill ( @invoices ) {
3008     my $amount;
3009
3010     if ( !defined($payment) || $payment->unapplied == 0 ) {
3011       $payment = pop @payments or last;
3012     }
3013
3014     if ( $cust_bill->owed >= $payment->unapplied ) {
3015       $amount = $payment->unapplied;
3016     } else {
3017       $amount = $cust_bill->owed;
3018     }
3019
3020     my $cust_bill_pay = new FS::cust_bill_pay ( {
3021       'paynum' => $payment->paynum,
3022       'invnum' => $cust_bill->invnum,
3023       'amount' => $amount,
3024     } );
3025     my $error = $cust_bill_pay->insert;
3026     die $error if $error;
3027
3028     redo if ( $cust_bill->owed > 0);
3029
3030   }
3031
3032   return $self->total_unapplied_payments;
3033 }
3034
3035 =item total_credited
3036
3037 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3038 customer.  See L<FS::cust_credit/credited>.
3039
3040 =cut
3041
3042 sub total_credited {
3043   my $self = shift;
3044   my $total_credit = 0;
3045   foreach my $cust_credit ( qsearch('cust_credit', {
3046     'custnum' => $self->custnum,
3047   } ) ) {
3048     $total_credit += $cust_credit->credited;
3049   }
3050   sprintf( "%.2f", $total_credit );
3051 }
3052
3053 =item total_unapplied_payments
3054
3055 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3056 See L<FS::cust_pay/unapplied>.
3057
3058 =cut
3059
3060 sub total_unapplied_payments {
3061   my $self = shift;
3062   my $total_unapplied = 0;
3063   foreach my $cust_pay ( qsearch('cust_pay', {
3064     'custnum' => $self->custnum,
3065   } ) ) {
3066     $total_unapplied += $cust_pay->unapplied;
3067   }
3068   sprintf( "%.2f", $total_unapplied );
3069 }
3070
3071 =item balance
3072
3073 Returns the balance for this customer (total_owed minus total_credited
3074 minus total_unapplied_payments).
3075
3076 =cut
3077
3078 sub balance {
3079   my $self = shift;
3080   sprintf( "%.2f",
3081     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
3082   );
3083 }
3084
3085 =item balance_date TIME
3086
3087 Returns the balance for this customer, only considering invoices with date
3088 earlier than TIME (total_owed_date minus total_credited minus
3089 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
3090 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
3091 functions.
3092
3093 =cut
3094
3095 sub balance_date {
3096   my $self = shift;
3097   my $time = shift;
3098   sprintf( "%.2f",
3099     $self->total_owed_date($time)
3100       - $self->total_credited
3101       - $self->total_unapplied_payments
3102   );
3103 }
3104
3105 =item paydate_monthyear
3106
3107 Returns a two-element list consisting of the month and year of this customer's
3108 paydate (credit card expiration date for CARD customers)
3109
3110 =cut
3111
3112 sub paydate_monthyear {
3113   my $self = shift;
3114   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3115     ( $2, $1 );
3116   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3117     ( $1, $3 );
3118   } else {
3119     ('', '');
3120   }
3121 }
3122
3123 =item payinfo_masked
3124
3125 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.
3126
3127 Credit Cards - Mask all but the last four characters.
3128 Checks - Mask all but last 2 of account number and bank routing number.
3129 Others - Do nothing, return the unmasked string.
3130
3131 =cut
3132
3133 sub payinfo_masked {
3134   my $self = shift;
3135   return $self->paymask;
3136 }
3137
3138 =item invoicing_list [ ARRAYREF ]
3139
3140 If an arguement is given, sets these email addresses as invoice recipients
3141 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
3142 (except as warnings), so use check_invoicing_list first.
3143
3144 Returns a list of email addresses (with svcnum entries expanded).
3145
3146 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
3147 check it without disturbing anything by passing nothing.
3148
3149 This interface may change in the future.
3150
3151 =cut
3152
3153 sub invoicing_list {
3154   my( $self, $arrayref ) = @_;
3155   if ( $arrayref ) {
3156     my @cust_main_invoice;
3157     if ( $self->custnum ) {
3158       @cust_main_invoice =
3159         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3160     } else {
3161       @cust_main_invoice = ();
3162     }
3163     foreach my $cust_main_invoice ( @cust_main_invoice ) {
3164       #warn $cust_main_invoice->destnum;
3165       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3166         #warn $cust_main_invoice->destnum;
3167         my $error = $cust_main_invoice->delete;
3168         warn $error if $error;
3169       }
3170     }
3171     if ( $self->custnum ) {
3172       @cust_main_invoice =
3173         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3174     } else {
3175       @cust_main_invoice = ();
3176     }
3177     my %seen = map { $_->address => 1 } @cust_main_invoice;
3178     foreach my $address ( @{$arrayref} ) {
3179       next if exists $seen{$address} && $seen{$address};
3180       $seen{$address} = 1;
3181       my $cust_main_invoice = new FS::cust_main_invoice ( {
3182         'custnum' => $self->custnum,
3183         'dest'    => $address,
3184       } );
3185       my $error = $cust_main_invoice->insert;
3186       warn $error if $error;
3187     }
3188   }
3189   if ( $self->custnum ) {
3190     map { $_->address }
3191       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3192   } else {
3193     ();
3194   }
3195 }
3196
3197 =item check_invoicing_list ARRAYREF
3198
3199 Checks these arguements as valid input for the invoicing_list method.  If there
3200 is an error, returns the error, otherwise returns false.
3201
3202 =cut
3203
3204 sub check_invoicing_list {
3205   my( $self, $arrayref ) = @_;
3206   foreach my $address ( @{$arrayref} ) {
3207
3208     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3209       return 'Can\'t add FAX invoice destination with a blank FAX number.';
3210     }
3211
3212     my $cust_main_invoice = new FS::cust_main_invoice ( {
3213       'custnum' => $self->custnum,
3214       'dest'    => $address,
3215     } );
3216     my $error = $self->custnum
3217                 ? $cust_main_invoice->check
3218                 : $cust_main_invoice->checkdest
3219     ;
3220     return $error if $error;
3221   }
3222   '';
3223 }
3224
3225 =item set_default_invoicing_list
3226
3227 Sets the invoicing list to all accounts associated with this customer,
3228 overwriting any previous invoicing list.
3229
3230 =cut
3231
3232 sub set_default_invoicing_list {
3233   my $self = shift;
3234   $self->invoicing_list($self->all_emails);
3235 }
3236
3237 =item all_emails
3238
3239 Returns the email addresses of all accounts provisioned for this customer.
3240
3241 =cut
3242
3243 sub all_emails {
3244   my $self = shift;
3245   my %list;
3246   foreach my $cust_pkg ( $self->all_pkgs ) {
3247     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3248     my @svc_acct =
3249       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3250         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3251           @cust_svc;
3252     $list{$_}=1 foreach map { $_->email } @svc_acct;
3253   }
3254   keys %list;
3255 }
3256
3257 =item invoicing_list_addpost
3258
3259 Adds postal invoicing to this customer.  If this customer is already configured
3260 to receive postal invoices, does nothing.
3261
3262 =cut
3263
3264 sub invoicing_list_addpost {
3265   my $self = shift;
3266   return if grep { $_ eq 'POST' } $self->invoicing_list;
3267   my @invoicing_list = $self->invoicing_list;
3268   push @invoicing_list, 'POST';
3269   $self->invoicing_list(\@invoicing_list);
3270 }
3271
3272 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3273
3274 Returns an array of customers referred by this customer (referral_custnum set
3275 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3276 customers referred by customers referred by this customer and so on, inclusive.
3277 The default behavior is DEPTH 1 (no recursion).
3278
3279 =cut
3280
3281 sub referral_cust_main {
3282   my $self = shift;
3283   my $depth = @_ ? shift : 1;
3284   my $exclude = @_ ? shift : {};
3285
3286   my @cust_main =
3287     map { $exclude->{$_->custnum}++; $_; }
3288       grep { ! $exclude->{ $_->custnum } }
3289         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3290
3291   if ( $depth > 1 ) {
3292     push @cust_main,
3293       map { $_->referral_cust_main($depth-1, $exclude) }
3294         @cust_main;
3295   }
3296
3297   @cust_main;
3298 }
3299
3300 =item referral_cust_main_ncancelled
3301
3302 Same as referral_cust_main, except only returns customers with uncancelled
3303 packages.
3304
3305 =cut
3306
3307 sub referral_cust_main_ncancelled {
3308   my $self = shift;
3309   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3310 }
3311
3312 =item referral_cust_pkg [ DEPTH ]
3313
3314 Like referral_cust_main, except returns a flat list of all unsuspended (and
3315 uncancelled) packages for each customer.  The number of items in this list may
3316 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3317
3318 =cut
3319
3320 sub referral_cust_pkg {
3321   my $self = shift;
3322   my $depth = @_ ? shift : 1;
3323
3324   map { $_->unsuspended_pkgs }
3325     grep { $_->unsuspended_pkgs }
3326       $self->referral_cust_main($depth);
3327 }
3328
3329 =item referring_cust_main
3330
3331 Returns the single cust_main record for the customer who referred this customer
3332 (referral_custnum), or false.
3333
3334 =cut
3335
3336 sub referring_cust_main {
3337   my $self = shift;
3338   return '' unless $self->referral_custnum;
3339   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3340 }
3341
3342 =item credit AMOUNT, REASON
3343
3344 Applies a credit to this customer.  If there is an error, returns the error,
3345 otherwise returns false.
3346
3347 =cut
3348
3349 sub credit {
3350   my( $self, $amount, $reason ) = @_;
3351   my $cust_credit = new FS::cust_credit {
3352     'custnum' => $self->custnum,
3353     'amount'  => $amount,
3354     'reason'  => $reason,
3355   };
3356   $cust_credit->insert;
3357 }
3358
3359 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3360
3361 Creates a one-time charge for this customer.  If there is an error, returns
3362 the error, otherwise returns false.
3363
3364 =cut
3365
3366 sub charge {
3367   my ( $self, $amount ) = ( shift, shift );
3368   my $pkg      = @_ ? shift : 'One-time charge';
3369   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
3370   my $taxclass = @_ ? shift : '';
3371
3372   local $SIG{HUP} = 'IGNORE';
3373   local $SIG{INT} = 'IGNORE';
3374   local $SIG{QUIT} = 'IGNORE';
3375   local $SIG{TERM} = 'IGNORE';
3376   local $SIG{TSTP} = 'IGNORE';
3377   local $SIG{PIPE} = 'IGNORE';
3378
3379   my $oldAutoCommit = $FS::UID::AutoCommit;
3380   local $FS::UID::AutoCommit = 0;
3381   my $dbh = dbh;
3382
3383   my $part_pkg = new FS::part_pkg ( {
3384     'pkg'      => $pkg,
3385     'comment'  => $comment,
3386     #'setup'    => $amount,
3387     #'recur'    => '0',
3388     'plan'     => 'flat',
3389     'plandata' => "setup_fee=$amount",
3390     'freq'     => 0,
3391     'disabled' => 'Y',
3392     'taxclass' => $taxclass,
3393   } );
3394
3395   my $error = $part_pkg->insert;
3396   if ( $error ) {
3397     $dbh->rollback if $oldAutoCommit;
3398     return $error;
3399   }
3400
3401   my $pkgpart = $part_pkg->pkgpart;
3402   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3403   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3404     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3405     $error = $type_pkgs->insert;
3406     if ( $error ) {
3407       $dbh->rollback if $oldAutoCommit;
3408       return $error;
3409     }
3410   }
3411
3412   my $cust_pkg = new FS::cust_pkg ( {
3413     'custnum' => $self->custnum,
3414     'pkgpart' => $pkgpart,
3415   } );
3416
3417   $error = $cust_pkg->insert;
3418   if ( $error ) {
3419     $dbh->rollback if $oldAutoCommit;
3420     return $error;
3421   }
3422
3423   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3424   '';
3425
3426 }
3427
3428 =item cust_bill
3429
3430 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3431
3432 =cut
3433
3434 sub cust_bill {
3435   my $self = shift;
3436   sort { $a->_date <=> $b->_date }
3437     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3438 }
3439
3440 =item open_cust_bill
3441
3442 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3443 customer.
3444
3445 =cut
3446
3447 sub open_cust_bill {
3448   my $self = shift;
3449   grep { $_->owed > 0 } $self->cust_bill;
3450 }
3451
3452 =item cust_credit
3453
3454 Returns all the credits (see L<FS::cust_credit>) for this customer.
3455
3456 =cut
3457
3458 sub cust_credit {
3459   my $self = shift;
3460   sort { $a->_date <=> $b->_date }
3461     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3462 }
3463
3464 =item cust_pay
3465
3466 Returns all the payments (see L<FS::cust_pay>) for this customer.
3467
3468 =cut
3469
3470 sub cust_pay {
3471   my $self = shift;
3472   sort { $a->_date <=> $b->_date }
3473     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3474 }
3475
3476 =item cust_pay_void
3477
3478 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3479
3480 =cut
3481
3482 sub cust_pay_void {
3483   my $self = shift;
3484   sort { $a->_date <=> $b->_date }
3485     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3486 }
3487
3488
3489 =item cust_refund
3490
3491 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3492
3493 =cut
3494
3495 sub cust_refund {
3496   my $self = shift;
3497   sort { $a->_date <=> $b->_date }
3498     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3499 }
3500
3501 =item select_for_update
3502
3503 Selects this record with the SQL "FOR UPDATE" command.  This can be useful as
3504 a mutex.
3505
3506 =cut
3507
3508 sub select_for_update {
3509   my $self = shift;
3510   qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
3511 }
3512
3513 =item name
3514
3515 Returns a name string for this customer, either "Company (Last, First)" or
3516 "Last, First".
3517
3518 =cut
3519
3520 sub name {
3521   my $self = shift;
3522   my $name = $self->contact;
3523   $name = $self->company. " ($name)" if $self->company;
3524   $name;
3525 }
3526
3527 =item ship_name
3528
3529 Returns a name string for this (service/shipping) contact, either
3530 "Company (Last, First)" or "Last, First".
3531
3532 =cut
3533
3534 sub ship_name {
3535   my $self = shift;
3536   if ( $self->get('ship_last') ) {
3537     my $name = $self->ship_contact;
3538     $name = $self->ship_company. " ($name)" if $self->ship_company;
3539     $name;
3540   } else {
3541     $self->name;
3542   }
3543 }
3544
3545 =item contact
3546
3547 Returns this customer's full (billing) contact name only, "Last, First"
3548
3549 =cut
3550
3551 sub contact {
3552   my $self = shift;
3553   $self->get('last'). ', '. $self->first;
3554 }
3555
3556 =item ship_contact
3557
3558 Returns this customer's full (shipping) contact name only, "Last, First"
3559
3560 =cut
3561
3562 sub ship_contact {
3563   my $self = shift;
3564   $self->get('ship_last')
3565     ? $self->get('ship_last'). ', '. $self->ship_first
3566     : $self->contact;
3567 }
3568
3569 =item status
3570
3571 Returns a status string for this customer, currently:
3572
3573 =over 4
3574
3575 =item prospect - No packages have ever been ordered
3576
3577 =item active - One or more recurring packages is active
3578
3579 =item suspended - All non-cancelled recurring packages are suspended
3580
3581 =item cancelled - All recurring packages are cancelled
3582
3583 =back
3584
3585 =cut
3586
3587 sub status {
3588   my $self = shift;
3589   for my $status (qw( prospect active suspended cancelled )) {
3590     my $method = $status.'_sql';
3591     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3592     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3593     $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
3594     return $status if $sth->fetchrow_arrayref->[0];
3595   }
3596 }
3597
3598 =item statuscolor
3599
3600 Returns a hex triplet color string for this customer's status.
3601
3602 =cut
3603
3604 my %statuscolor = (
3605   'prospect'  => '000000',
3606   'active'    => '00CC00',
3607   'suspended' => 'FF9900',
3608   'cancelled' => 'FF0000',
3609 );
3610 sub statuscolor {
3611   my $self = shift;
3612   $statuscolor{$self->status};
3613 }
3614
3615 =back
3616
3617 =head1 CLASS METHODS
3618
3619 =over 4
3620
3621 =item prospect_sql
3622
3623 Returns an SQL expression identifying prospective cust_main records (customers
3624 with no packages ever ordered)
3625
3626 =cut
3627
3628 sub prospect_sql { "
3629   0 = ( SELECT COUNT(*) FROM cust_pkg
3630           WHERE cust_pkg.custnum = cust_main.custnum
3631       )
3632 "; }
3633
3634 =item active_sql
3635
3636 Returns an SQL expression identifying active cust_main records.
3637
3638 =cut
3639
3640 sub active_sql { "
3641   0 < ( SELECT COUNT(*) FROM cust_pkg
3642           WHERE cust_pkg.custnum = cust_main.custnum
3643             AND ". FS::cust_pkg->active_sql. "
3644       )
3645 "; }
3646
3647 =item susp_sql
3648 =item suspended_sql
3649
3650 Returns an SQL expression identifying suspended cust_main records.
3651
3652 =cut
3653
3654 #my $recurring_sql = FS::cust_pkg->recurring_sql;
3655 my $recurring_sql = "
3656   '0' != ( select freq from part_pkg
3657              where cust_pkg.pkgpart = part_pkg.pkgpart )
3658 ";
3659
3660 sub suspended_sql { susp_sql(@_); }
3661 sub susp_sql { "
3662     0 < ( SELECT COUNT(*) FROM cust_pkg
3663             WHERE cust_pkg.custnum = cust_main.custnum
3664               AND $recurring_sql
3665               AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3666         )
3667     AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3668                 WHERE cust_pkg.custnum = cust_main.custnum
3669                   AND ". FS::cust_pkg->active_sql. "
3670             )
3671 "; }
3672
3673 =item cancel_sql
3674 =item cancelled_sql
3675
3676 Returns an SQL expression identifying cancelled cust_main records.
3677
3678 =cut
3679
3680 sub cancelled_sql { cancel_sql(@_); }
3681 sub cancel_sql { "
3682   0 < ( SELECT COUNT(*) FROM cust_pkg
3683           WHERE cust_pkg.custnum = cust_main.custnum
3684       )
3685   AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3686               WHERE cust_pkg.custnum = cust_main.custnum
3687                 AND $recurring_sql
3688                 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3689           )
3690 "; }
3691
3692 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3693
3694 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3695 records.  Currently, only I<last> or I<company> may be specified (the
3696 appropriate ship_ field is also searched if applicable).
3697
3698 Additional options are the same as FS::Record::qsearch
3699
3700 =cut
3701
3702 sub fuzzy_search {
3703   my( $self, $fuzzy, $hash, @opt) = @_;
3704   #$self
3705   $hash ||= {};
3706   my @cust_main = ();
3707
3708   check_and_rebuild_fuzzyfiles();
3709   foreach my $field ( keys %$fuzzy ) {
3710     my $sub = \&{"all_$field"};
3711     my %match = ();
3712     $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
3713
3714     foreach ( keys %match ) {
3715       push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3716       push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
3717         if defined dbdef->table('cust_main')->column('ship_last');
3718     }
3719   }
3720
3721   my %saw = ();
3722   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
3723
3724   @cust_main;
3725
3726 }
3727
3728 =back
3729
3730 =head1 SUBROUTINES
3731
3732 =over 4
3733
3734 =item smart_search OPTION => VALUE ...
3735
3736 Accepts the following options: I<search>, the string to search for.  The string
3737 will be searched for as a customer number, last name or company name, first
3738 searching for an exact match then fuzzy and substring matches.
3739
3740 Any additional options treated as an additional qualifier on the search
3741 (i.e. I<agentnum>).
3742
3743 Returns a (possibly empty) array of FS::cust_main objects.
3744
3745 =cut
3746
3747 sub smart_search {
3748   my %options = @_;
3749   my $search = delete $options{'search'};
3750   my @cust_main = ();
3751
3752   if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3753
3754     push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } );
3755
3756   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3757
3758     my $value = lc($1);
3759     my $q_value = dbh->quote($value);
3760
3761     #exact
3762     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3763     $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3764     $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3765       if defined dbdef->table('cust_main')->column('ship_last');
3766     $sql .= ' )';
3767
3768     push @cust_main, qsearch( 'cust_main', \%options, '', $sql );
3769
3770     unless ( @cust_main ) {  #no exact match, trying substring/fuzzy
3771
3772       #still some false laziness w/ search/cust_main.cgi
3773
3774       #substring
3775       push @cust_main, qsearch( 'cust_main',
3776                                 { 'last'     => { 'op'    => 'ILIKE',
3777                                                   'value' => "%$q_value%" },
3778                                   %options,
3779                                 }
3780                               );
3781       push @cust_main, qsearch( 'cust_main',
3782                                 { 'ship_last' => { 'op'    => 'ILIKE',
3783                                                    'value' => "%$q_value%" },
3784                                   %options,
3785
3786                                 }
3787                               )
3788         if defined dbdef->table('cust_main')->column('ship_last');
3789
3790       push @cust_main, qsearch( 'cust_main',
3791                                 { 'company'  => { 'op'    => 'ILIKE',
3792                                                   'value' => "%$q_value%" },
3793                                   %options,
3794                                 }
3795                               );
3796       push @cust_main, qsearch( 'cust_main',
3797                                 { 'ship_company' => { 'op' => 'ILIKE',
3798                                                    'value' => "%$q_value%" },
3799                                   %options,
3800                                 }
3801                               )
3802         if defined dbdef->table('cust_main')->column('ship_last');
3803
3804       #fuzzy
3805       push @cust_main, FS::cust_main->fuzzy_search(
3806         { 'last'     => $value },
3807         \%options,
3808       );
3809       push @cust_main, FS::cust_main->fuzzy_search(
3810         { 'company'  => $value },
3811         \%options,
3812       );
3813
3814     }
3815
3816   }
3817
3818   @cust_main;
3819
3820 }
3821
3822 =item check_and_rebuild_fuzzyfiles
3823
3824 =cut
3825
3826 sub check_and_rebuild_fuzzyfiles {
3827   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3828   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3829     or &rebuild_fuzzyfiles;
3830 }
3831
3832 =item rebuild_fuzzyfiles
3833
3834 =cut
3835
3836 sub rebuild_fuzzyfiles {
3837
3838   use Fcntl qw(:flock);
3839
3840   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3841
3842   #last
3843
3844   open(LASTLOCK,">>$dir/cust_main.last")
3845     or die "can't open $dir/cust_main.last: $!";
3846   flock(LASTLOCK,LOCK_EX)
3847     or die "can't lock $dir/cust_main.last: $!";
3848
3849   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3850   push @all_last,
3851                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3852     if defined dbdef->table('cust_main')->column('ship_last');
3853
3854   open (LASTCACHE,">$dir/cust_main.last.tmp")
3855     or die "can't open $dir/cust_main.last.tmp: $!";
3856   print LASTCACHE join("\n", @all_last), "\n";
3857   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3858
3859   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3860   close LASTLOCK;
3861
3862   #company
3863
3864   open(COMPANYLOCK,">>$dir/cust_main.company")
3865     or die "can't open $dir/cust_main.company: $!";
3866   flock(COMPANYLOCK,LOCK_EX)
3867     or die "can't lock $dir/cust_main.company: $!";
3868
3869   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3870   push @all_company,
3871        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3872     if defined dbdef->table('cust_main')->column('ship_last');
3873
3874   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3875     or die "can't open $dir/cust_main.company.tmp: $!";
3876   print COMPANYCACHE join("\n", @all_company), "\n";
3877   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3878
3879   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3880   close COMPANYLOCK;
3881
3882 }
3883
3884 =item all_last
3885
3886 =cut
3887
3888 sub all_last {
3889   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3890   open(LASTCACHE,"<$dir/cust_main.last")
3891     or die "can't open $dir/cust_main.last: $!";
3892   my @array = map { chomp; $_; } <LASTCACHE>;
3893   close LASTCACHE;
3894   \@array;
3895 }
3896
3897 =item all_company
3898
3899 =cut
3900
3901 sub all_company {
3902   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3903   open(COMPANYCACHE,"<$dir/cust_main.company")
3904     or die "can't open $dir/cust_main.last: $!";
3905   my @array = map { chomp; $_; } <COMPANYCACHE>;
3906   close COMPANYCACHE;
3907   \@array;
3908 }
3909
3910 =item append_fuzzyfiles LASTNAME COMPANY
3911
3912 =cut
3913
3914 sub append_fuzzyfiles {
3915   my( $last, $company ) = @_;
3916
3917   &check_and_rebuild_fuzzyfiles;
3918
3919   use Fcntl qw(:flock);
3920
3921   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3922
3923   if ( $last ) {
3924
3925     open(LAST,">>$dir/cust_main.last")
3926       or die "can't open $dir/cust_main.last: $!";
3927     flock(LAST,LOCK_EX)
3928       or die "can't lock $dir/cust_main.last: $!";
3929
3930     print LAST "$last\n";
3931
3932     flock(LAST,LOCK_UN)
3933       or die "can't unlock $dir/cust_main.last: $!";
3934     close LAST;
3935   }
3936
3937   if ( $company ) {
3938
3939     open(COMPANY,">>$dir/cust_main.company")
3940       or die "can't open $dir/cust_main.company: $!";
3941     flock(COMPANY,LOCK_EX)
3942       or die "can't lock $dir/cust_main.company: $!";
3943
3944     print COMPANY "$company\n";
3945
3946     flock(COMPANY,LOCK_UN)
3947       or die "can't unlock $dir/cust_main.company: $!";
3948
3949     close COMPANY;
3950   }
3951
3952   1;
3953 }
3954
3955 =item batch_import
3956
3957 =cut
3958
3959 sub batch_import {
3960   my $param = shift;
3961   #warn join('-',keys %$param);
3962   my $fh = $param->{filehandle};
3963   my $agentnum = $param->{agentnum};
3964   my $refnum = $param->{refnum};
3965   my $pkgpart = $param->{pkgpart};
3966   my @fields = @{$param->{fields}};
3967
3968   eval "use Text::CSV_XS;";
3969   die $@ if $@;
3970
3971   my $csv = new Text::CSV_XS;
3972   #warn $csv;
3973   #warn $fh;
3974
3975   my $imported = 0;
3976   #my $columns;
3977
3978   local $SIG{HUP} = 'IGNORE';
3979   local $SIG{INT} = 'IGNORE';
3980   local $SIG{QUIT} = 'IGNORE';
3981   local $SIG{TERM} = 'IGNORE';
3982   local $SIG{TSTP} = 'IGNORE';
3983   local $SIG{PIPE} = 'IGNORE';
3984
3985   my $oldAutoCommit = $FS::UID::AutoCommit;
3986   local $FS::UID::AutoCommit = 0;
3987   my $dbh = dbh;
3988
3989   #while ( $columns = $csv->getline($fh) ) {
3990   my $line;
3991   while ( defined($line=<$fh>) ) {
3992
3993     $csv->parse($line) or do {
3994       $dbh->rollback if $oldAutoCommit;
3995       return "can't parse: ". $csv->error_input();
3996     };
3997
3998     my @columns = $csv->fields();
3999     #warn join('-',@columns);
4000
4001     my %cust_main = (
4002       agentnum => $agentnum,
4003       refnum   => $refnum,
4004       country  => $conf->config('countrydefault') || 'US',
4005       payby    => 'BILL', #default
4006       paydate  => '12/2037', #default
4007     );
4008     my $billtime = time;
4009     my %cust_pkg = ( pkgpart => $pkgpart );
4010     foreach my $field ( @fields ) {
4011       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
4012         #$cust_pkg{$1} = str2time( shift @$columns );
4013         if ( $1 eq 'setup' ) {
4014           $billtime = str2time(shift @columns);
4015         } else {
4016           $cust_pkg{$1} = str2time( shift @columns );
4017         }
4018       } else {
4019         #$cust_main{$field} = shift @$columns;
4020         $cust_main{$field} = shift @columns;
4021       }
4022     }
4023
4024     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
4025     my $cust_main = new FS::cust_main ( \%cust_main );
4026     use Tie::RefHash;
4027     tie my %hash, 'Tie::RefHash'; #this part is important
4028     $hash{$cust_pkg} = [] if $pkgpart;
4029     my $error = $cust_main->insert( \%hash );
4030
4031     if ( $error ) {
4032       $dbh->rollback if $oldAutoCommit;
4033       return "can't insert customer for $line: $error";
4034     }
4035
4036     #false laziness w/bill.cgi
4037     $error = $cust_main->bill( 'time' => $billtime );
4038     if ( $error ) {
4039       $dbh->rollback if $oldAutoCommit;
4040       return "can't bill customer for $line: $error";
4041     }
4042
4043     $cust_main->apply_payments;
4044     $cust_main->apply_credits;
4045
4046     $error = $cust_main->collect();
4047     if ( $error ) {
4048       $dbh->rollback if $oldAutoCommit;
4049       return "can't collect customer for $line: $error";
4050     }
4051
4052     $imported++;
4053   }
4054
4055   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4056
4057   return "Empty file!" unless $imported;
4058
4059   ''; #no error
4060
4061 }
4062
4063 =item batch_charge
4064
4065 =cut
4066
4067 sub batch_charge {
4068   my $param = shift;
4069   #warn join('-',keys %$param);
4070   my $fh = $param->{filehandle};
4071   my @fields = @{$param->{fields}};
4072
4073   eval "use Text::CSV_XS;";
4074   die $@ if $@;
4075
4076   my $csv = new Text::CSV_XS;
4077   #warn $csv;
4078   #warn $fh;
4079
4080   my $imported = 0;
4081   #my $columns;
4082
4083   local $SIG{HUP} = 'IGNORE';
4084   local $SIG{INT} = 'IGNORE';
4085   local $SIG{QUIT} = 'IGNORE';
4086   local $SIG{TERM} = 'IGNORE';
4087   local $SIG{TSTP} = 'IGNORE';
4088   local $SIG{PIPE} = 'IGNORE';
4089
4090   my $oldAutoCommit = $FS::UID::AutoCommit;
4091   local $FS::UID::AutoCommit = 0;
4092   my $dbh = dbh;
4093
4094   #while ( $columns = $csv->getline($fh) ) {
4095   my $line;
4096   while ( defined($line=<$fh>) ) {
4097
4098     $csv->parse($line) or do {
4099       $dbh->rollback if $oldAutoCommit;
4100       return "can't parse: ". $csv->error_input();
4101     };
4102
4103     my @columns = $csv->fields();
4104     #warn join('-',@columns);
4105
4106     my %row = ();
4107     foreach my $field ( @fields ) {
4108       $row{$field} = shift @columns;
4109     }
4110
4111     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
4112     unless ( $cust_main ) {
4113       $dbh->rollback if $oldAutoCommit;
4114       return "unknown custnum $row{'custnum'}";
4115     }
4116
4117     if ( $row{'amount'} > 0 ) {
4118       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4119       if ( $error ) {
4120         $dbh->rollback if $oldAutoCommit;
4121         return $error;
4122       }
4123       $imported++;
4124     } elsif ( $row{'amount'} < 0 ) {
4125       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4126                                       $row{'pkg'}                         );
4127       if ( $error ) {
4128         $dbh->rollback if $oldAutoCommit;
4129         return $error;
4130       }
4131       $imported++;
4132     } else {
4133       #hmm?
4134     }
4135
4136   }
4137
4138   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4139
4140   return "Empty file!" unless $imported;
4141
4142   ''; #no error
4143
4144 }
4145
4146 =back
4147
4148 =head1 BUGS
4149
4150 The delete method.
4151
4152 The delete method should possibly take an FS::cust_main object reference
4153 instead of a scalar customer number.
4154
4155 Bill and collect options should probably be passed as references instead of a
4156 list.
4157
4158 There should probably be a configuration file with a list of allowed credit
4159 card types.
4160
4161 No multiple currency support (probably a larger project than just this module).
4162
4163 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4164
4165 =head1 SEE ALSO
4166
4167 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4168 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4169 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
4170
4171 =cut
4172
4173 1;
4174