FS/FS/cust_main.pm

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