FS/FS/cust_main.pm

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