FS/FS/cust_main.pm

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