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