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