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