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