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