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 'DCRD') { # 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       } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
1637         my $hours = $1;
1638         $hour += $hours;
1639       } else {
1640         $dbh->rollback if $oldAutoCommit;
1641         return "unparsable frequency: ". $part_pkg->freq;
1642       }
1643       $cust_pkg->setfield('bill',
1644         timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1645     }
1646
1647     warn "\$setup is undefined" unless defined($setup);
1648     warn "\$recur is undefined" unless defined($recur);
1649     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1650
1651     if ( $cust_pkg->modified ) {
1652
1653       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n" if $DEBUG;
1654
1655       $error=$cust_pkg->replace($old_cust_pkg);
1656       if ( $error ) { #just in case
1657         $dbh->rollback if $oldAutoCommit;
1658         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1659       }
1660
1661       $setup = sprintf( "%.2f", $setup );
1662       $recur = sprintf( "%.2f", $recur );
1663       if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1664         $dbh->rollback if $oldAutoCommit;
1665         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1666       }
1667       if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1668         $dbh->rollback if $oldAutoCommit;
1669         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1670       }
1671       if ( $setup != 0 || $recur != 0 ) {
1672         warn "    charges (setup=$setup, recur=$recur); queueing line items\n"
1673           if $DEBUG;
1674         my $cust_bill_pkg = new FS::cust_bill_pkg ({
1675           'pkgnum'  => $cust_pkg->pkgnum,
1676           'setup'   => $setup,
1677           'recur'   => $recur,
1678           'sdate'   => $sdate,
1679           'edate'   => $cust_pkg->bill,
1680           'details' => \@details,
1681         });
1682         push @cust_bill_pkg, $cust_bill_pkg;
1683         $total_setup += $setup;
1684         $total_recur += $recur;
1685
1686         unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1687
1688           my @taxes = qsearch( 'cust_main_county', {
1689                                  'state'    => $self->state,
1690                                  'county'   => $self->county,
1691                                  'country'  => $self->country,
1692                                  'taxclass' => $part_pkg->taxclass,
1693                                                                       } );
1694           unless ( @taxes ) {
1695             @taxes =  qsearch( 'cust_main_county', {
1696                                   'state'    => $self->state,
1697                                   'county'   => $self->county,
1698                                   'country'  => $self->country,
1699                                   'taxclass' => '',
1700                                                                       } );
1701           }
1702
1703           #one more try at a whole-country tax rate
1704           unless ( @taxes ) {
1705             @taxes =  qsearch( 'cust_main_county', {
1706                                   'state'    => '',
1707                                   'county'   => '',
1708                                   'country'  => $self->country,
1709                                   'taxclass' => '',
1710                                                                       } );
1711           }
1712
1713           # maybe eliminate this entirely, along with all the 0% records
1714           unless ( @taxes ) {
1715             $dbh->rollback if $oldAutoCommit;
1716             return
1717               "fatal: can't find tax rate for state/county/country/taxclass ".
1718               join('/', ( map $self->$_(), qw(state county country) ),
1719                         $part_pkg->taxclass ).  "\n";
1720           }
1721
1722           foreach my $tax ( @taxes ) {
1723
1724             my $taxable_charged = 0;
1725             $taxable_charged += $setup
1726               unless $part_pkg->setuptax =~ /^Y$/i
1727                   || $tax->setuptax =~ /^Y$/i;
1728             $taxable_charged += $recur
1729               unless $part_pkg->recurtax =~ /^Y$/i
1730                   || $tax->recurtax =~ /^Y$/i;
1731             next unless $taxable_charged;
1732
1733             if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
1734               my ($mon,$year) = (localtime($sdate) )[4,5];
1735               $mon++;
1736               my $freq = $part_pkg->freq || 1;
1737               if ( $freq !~ /(\d+)$/ ) {
1738                 $dbh->rollback if $oldAutoCommit;
1739                 return "daily/weekly package definitions not (yet?)".
1740                        " compatible with monthly tax exemptions";
1741               }
1742               my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1743               foreach my $which_month ( 1 .. $freq ) {
1744                 my %hash = (
1745                   'custnum' => $self->custnum,
1746                   'taxnum'  => $tax->taxnum,
1747                   'year'    => 1900+$year,
1748                   'month'   => $mon++,
1749                 );
1750                 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1751                 until ( $mon < 13 ) { $mon -= 12; $year++; }
1752                 my $cust_tax_exempt =
1753                   qsearchs('cust_tax_exempt', \%hash)
1754                   || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1755                 my $remaining_exemption = sprintf("%.2f",
1756                   $tax->exempt_amount - $cust_tax_exempt->amount );
1757                 if ( $remaining_exemption > 0 ) {
1758                   my $addl = $remaining_exemption > $taxable_per_month
1759                     ? $taxable_per_month
1760                     : $remaining_exemption;
1761                   $taxable_charged -= $addl;
1762                   my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1763                     $cust_tax_exempt->hash,
1764                     'amount' =>
1765                       sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1766                   } );
1767                   $error = $new_cust_tax_exempt->exemptnum
1768                     ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1769                     : $new_cust_tax_exempt->insert;
1770                   if ( $error ) {
1771                     $dbh->rollback if $oldAutoCommit;
1772                     return "fatal: can't update cust_tax_exempt: $error";
1773                   }
1774
1775                 } # if $remaining_exemption > 0
1776
1777               } #foreach $which_month
1778
1779             } #if $tax->exempt_amount
1780
1781             $taxable_charged = sprintf( "%.2f", $taxable_charged);
1782
1783             #$tax += $taxable_charged * $cust_main_county->tax / 100
1784             $tax{ $tax->taxname || 'Tax' } +=
1785               $taxable_charged * $tax->tax / 100
1786
1787           } #foreach my $tax ( @taxes )
1788
1789         } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1790
1791       } #if $setup != 0 || $recur != 0
1792
1793     } #if $cust_pkg->modified
1794
1795   } #foreach my $cust_pkg
1796
1797   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1798 #  my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1799
1800   unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1801     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1802     return '';
1803   }
1804
1805 #  unless ( $self->tax =~ /Y/i
1806 #           || $self->payby eq 'COMP'
1807 #           || $taxable_charged == 0 ) {
1808 #    my $cust_main_county = qsearchs('cust_main_county',{
1809 #        'state'   => $self->state,
1810 #        'county'  => $self->county,
1811 #        'country' => $self->country,
1812 #    } ) or die "fatal: can't find tax rate for state/county/country ".
1813 #               $self->state. "/". $self->county. "/". $self->country. "\n";
1814 #    my $tax = sprintf( "%.2f",
1815 #      $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1816 #    );
1817
1818   if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1819
1820     foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1821       my $tax = sprintf("%.2f", $tax{$taxname} );
1822       $charged = sprintf( "%.2f", $charged+$tax );
1823
1824       my $cust_bill_pkg = new FS::cust_bill_pkg ({
1825         'pkgnum'   => 0,
1826         'setup'    => $tax,
1827         'recur'    => 0,
1828         'sdate'    => '',
1829         'edate'    => '',
1830         'itemdesc' => $taxname,
1831       });
1832       push @cust_bill_pkg, $cust_bill_pkg;
1833     }
1834
1835   } else { #1.4 schema
1836
1837     my $tax = 0;
1838     foreach ( values %tax ) { $tax += $_ };
1839     $tax = sprintf("%.2f", $tax);
1840     if ( $tax > 0 ) {
1841       $charged = sprintf( "%.2f", $charged+$tax );
1842
1843       my $cust_bill_pkg = new FS::cust_bill_pkg ({
1844         'pkgnum' => 0,
1845         'setup'  => $tax,
1846         'recur'  => 0,
1847         'sdate'  => '',
1848         'edate'  => '',
1849       });
1850       push @cust_bill_pkg, $cust_bill_pkg;
1851     }
1852
1853   }
1854
1855   my $cust_bill = new FS::cust_bill ( {
1856     'custnum' => $self->custnum,
1857     '_date'   => $time,
1858     'charged' => $charged,
1859   } );
1860   $error = $cust_bill->insert;
1861   if ( $error ) {
1862     $dbh->rollback if $oldAutoCommit;
1863     return "can't create invoice for customer #". $self->custnum. ": $error";
1864   }
1865
1866   my $invnum = $cust_bill->invnum;
1867   my $cust_bill_pkg;
1868   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1869     #warn $invnum;
1870     $cust_bill_pkg->invnum($invnum);
1871     $error = $cust_bill_pkg->insert;
1872     if ( $error ) {
1873       $dbh->rollback if $oldAutoCommit;
1874       return "can't create invoice line item for customer #". $self->custnum.
1875              ": $error";
1876     }
1877   }
1878
1879   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1880   ''; #no error
1881 }
1882
1883 =item collect OPTIONS
1884
1885 (Attempt to) collect money for this customer's outstanding invoices (see
1886 L<FS::cust_bill>).  Usually used after the bill method.
1887
1888 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1889 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1890 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1891
1892 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1893 and the invoice events web interface.
1894
1895 If there is an error, returns the error, otherwise returns false.
1896
1897 Options are passed as name-value pairs.
1898
1899 Currently available options are:
1900
1901 invoice_time - Use this time when deciding when to print invoices and
1902 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>
1903 for conversion functions.
1904
1905 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1906 events.
1907
1908 retry_card - Deprecated alias for 'retry'
1909
1910 batch_card - This option is deprecated.  See the invoice events web interface
1911 to control whether cards are batched or run against a realtime gateway.
1912
1913 report_badcard - This option is deprecated.
1914
1915 force_print - This option is deprecated; see the invoice events web interface.
1916
1917 quiet - set true to surpress email card/ACH decline notices.
1918
1919 =cut
1920
1921 sub collect {
1922   my( $self, %options ) = @_;
1923   my $invoice_time = $options{'invoice_time'} || time;
1924
1925   #put below somehow?
1926   local $SIG{HUP} = 'IGNORE';
1927   local $SIG{INT} = 'IGNORE';
1928   local $SIG{QUIT} = 'IGNORE';
1929   local $SIG{TERM} = 'IGNORE';
1930   local $SIG{TSTP} = 'IGNORE';
1931   local $SIG{PIPE} = 'IGNORE';
1932
1933   my $oldAutoCommit = $FS::UID::AutoCommit;
1934   local $FS::UID::AutoCommit = 0;
1935   my $dbh = dbh;
1936
1937   $self->select_for_update; #mutex
1938
1939   my $balance = $self->balance;
1940   warn "collect customer ". $self->custnum. ": balance $balance\n" if $DEBUG;
1941   unless ( $balance > 0 ) { #redundant?????
1942     $dbh->rollback if $oldAutoCommit; #hmm
1943     return '';
1944   }
1945
1946   if ( exists($options{'retry_card'}) ) {
1947     carp 'retry_card option passed to collect is deprecated; use retry';
1948     $options{'retry'} ||= $options{'retry_card'};
1949   }
1950   if ( exists($options{'retry'}) && $options{'retry'} ) {
1951     my $error = $self->retry_realtime;
1952     if ( $error ) {
1953       $dbh->rollback if $oldAutoCommit;
1954       return $error;
1955     }
1956   }
1957
1958   foreach my $cust_bill ( $self->open_cust_bill ) {
1959
1960     # don't try to charge for the same invoice if it's already in a batch
1961     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1962
1963     last if $self->balance <= 0;
1964
1965     warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n"
1966       if $DEBUG;
1967
1968     foreach my $part_bill_event (
1969       sort {    $a->seconds   <=> $b->seconds
1970              || $a->weight    <=> $b->weight
1971              || $a->eventpart <=> $b->eventpart }
1972         grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1973                && ! qsearch( 'cust_bill_event', {
1974                                 'invnum'    => $cust_bill->invnum,
1975                                 'eventpart' => $_->eventpart,
1976                                 'status'    => 'done',
1977                                                                    } )
1978              }
1979           qsearch('part_bill_event', { 'payby'    => $self->payby,
1980                                        'disabled' => '',           } )
1981     ) {
1982
1983       last if $cust_bill->owed <= 0  # don't run subsequent events if owed<=0
1984            || $self->balance   <= 0; # or if balance<=0
1985
1986       warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1987         if $DEBUG;
1988       my $cust_main = $self; #for callback
1989
1990       my $error;
1991       {
1992         local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1993         local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
1994         $error = eval $part_bill_event->eventcode;
1995       }
1996
1997       my $status = '';
1998       my $statustext = '';
1999       if ( $@ ) {
2000         $status = 'failed';
2001         $statustext = $@;
2002       } elsif ( $error ) {
2003         $status = 'done';
2004         $statustext = $error;
2005       } else {
2006         $status = 'done'
2007       }
2008
2009       #add cust_bill_event
2010       my $cust_bill_event = new FS::cust_bill_event {
2011         'invnum'     => $cust_bill->invnum,
2012         'eventpart'  => $part_bill_event->eventpart,
2013         #'_date'      => $invoice_time,
2014         '_date'      => time,
2015         'status'     => $status,
2016         'statustext' => $statustext,
2017       };
2018       $error = $cust_bill_event->insert;
2019       if ( $error ) {
2020         #$dbh->rollback if $oldAutoCommit;
2021         #return "error: $error";
2022
2023         # gah, even with transactions.
2024         $dbh->commit if $oldAutoCommit; #well.
2025         my $e = 'WARNING: Event run but database not updated - '.
2026                 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
2027                 ', eventpart '. $part_bill_event->eventpart.
2028                 ": $error";
2029         warn $e;
2030         return $e;
2031       }
2032
2033
2034     }
2035
2036   }
2037
2038   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2039   '';
2040
2041 }
2042
2043 =item retry_realtime
2044
2045 Schedules realtime credit card / electronic check / LEC billing events for
2046 for retry.  Useful if card information has changed or manual retry is desired.
2047 The 'collect' method must be called to actually retry the transaction.
2048
2049 Implementation details: For each of this customer's open invoices, changes
2050 the status of the first "done" (with statustext error) realtime processing
2051 event to "failed".
2052
2053 =cut
2054
2055 sub retry_realtime {
2056   my $self = shift;
2057
2058   local $SIG{HUP} = 'IGNORE';
2059   local $SIG{INT} = 'IGNORE';
2060   local $SIG{QUIT} = 'IGNORE';
2061   local $SIG{TERM} = 'IGNORE';
2062   local $SIG{TSTP} = 'IGNORE';
2063   local $SIG{PIPE} = 'IGNORE';
2064
2065   my $oldAutoCommit = $FS::UID::AutoCommit;
2066   local $FS::UID::AutoCommit = 0;
2067   my $dbh = dbh;
2068
2069   foreach my $cust_bill (
2070     grep { $_->cust_bill_event }
2071       $self->open_cust_bill
2072   ) {
2073     my @cust_bill_event =
2074       sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
2075         grep {
2076                #$_->part_bill_event->plan eq 'realtime-card'
2077                $_->part_bill_event->eventcode =~
2078                    /\$cust_bill\->realtime_(card|ach|lec)/
2079                  && $_->status eq 'done'
2080                  && $_->statustext
2081              }
2082           $cust_bill->cust_bill_event;
2083     next unless @cust_bill_event;
2084     my $error = $cust_bill_event[0]->retry;
2085     if ( $error ) {
2086       $dbh->rollback if $oldAutoCommit;
2087       return "error scheduling invoice event for retry: $error";
2088     }
2089
2090   }
2091
2092   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2093   '';
2094
2095 }
2096
2097 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
2098
2099 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
2100 via a Business::OnlinePayment realtime gateway.  See
2101 L<http://420.am/business-onlinepayment> for supported gateways.
2102
2103 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2104
2105 Available options are: I<description>, I<invnum>, I<quiet>
2106
2107 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2108 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2109 if set, will override the value from the customer record.
2110
2111 I<description> is a free-text field passed to the gateway.  It defaults to
2112 "Internet services".
2113
2114 If an I<invnum> is specified, this payment (if sucessful) is applied to the
2115 specified invoice.  If you don't specify an I<invnum> you might want to
2116 call the B<apply_payments> method.
2117
2118 I<quiet> can be set true to surpress email decline notices.
2119
2120 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
2121
2122 =cut
2123
2124 sub realtime_bop {
2125   my( $self, $method, $amount, %options ) = @_;
2126   if ( $DEBUG ) {
2127     warn "$self $method $amount\n";
2128     warn "  $_ => $options{$_}\n" foreach keys %options;
2129   }
2130
2131   $options{'description'} ||= 'Internet services';
2132
2133   eval "use Business::OnlinePayment";
2134   die $@ if $@;
2135
2136   my $payinfo = exists($options{'payinfo'})
2137                   ? $options{'payinfo'}
2138                   : $self->payinfo;
2139
2140   ###
2141   # select a gateway
2142   ###
2143
2144   my $taxclass = '';
2145   if ( $options{'invnum'} ) {
2146     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
2147     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
2148     my @taxclasses =
2149       map  { $_->part_pkg->taxclass }
2150       grep { $_ }
2151       map  { $_->cust_pkg }
2152       $cust_bill->cust_bill_pkg;
2153     unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
2154                                                            #different taxclasses
2155       $taxclass = $taxclasses[0];
2156     }
2157   }
2158
2159   #look for an agent gateway override first
2160   my $cardtype;
2161   if ( $method eq 'CC' ) {
2162     $cardtype = cardtype($payinfo);
2163   } elsif ( $method eq 'ECHECK' ) {
2164     $cardtype = 'ACH';
2165   } else {
2166     $cardtype = $method;
2167   }
2168
2169   my $override =
2170        qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2171                                            cardtype => $cardtype,
2172                                            taxclass => $taxclass,       } )
2173     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2174                                            cardtype => '',
2175                                            taxclass => $taxclass,       } )
2176     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2177                                            cardtype => $cardtype,
2178                                            taxclass => '',              } )
2179     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2180                                            cardtype => '',
2181                                            taxclass => '',              } );
2182
2183   my $payment_gateway = '';
2184   my( $processor, $login, $password, $action, @bop_options );
2185   if ( $override ) { #use a payment gateway override
2186
2187     $payment_gateway = $override->payment_gateway;
2188
2189     $processor   = $payment_gateway->gateway_module;
2190     $login       = $payment_gateway->gateway_username;
2191     $password    = $payment_gateway->gateway_password;
2192     $action      = $payment_gateway->gateway_action;
2193     @bop_options = $payment_gateway->options;
2194
2195   } else { #use the standard settings from the config
2196
2197     ( $processor, $login, $password, $action, @bop_options ) =
2198       $self->default_payment_gateway($method);
2199
2200   }
2201
2202   ###
2203   # massage data
2204   ###
2205
2206   my $address = exists($options{'address1'})
2207                     ? $options{'address1'}
2208                     : $self->address1;
2209   my $address2 = exists($options{'address2'})
2210                     ? $options{'address2'}
2211                     : $self->address2;
2212   $address .= ", ". $address2 if length($address2);
2213
2214   my $o_payname = exists($options{'payname'})
2215                     ? $options{'payname'}
2216                     : $self->payname;
2217   my($payname, $payfirst, $paylast);
2218   if ( $o_payname && $method ne 'ECHECK' ) {
2219     ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2220       or return "Illegal payname $payname";
2221     ($payfirst, $paylast) = ($1, $2);
2222   } else {
2223     $payfirst = $self->getfield('first');
2224     $paylast = $self->getfield('last');
2225     $payname =  "$payfirst $paylast";
2226   }
2227
2228   my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
2229   if ( $conf->exists('emailinvoiceauto')
2230        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
2231     push @invoicing_list, $self->all_emails;
2232   }
2233
2234   my $email = ($conf->exists('business-onlinepayment-email-override'))
2235               ? $conf->config('business-onlinepayment-email-override')
2236               : $invoicing_list[0];
2237
2238   my %content = ();
2239   if ( $method eq 'CC' ) {
2240
2241     $content{card_number} = $payinfo;
2242     my $paydate = exists($options{'paydate'})
2243                     ? $options{'paydate'}
2244                     : $self->paydate;
2245     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2246     $content{expiration} = "$2/$1";
2247
2248     my $paycvv = exists($options{'paycvv'})
2249                    ? $options{'paycvv'}
2250                    : $self->paycvv;
2251     $content{cvv2} = $self->paycvv
2252       if length($paycvv);
2253
2254     my $paystart_month = exists($options{'paystart_month'})
2255                            ? $options{'paystart_month'}
2256                            : $self->paystart_month;
2257
2258     my $paystart_year  = exists($options{'paystart_year'})
2259                            ? $options{'paystart_year'}
2260                            : $self->paystart_year;
2261
2262     $content{card_start} = "$paystart_month/$paystart_year"
2263       if $paystart_month && $paystart_year;
2264
2265     my $payissue       = exists($options{'payissue'})
2266                            ? $options{'payissue'}
2267                            : $self->payissue;
2268     $content{issue_number} = $payissue if $payissue;
2269
2270     my $payip          = exists($options{'payip'})
2271                            ? $options{'payip'}
2272                            : $self->payip;
2273     $content{customer_ip} = $payip
2274       if length($payip);
2275
2276     $content{recurring_billing} = 'YES'
2277       if qsearch('cust_pay', { 'custnum' => $self->custnum,
2278                                'payby'   => 'CARD',
2279                                'payinfo' => $payinfo,
2280                              } );
2281
2282   } elsif ( $method eq 'ECHECK' ) {
2283     ( $content{account_number}, $content{routing_code} ) =
2284       split('@', $payinfo);
2285     $content{bank_name} = $o_payname;
2286     $content{account_type} = 'CHECKING';
2287     $content{account_name} = $payname;
2288     $content{customer_org} = $self->company ? 'B' : 'I';
2289     $content{customer_ssn} = exists($options{'ss'})
2290                                ? $options{'ss'}
2291                                : $self->ss;
2292   } elsif ( $method eq 'LEC' ) {
2293     $content{phone} = $payinfo;
2294   }
2295
2296   ###
2297   # run transaction(s)
2298   ###
2299
2300   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
2301
2302   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
2303   $transaction->content(
2304     'type'           => $method,
2305     'login'          => $login,
2306     'password'       => $password,
2307     'action'         => $action1,
2308     'description'    => $options{'description'},
2309     'amount'         => $amount,
2310     'invoice_number' => $options{'invnum'},
2311     'customer_id'    => $self->custnum,
2312     'last_name'      => $paylast,
2313     'first_name'     => $payfirst,
2314     'name'           => $payname,
2315     'address'        => $address,
2316     'city'           => ( exists($options{'city'})
2317                             ? $options{'city'}
2318                             : $self->city          ),
2319     'state'          => ( exists($options{'state'})
2320                             ? $options{'state'}
2321                             : $self->state          ),
2322     'zip'            => ( exists($options{'zip'})
2323                             ? $options{'zip'}
2324                             : $self->zip          ),
2325     'country'        => ( exists($options{'country'})
2326                             ? $options{'country'}
2327                             : $self->country          ),
2328     'referer'        => 'http://cleanwhisker.420.am/',
2329     'email'          => $email,
2330     'phone'          => $self->daytime || $self->night,
2331     %content, #after
2332   );
2333   $transaction->submit();
2334
2335   if ( $transaction->is_success() && $action2 ) {
2336     my $auth = $transaction->authorization;
2337     my $ordernum = $transaction->can('order_number')
2338                    ? $transaction->order_number
2339                    : '';
2340
2341     my $capture =
2342       new Business::OnlinePayment( $processor, @bop_options );
2343
2344     my %capture = (
2345       %content,
2346       type           => $method,
2347       action         => $action2,
2348       login          => $login,
2349       password       => $password,
2350       order_number   => $ordernum,
2351       amount         => $amount,
2352       authorization  => $auth,
2353       description    => $options{'description'},
2354     );
2355
2356     foreach my $field (qw( authorization_source_code returned_ACI                                          transaction_identifier validation_code
2357                            transaction_sequence_num local_transaction_date
2358                            local_transaction_time AVS_result_code          )) {
2359       $capture{$field} = $transaction->$field() if $transaction->can($field);
2360     }
2361
2362     $capture->content( %capture );
2363
2364     $capture->submit();
2365
2366     unless ( $capture->is_success ) {
2367       my $e = "Authorization sucessful but capture failed, custnum #".
2368               $self->custnum. ': '.  $capture->result_code.
2369               ": ". $capture->error_message;
2370       warn $e;
2371       return $e;
2372     }
2373
2374   }
2375
2376   ###
2377   # remove paycvv after initial transaction
2378   ###
2379
2380   #false laziness w/misc/process/payment.cgi - check both to make sure working
2381   # correctly
2382   if ( defined $self->dbdef_table->column('paycvv')
2383        && length($self->paycvv)
2384        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2385   ) {
2386     my $error = $self->remove_cvv;
2387     if ( $error ) {
2388       warn "error removing cvv: $error\n";
2389     }
2390   }
2391
2392   ###
2393   # result handling
2394   ###
2395
2396   if ( $transaction->is_success() ) {
2397
2398     my %method2payby = (
2399       'CC'     => 'CARD',
2400       'ECHECK' => 'CHEK',
2401       'LEC'    => 'LECB',
2402     );
2403
2404     my $paybatch = '';
2405     if ( $payment_gateway ) { # agent override
2406       $paybatch = $payment_gateway->gatewaynum. '-';
2407     }
2408
2409     $paybatch .= "$processor:". $transaction->authorization;
2410
2411     $paybatch .= ':'. $transaction->order_number
2412       if $transaction->can('order_number')
2413       && length($transaction->order_number);
2414
2415     my $cust_pay = new FS::cust_pay ( {
2416        'custnum'  => $self->custnum,
2417        'invnum'   => $options{'invnum'},
2418        'paid'     => $amount,
2419        '_date'     => '',
2420        'payby'    => $method2payby{$method},
2421        'payinfo'  => $payinfo,
2422        'paybatch' => $paybatch,
2423     } );
2424     my $error = $cust_pay->insert;
2425     if ( $error ) {
2426       $cust_pay->invnum(''); #try again with no specific invnum
2427       my $error2 = $cust_pay->insert;
2428       if ( $error2 ) {
2429         # gah, even with transactions.
2430         my $e = 'WARNING: Card/ACH debited but database not updated - '.
2431                 "error inserting payment ($processor): $error2".
2432                 " (previously tried insert with invnum #$options{'invnum'}" .
2433                 ": $error )";
2434         warn $e;
2435         return $e;
2436       }
2437     }
2438     return ''; #no error
2439
2440   } else {
2441
2442     my $perror = "$processor error: ". $transaction->error_message;
2443
2444     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2445          && $conf->exists('emaildecline')
2446          && grep { $_ ne 'POST' } $self->invoicing_list
2447          && ! grep { $transaction->error_message =~ /$_/ }
2448                    $conf->config('emaildecline-exclude')
2449     ) {
2450       my @templ = $conf->config('declinetemplate');
2451       my $template = new Text::Template (
2452         TYPE   => 'ARRAY',
2453         SOURCE => [ map "$_\n", @templ ],
2454       ) or return "($perror) can't create template: $Text::Template::ERROR";
2455       $template->compile()
2456         or return "($perror) can't compile template: $Text::Template::ERROR";
2457
2458       my $templ_hash = { error => $transaction->error_message };
2459
2460       my $error = send_email(
2461         'from'    => $conf->config('invoice_from'),
2462         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2463         'subject' => 'Your payment could not be processed',
2464         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
2465       );
2466
2467       $perror .= " (also received error sending decline notification: $error)"
2468         if $error;
2469
2470     }
2471
2472     return $perror;
2473   }
2474
2475 }
2476
2477 =item default_payment_gateway
2478
2479 =cut
2480
2481 sub default_payment_gateway {
2482   my( $self, $method ) = @_;
2483
2484   die "Real-time processing not enabled\n"
2485     unless $conf->exists('business-onlinepayment');
2486
2487   #load up config
2488   my $bop_config = 'business-onlinepayment';
2489   $bop_config .= '-ach'
2490     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2491   my ( $processor, $login, $password, $action, @bop_options ) =
2492     $conf->config($bop_config);
2493   $action ||= 'normal authorization';
2494   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2495   die "No real-time processor is enabled - ".
2496       "did you set the business-onlinepayment configuration value?\n"
2497     unless $processor;
2498
2499   ( $processor, $login, $password, $action, @bop_options )
2500 }
2501
2502 =item remove_cvv
2503
2504 Removes the I<paycvv> field from the database directly.
2505
2506 If there is an error, returns the error, otherwise returns false.
2507
2508 =cut
2509
2510 sub remove_cvv {
2511   my $self = shift;
2512   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2513     or return dbh->errstr;
2514   $sth->execute($self->custnum)
2515     or return $sth->errstr;
2516   $self->paycvv('');
2517   '';
2518 }
2519
2520 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2521
2522 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2523 via a Business::OnlinePayment realtime gateway.  See
2524 L<http://420.am/business-onlinepayment> for supported gateways.
2525
2526 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2527
2528 Available options are: I<amount>, I<reason>, I<paynum>
2529
2530 Most gateways require a reference to an original payment transaction to refund,
2531 so you probably need to specify a I<paynum>.
2532
2533 I<amount> defaults to the original amount of the payment if not specified.
2534
2535 I<reason> specifies a reason for the refund.
2536
2537 Implementation note: If I<amount> is unspecified or equal to the amount of the
2538 orignal payment, first an attempt is made to "void" the transaction via
2539 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2540 the normal attempt is made to "refund" ("credit") the transaction via the
2541 gateway is attempted.
2542
2543 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2544 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2545 #if set, will override the value from the customer record.
2546
2547 #If an I<invnum> is specified, this payment (if sucessful) is applied to the
2548 #specified invoice.  If you don't specify an I<invnum> you might want to
2549 #call the B<apply_payments> method.
2550
2551 =cut
2552
2553 #some false laziness w/realtime_bop, not enough to make it worth merging
2554 #but some useful small subs should be pulled out
2555 sub realtime_refund_bop {
2556   my( $self, $method, %options ) = @_;
2557   if ( $DEBUG ) {
2558     warn "$self $method refund\n";
2559     warn "  $_ => $options{$_}\n" foreach keys %options;
2560   }
2561
2562   eval "use Business::OnlinePayment";
2563   die $@ if $@;
2564
2565   ###
2566   # look up the original payment and optionally a gateway for that payment
2567   ###
2568
2569   my $cust_pay = '';
2570   my $amount = $options{'amount'};
2571
2572   my( $processor, $login, $password, @bop_options ) ;
2573   my( $auth, $order_number ) = ( '', '', '' );
2574
2575   if ( $options{'paynum'} ) {
2576
2577     warn "FS::cust_main::realtime_bop: paynum: $options{paynum}\n" if $DEBUG;
2578     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2579       or return "Unknown paynum $options{'paynum'}";
2580     $amount ||= $cust_pay->paid;
2581
2582     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/
2583       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2584                 $cust_pay->paybatch;
2585     my $gatewaynum = '';
2586     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
2587
2588     if ( $gatewaynum ) { #gateway for the payment to be refunded
2589
2590       my $payment_gateway =
2591         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
2592       die "payment gateway $gatewaynum not found"
2593         unless $payment_gateway;
2594
2595       $processor   = $payment_gateway->gateway_module;
2596       $login       = $payment_gateway->gateway_username;
2597       $password    = $payment_gateway->gateway_password;
2598       @bop_options = $payment_gateway->options;
2599
2600     } else { #try the default gateway
2601
2602       my( $conf_processor, $unused_action );
2603       ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
2604         $self->default_payment_gateway($method);
2605
2606       return "processor of payment $options{'paynum'} $processor does not".
2607              " match default processor $conf_processor"
2608         unless $processor eq $conf_processor;
2609
2610     }
2611
2612
2613   } else { # didn't specify a paynum, so look for agent gateway overrides
2614            # like a normal transaction
2615
2616     my $cardtype;
2617     if ( $method eq 'CC' ) {
2618       $cardtype = cardtype($self->payinfo);
2619     } elsif ( $method eq 'ECHECK' ) {
2620       $cardtype = 'ACH';
2621     } else {
2622       $cardtype = $method;
2623     }
2624     my $override =
2625            qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2626                                                cardtype => $cardtype,
2627                                                taxclass => '',              } )
2628         || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2629                                                cardtype => '',
2630                                                taxclass => '',              } );
2631
2632     if ( $override ) { #use a payment gateway override
2633
2634       my $payment_gateway = $override->payment_gateway;
2635
2636       $processor   = $payment_gateway->gateway_module;
2637       $login       = $payment_gateway->gateway_username;
2638       $password    = $payment_gateway->gateway_password;
2639       #$action      = $payment_gateway->gateway_action;
2640       @bop_options = $payment_gateway->options;
2641
2642     } else { #use the standard settings from the config
2643
2644       my $unused_action;
2645       ( $processor, $login, $password, $unused_action, @bop_options ) =
2646         $self->default_payment_gateway($method);
2647
2648     }
2649
2650   }
2651   return "neither amount nor paynum specified" unless $amount;
2652
2653   my %content = (
2654     'type'           => $method,
2655     'login'          => $login,
2656     'password'       => $password,
2657     'order_number'   => $order_number,
2658     'amount'         => $amount,
2659     'referer'        => 'http://cleanwhisker.420.am/',
2660   );
2661   $content{authorization} = $auth
2662     if length($auth); #echeck/ACH transactions have an order # but no auth
2663                       #(at least with authorize.net)
2664
2665   #first try void if applicable
2666   if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2667     warn "FS::cust_main::realtime_bop: attempting void\n" if $DEBUG;
2668     my $void = new Business::OnlinePayment( $processor, @bop_options );
2669     $void->content( 'action' => 'void', %content );
2670     $void->submit();
2671     if ( $void->is_success ) {
2672       my $error = $cust_pay->void($options{'reason'});
2673       if ( $error ) {
2674         # gah, even with transactions.
2675         my $e = 'WARNING: Card/ACH voided but database not updated - '.
2676                 "error voiding payment: $error";
2677         warn $e;
2678         return $e;
2679       }
2680       warn "FS::cust_main::realtime_bop: void successful\n" if $DEBUG;
2681       return '';
2682     }
2683   }
2684
2685   warn "FS::cust_main::realtime_bop: void unsuccessful, trying refund\n"
2686     if $DEBUG;
2687
2688   #massage data
2689   my $address = $self->address1;
2690   $address .= ", ". $self->address2 if $self->address2;
2691
2692   my($payname, $payfirst, $paylast);
2693   if ( $self->payname && $method ne 'ECHECK' ) {
2694     $payname = $self->payname;
2695     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2696       or return "Illegal payname $payname";
2697     ($payfirst, $paylast) = ($1, $2);
2698   } else {
2699     $payfirst = $self->getfield('first');
2700     $paylast = $self->getfield('last');
2701     $payname =  "$payfirst $paylast";
2702   }
2703
2704   my $payinfo = '';
2705   if ( $method eq 'CC' ) {
2706
2707     if ( $cust_pay ) {
2708       $content{card_number} = $payinfo = $cust_pay->payinfo;
2709       #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2710       #$content{expiration} = "$2/$1";
2711     } else {
2712       $content{card_number} = $payinfo = $self->payinfo;
2713       $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2714       $content{expiration} = "$2/$1";
2715     }
2716
2717   } elsif ( $method eq 'ECHECK' ) {
2718     ( $content{account_number}, $content{routing_code} ) =
2719       split('@', $payinfo = $self->payinfo);
2720     $content{bank_name} = $self->payname;
2721     $content{account_type} = 'CHECKING';
2722     $content{account_name} = $payname;
2723     $content{customer_org} = $self->company ? 'B' : 'I';
2724     $content{customer_ssn} = $self->ss;
2725   } elsif ( $method eq 'LEC' ) {
2726     $content{phone} = $payinfo = $self->payinfo;
2727   }
2728
2729   #then try refund
2730   my $refund = new Business::OnlinePayment( $processor, @bop_options );
2731   my %sub_content = $refund->content(
2732     'action'         => 'credit',
2733     'customer_id'    => $self->custnum,
2734     'last_name'      => $paylast,
2735     'first_name'     => $payfirst,
2736     'name'           => $payname,
2737     'address'        => $address,
2738     'city'           => $self->city,
2739     'state'          => $self->state,
2740     'zip'            => $self->zip,
2741     'country'        => $self->country,
2742     %content, #after
2743   );
2744   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
2745     if $DEBUG > 1;
2746   $refund->submit();
2747
2748   return "$processor error: ". $refund->error_message
2749     unless $refund->is_success();
2750
2751   my %method2payby = (
2752     'CC'     => 'CARD',
2753     'ECHECK' => 'CHEK',
2754     'LEC'    => 'LECB',
2755   );
2756
2757   my $paybatch = "$processor:". $refund->authorization;
2758   $paybatch .= ':'. $refund->order_number
2759     if $refund->can('order_number') && $refund->order_number;
2760
2761   while ( $cust_pay && $cust_pay->unappled < $amount ) {
2762     my @cust_bill_pay = $cust_pay->cust_bill_pay;
2763     last unless @cust_bill_pay;
2764     my $cust_bill_pay = pop @cust_bill_pay;
2765     my $error = $cust_bill_pay->delete;
2766     last if $error;
2767   }
2768
2769   my $cust_refund = new FS::cust_refund ( {
2770     'custnum'  => $self->custnum,
2771     'paynum'   => $options{'paynum'},
2772     'refund'   => $amount,
2773     '_date'    => '',
2774     'payby'    => $method2payby{$method},
2775     'payinfo'  => $payinfo,
2776     'paybatch' => $paybatch,
2777     'reason'   => $options{'reason'} || 'card or ACH refund',
2778   } );
2779   my $error = $cust_refund->insert;
2780   if ( $error ) {
2781     $cust_refund->paynum(''); #try again with no specific paynum
2782     my $error2 = $cust_refund->insert;
2783     if ( $error2 ) {
2784       # gah, even with transactions.
2785       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2786               "error inserting refund ($processor): $error2".
2787               " (previously tried insert with paynum #$options{'paynum'}" .
2788               ": $error )";
2789       warn $e;
2790       return $e;
2791     }
2792   }
2793
2794   ''; #no error
2795
2796 }
2797
2798 =item total_owed
2799
2800 Returns the total owed for this customer on all invoices
2801 (see L<FS::cust_bill/owed>).
2802
2803 =cut
2804
2805 sub total_owed {
2806   my $self = shift;
2807   $self->total_owed_date(2145859200); #12/31/2037
2808 }
2809
2810 =item total_owed_date TIME
2811
2812 Returns the total owed for this customer on all invoices with date earlier than
2813 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2814 see L<Time::Local> and L<Date::Parse> for conversion functions.
2815
2816 =cut
2817
2818 sub total_owed_date {
2819   my $self = shift;
2820   my $time = shift;
2821   my $total_bill = 0;
2822   foreach my $cust_bill (
2823     grep { $_->_date <= $time }
2824       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2825   ) {
2826     $total_bill += $cust_bill->owed;
2827   }
2828   sprintf( "%.2f", $total_bill );
2829 }
2830
2831 =item apply_credits OPTION => VALUE ...
2832
2833 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2834 to outstanding invoice balances in chronological order (or reverse
2835 chronological order if the I<order> option is set to B<newest>) and returns the
2836 value of any remaining unapplied credits available for refund (see
2837 L<FS::cust_refund>).
2838
2839 =cut
2840
2841 sub apply_credits {
2842   my $self = shift;
2843   my %opt = @_;
2844
2845   return 0 unless $self->total_credited;
2846
2847   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2848       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2849
2850   my @invoices = $self->open_cust_bill;
2851   @invoices = sort { $b->_date <=> $a->_date } @invoices
2852     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2853
2854   my $credit;
2855   foreach my $cust_bill ( @invoices ) {
2856     my $amount;
2857
2858     if ( !defined($credit) || $credit->credited == 0) {
2859       $credit = pop @credits or last;
2860     }
2861
2862     if ($cust_bill->owed >= $credit->credited) {
2863       $amount=$credit->credited;
2864     }else{
2865       $amount=$cust_bill->owed;
2866     }
2867
2868     my $cust_credit_bill = new FS::cust_credit_bill ( {
2869       'crednum' => $credit->crednum,
2870       'invnum'  => $cust_bill->invnum,
2871       'amount'  => $amount,
2872     } );
2873     my $error = $cust_credit_bill->insert;
2874     die $error if $error;
2875
2876     redo if ($cust_bill->owed > 0);
2877
2878   }
2879
2880   return $self->total_credited;
2881 }
2882
2883 =item apply_payments
2884
2885 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2886 to outstanding invoice balances in chronological order.
2887
2888  #and returns the value of any remaining unapplied payments.
2889
2890 =cut
2891
2892 sub apply_payments {
2893   my $self = shift;
2894
2895   #return 0 unless
2896
2897   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2898       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
2899
2900   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2901       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2902
2903   my $payment;
2904
2905   foreach my $cust_bill ( @invoices ) {
2906     my $amount;
2907
2908     if ( !defined($payment) || $payment->unapplied == 0 ) {
2909       $payment = pop @payments or last;
2910     }
2911
2912     if ( $cust_bill->owed >= $payment->unapplied ) {
2913       $amount = $payment->unapplied;
2914     } else {
2915       $amount = $cust_bill->owed;
2916     }
2917
2918     my $cust_bill_pay = new FS::cust_bill_pay ( {
2919       'paynum' => $payment->paynum,
2920       'invnum' => $cust_bill->invnum,
2921       'amount' => $amount,
2922     } );
2923     my $error = $cust_bill_pay->insert;
2924     die $error if $error;
2925
2926     redo if ( $cust_bill->owed > 0);
2927
2928   }
2929
2930   return $self->total_unapplied_payments;
2931 }
2932
2933 =item total_credited
2934
2935 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2936 customer.  See L<FS::cust_credit/credited>.
2937
2938 =cut
2939
2940 sub total_credited {
2941   my $self = shift;
2942   my $total_credit = 0;
2943   foreach my $cust_credit ( qsearch('cust_credit', {
2944     'custnum' => $self->custnum,
2945   } ) ) {
2946     $total_credit += $cust_credit->credited;
2947   }
2948   sprintf( "%.2f", $total_credit );
2949 }
2950
2951 =item total_unapplied_payments
2952
2953 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2954 See L<FS::cust_pay/unapplied>.
2955
2956 =cut
2957
2958 sub total_unapplied_payments {
2959   my $self = shift;
2960   my $total_unapplied = 0;
2961   foreach my $cust_pay ( qsearch('cust_pay', {
2962     'custnum' => $self->custnum,
2963   } ) ) {
2964     $total_unapplied += $cust_pay->unapplied;
2965   }
2966   sprintf( "%.2f", $total_unapplied );
2967 }
2968
2969 =item balance
2970
2971 Returns the balance for this customer (total_owed minus total_credited
2972 minus total_unapplied_payments).
2973
2974 =cut
2975
2976 sub balance {
2977   my $self = shift;
2978   sprintf( "%.2f",
2979     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2980   );
2981 }
2982
2983 =item balance_date TIME
2984
2985 Returns the balance for this customer, only considering invoices with date
2986 earlier than TIME (total_owed_date minus total_credited minus
2987 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
2988 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
2989 functions.
2990
2991 =cut
2992
2993 sub balance_date {
2994   my $self = shift;
2995   my $time = shift;
2996   sprintf( "%.2f",
2997     $self->total_owed_date($time)
2998       - $self->total_credited
2999       - $self->total_unapplied_payments
3000   );
3001 }
3002
3003 =item paydate_monthyear
3004
3005 Returns a two-element list consisting of the month and year of this customer's
3006 paydate (credit card expiration date for CARD customers)
3007
3008 =cut
3009
3010 sub paydate_monthyear {
3011   my $self = shift;
3012   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3013     ( $2, $1 );
3014   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3015     ( $1, $3 );
3016   } else {
3017     ('', '');
3018   }
3019 }
3020
3021 =item payinfo_masked
3022
3023 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.
3024
3025 Credit Cards - Mask all but the last four characters.
3026 Checks - Mask all but last 2 of account number and bank routing number.
3027 Others - Do nothing, return the unmasked string.
3028
3029 =cut
3030
3031 sub payinfo_masked {
3032   my $self = shift;
3033   return $self->paymask;
3034 }
3035
3036 =item invoicing_list [ ARRAYREF ]
3037
3038 If an arguement is given, sets these email addresses as invoice recipients
3039 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
3040 (except as warnings), so use check_invoicing_list first.
3041
3042 Returns a list of email addresses (with svcnum entries expanded).
3043
3044 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
3045 check it without disturbing anything by passing nothing.
3046
3047 This interface may change in the future.
3048
3049 =cut
3050
3051 sub invoicing_list {
3052   my( $self, $arrayref ) = @_;
3053   if ( $arrayref ) {
3054     my @cust_main_invoice;
3055     if ( $self->custnum ) {
3056       @cust_main_invoice =
3057         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3058     } else {
3059       @cust_main_invoice = ();
3060     }
3061     foreach my $cust_main_invoice ( @cust_main_invoice ) {
3062       #warn $cust_main_invoice->destnum;
3063       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3064         #warn $cust_main_invoice->destnum;
3065         my $error = $cust_main_invoice->delete;
3066         warn $error if $error;
3067       }
3068     }
3069     if ( $self->custnum ) {
3070       @cust_main_invoice =
3071         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3072     } else {
3073       @cust_main_invoice = ();
3074     }
3075     my %seen = map { $_->address => 1 } @cust_main_invoice;
3076     foreach my $address ( @{$arrayref} ) {
3077       next if exists $seen{$address} && $seen{$address};
3078       $seen{$address} = 1;
3079       my $cust_main_invoice = new FS::cust_main_invoice ( {
3080         'custnum' => $self->custnum,
3081         'dest'    => $address,
3082       } );
3083       my $error = $cust_main_invoice->insert;
3084       warn $error if $error;
3085     }
3086   }
3087   if ( $self->custnum ) {
3088     map { $_->address }
3089       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3090   } else {
3091     ();
3092   }
3093 }
3094
3095 =item check_invoicing_list ARRAYREF
3096
3097 Checks these arguements as valid input for the invoicing_list method.  If there
3098 is an error, returns the error, otherwise returns false.
3099
3100 =cut
3101
3102 sub check_invoicing_list {
3103   my( $self, $arrayref ) = @_;
3104   foreach my $address ( @{$arrayref} ) {
3105
3106     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3107       return 'Can\'t add FAX invoice destination with a blank FAX number.';
3108     }
3109
3110     my $cust_main_invoice = new FS::cust_main_invoice ( {
3111       'custnum' => $self->custnum,
3112       'dest'    => $address,
3113     } );
3114     my $error = $self->custnum
3115                 ? $cust_main_invoice->check
3116                 : $cust_main_invoice->checkdest
3117     ;
3118     return $error if $error;
3119   }
3120   '';
3121 }
3122
3123 =item set_default_invoicing_list
3124
3125 Sets the invoicing list to all accounts associated with this customer,
3126 overwriting any previous invoicing list.
3127
3128 =cut
3129
3130 sub set_default_invoicing_list {
3131   my $self = shift;
3132   $self->invoicing_list($self->all_emails);
3133 }
3134
3135 =item all_emails
3136
3137 Returns the email addresses of all accounts provisioned for this customer.
3138
3139 =cut
3140
3141 sub all_emails {
3142   my $self = shift;
3143   my %list;
3144   foreach my $cust_pkg ( $self->all_pkgs ) {
3145     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3146     my @svc_acct =
3147       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3148         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3149           @cust_svc;
3150     $list{$_}=1 foreach map { $_->email } @svc_acct;
3151   }
3152   keys %list;
3153 }
3154
3155 =item invoicing_list_addpost
3156
3157 Adds postal invoicing to this customer.  If this customer is already configured
3158 to receive postal invoices, does nothing.
3159
3160 =cut
3161
3162 sub invoicing_list_addpost {
3163   my $self = shift;
3164   return if grep { $_ eq 'POST' } $self->invoicing_list;
3165   my @invoicing_list = $self->invoicing_list;
3166   push @invoicing_list, 'POST';
3167   $self->invoicing_list(\@invoicing_list);
3168 }
3169
3170 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3171
3172 Returns an array of customers referred by this customer (referral_custnum set
3173 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3174 customers referred by customers referred by this customer and so on, inclusive.
3175 The default behavior is DEPTH 1 (no recursion).
3176
3177 =cut
3178
3179 sub referral_cust_main {
3180   my $self = shift;
3181   my $depth = @_ ? shift : 1;
3182   my $exclude = @_ ? shift : {};
3183
3184   my @cust_main =
3185     map { $exclude->{$_->custnum}++; $_; }
3186       grep { ! $exclude->{ $_->custnum } }
3187         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3188
3189   if ( $depth > 1 ) {
3190     push @cust_main,
3191       map { $_->referral_cust_main($depth-1, $exclude) }
3192         @cust_main;
3193   }
3194
3195   @cust_main;
3196 }
3197
3198 =item referral_cust_main_ncancelled
3199
3200 Same as referral_cust_main, except only returns customers with uncancelled
3201 packages.
3202
3203 =cut
3204
3205 sub referral_cust_main_ncancelled {
3206   my $self = shift;
3207   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3208 }
3209
3210 =item referral_cust_pkg [ DEPTH ]
3211
3212 Like referral_cust_main, except returns a flat list of all unsuspended (and
3213 uncancelled) packages for each customer.  The number of items in this list may
3214 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3215
3216 =cut
3217
3218 sub referral_cust_pkg {
3219   my $self = shift;
3220   my $depth = @_ ? shift : 1;
3221
3222   map { $_->unsuspended_pkgs }
3223     grep { $_->unsuspended_pkgs }
3224       $self->referral_cust_main($depth);
3225 }
3226
3227 =item referring_cust_main
3228
3229 Returns the single cust_main record for the customer who referred this customer
3230 (referral_custnum), or false.
3231
3232 =cut
3233
3234 sub referring_cust_main {
3235   my $self = shift;
3236   return '' unless $self->referral_custnum;
3237   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3238 }
3239
3240 =item credit AMOUNT, REASON
3241
3242 Applies a credit to this customer.  If there is an error, returns the error,
3243 otherwise returns false.
3244
3245 =cut
3246
3247 sub credit {
3248   my( $self, $amount, $reason ) = @_;
3249   my $cust_credit = new FS::cust_credit {
3250     'custnum' => $self->custnum,
3251     'amount'  => $amount,
3252     'reason'  => $reason,
3253   };
3254   $cust_credit->insert;
3255 }
3256
3257 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3258
3259 Creates a one-time charge for this customer.  If there is an error, returns
3260 the error, otherwise returns false.
3261
3262 =cut
3263
3264 sub charge {
3265   my ( $self, $amount ) = ( shift, shift );
3266   my $pkg      = @_ ? shift : 'One-time charge';
3267   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
3268   my $taxclass = @_ ? shift : '';
3269
3270   local $SIG{HUP} = 'IGNORE';
3271   local $SIG{INT} = 'IGNORE';
3272   local $SIG{QUIT} = 'IGNORE';
3273   local $SIG{TERM} = 'IGNORE';
3274   local $SIG{TSTP} = 'IGNORE';
3275   local $SIG{PIPE} = 'IGNORE';
3276
3277   my $oldAutoCommit = $FS::UID::AutoCommit;
3278   local $FS::UID::AutoCommit = 0;
3279   my $dbh = dbh;
3280
3281   my $part_pkg = new FS::part_pkg ( {
3282     'pkg'      => $pkg,
3283     'comment'  => $comment,
3284     #'setup'    => $amount,
3285     #'recur'    => '0',
3286     'plan'     => 'flat',
3287     'plandata' => "setup_fee=$amount",
3288     'freq'     => 0,
3289     'disabled' => 'Y',
3290     'taxclass' => $taxclass,
3291   } );
3292
3293   my $error = $part_pkg->insert;
3294   if ( $error ) {
3295     $dbh->rollback if $oldAutoCommit;
3296     return $error;
3297   }
3298
3299   my $pkgpart = $part_pkg->pkgpart;
3300   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3301   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3302     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3303     $error = $type_pkgs->insert;
3304     if ( $error ) {
3305       $dbh->rollback if $oldAutoCommit;
3306       return $error;
3307     }
3308   }
3309
3310   my $cust_pkg = new FS::cust_pkg ( {
3311     'custnum' => $self->custnum,
3312     'pkgpart' => $pkgpart,
3313   } );
3314
3315   $error = $cust_pkg->insert;
3316   if ( $error ) {
3317     $dbh->rollback if $oldAutoCommit;
3318     return $error;
3319   }
3320
3321   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3322   '';
3323
3324 }
3325
3326 =item cust_bill
3327
3328 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3329
3330 =cut
3331
3332 sub cust_bill {
3333   my $self = shift;
3334   sort { $a->_date <=> $b->_date }
3335     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3336 }
3337
3338 =item open_cust_bill
3339
3340 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3341 customer.
3342
3343 =cut
3344
3345 sub open_cust_bill {
3346   my $self = shift;
3347   grep { $_->owed > 0 } $self->cust_bill;
3348 }
3349
3350 =item cust_credit
3351
3352 Returns all the credits (see L<FS::cust_credit>) for this customer.
3353
3354 =cut
3355
3356 sub cust_credit {
3357   my $self = shift;
3358   sort { $a->_date <=> $b->_date }
3359     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3360 }
3361
3362 =item cust_pay
3363
3364 Returns all the payments (see L<FS::cust_pay>) for this customer.
3365
3366 =cut
3367
3368 sub cust_pay {
3369   my $self = shift;
3370   sort { $a->_date <=> $b->_date }
3371     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3372 }
3373
3374 =item cust_pay_void
3375
3376 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3377
3378 =cut
3379
3380 sub cust_pay_void {
3381   my $self = shift;
3382   sort { $a->_date <=> $b->_date }
3383     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3384 }
3385
3386
3387 =item cust_refund
3388
3389 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3390
3391 =cut
3392
3393 sub cust_refund {
3394   my $self = shift;
3395   sort { $a->_date <=> $b->_date }
3396     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3397 }
3398
3399 =item select_for_update
3400
3401 Selects this record with the SQL "FOR UPDATE" command.  This can be useful as
3402 a mutex.
3403
3404 =cut
3405
3406 sub select_for_update {
3407   my $self = shift;
3408   qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
3409 }
3410
3411 =item name
3412
3413 Returns a name string for this customer, either "Company (Last, First)" or
3414 "Last, First".
3415
3416 =cut
3417
3418 sub name {
3419   my $self = shift;
3420   my $name = $self->contact;
3421   $name = $self->company. " ($name)" if $self->company;
3422   $name;
3423 }
3424
3425 =item ship_name
3426
3427 Returns a name string for this (service/shipping) contact, either
3428 "Company (Last, First)" or "Last, First".
3429
3430 =cut
3431
3432 sub ship_name {
3433   my $self = shift;
3434   if ( $self->get('ship_last') ) {
3435     my $name = $self->ship_contact;
3436     $name = $self->ship_company. " ($name)" if $self->ship_company;
3437     $name;
3438   } else {
3439     $self->name;
3440   }
3441 }
3442
3443 =item contact
3444
3445 Returns this customer's full (billing) contact name only, "Last, First"
3446
3447 =cut
3448
3449 sub contact {
3450   my $self = shift;
3451   $self->get('last'). ', '. $self->first;
3452 }
3453
3454 =item ship_contact
3455
3456 Returns this customer's full (shipping) contact name only, "Last, First"
3457
3458 =cut
3459
3460 sub ship_contact {
3461   my $self = shift;
3462   $self->get('ship_last')
3463     ? $self->get('ship_last'). ', '. $self->ship_first
3464     : $self->contact;
3465 }
3466
3467 =item status
3468
3469 Returns a status string for this customer, currently:
3470
3471 =over 4
3472
3473 =item prospect - No packages have ever been ordered
3474
3475 =item active - One or more recurring packages is active
3476
3477 =item suspended - All non-cancelled recurring packages are suspended
3478
3479 =item cancelled - All recurring packages are cancelled
3480
3481 =back
3482
3483 =cut
3484
3485 sub status {
3486   my $self = shift;
3487   for my $status (qw( prospect active suspended cancelled )) {
3488     my $method = $status.'_sql';
3489     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3490     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3491     $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
3492     return $status if $sth->fetchrow_arrayref->[0];
3493   }
3494 }
3495
3496 =item statuscolor
3497
3498 Returns a hex triplet color string for this customer's status.
3499
3500 =cut
3501
3502 my %statuscolor = (
3503   'prospect'  => '000000',
3504   'active'    => '00CC00',
3505   'suspended' => 'FF9900',
3506   'cancelled' => 'FF0000',
3507 );
3508 sub statuscolor {
3509   my $self = shift;
3510   $statuscolor{$self->status};
3511 }
3512
3513 =back
3514
3515 =head1 CLASS METHODS
3516
3517 =over 4
3518
3519 =item prospect_sql
3520
3521 Returns an SQL expression identifying prospective cust_main records (customers
3522 with no packages ever ordered)
3523
3524 =cut
3525
3526 sub prospect_sql { "
3527   0 = ( SELECT COUNT(*) FROM cust_pkg
3528           WHERE cust_pkg.custnum = cust_main.custnum
3529       )
3530 "; }
3531
3532 =item active_sql
3533
3534 Returns an SQL expression identifying active cust_main records.
3535
3536 =cut
3537
3538 sub active_sql { "
3539   0 < ( SELECT COUNT(*) FROM cust_pkg
3540           WHERE cust_pkg.custnum = cust_main.custnum
3541             AND ". FS::cust_pkg->active_sql. "
3542       )
3543 "; }
3544
3545 =item susp_sql
3546 =item suspended_sql
3547
3548 Returns an SQL expression identifying suspended cust_main records.
3549
3550 =cut
3551
3552 #my $recurring_sql = FS::cust_pkg->recurring_sql;
3553 my $recurring_sql = "
3554   '0' != ( select freq from part_pkg
3555              where cust_pkg.pkgpart = part_pkg.pkgpart )
3556 ";
3557
3558 sub suspended_sql { susp_sql(@_); }
3559 sub susp_sql { "
3560     0 < ( SELECT COUNT(*) FROM cust_pkg
3561             WHERE cust_pkg.custnum = cust_main.custnum
3562               AND $recurring_sql
3563               AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3564         )
3565     AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3566                 WHERE cust_pkg.custnum = cust_main.custnum
3567                   AND ". FS::cust_pkg->active_sql. "
3568             )
3569 "; }
3570
3571 =item cancel_sql
3572 =item cancelled_sql
3573
3574 Returns an SQL expression identifying cancelled cust_main records.
3575
3576 =cut
3577
3578 sub cancelled_sql { cancel_sql(@_); }
3579 sub cancel_sql { "
3580   0 < ( SELECT COUNT(*) FROM cust_pkg
3581           WHERE cust_pkg.custnum = cust_main.custnum
3582       )
3583   AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3584               WHERE cust_pkg.custnum = cust_main.custnum
3585                 AND $recurring_sql
3586                 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3587           )
3588 "; }
3589
3590 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3591
3592 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3593 records.  Currently, only I<last> or I<company> may be specified (the
3594 appropriate ship_ field is also searched if applicable).
3595
3596 Additional options are the same as FS::Record::qsearch
3597
3598 =cut
3599
3600 sub fuzzy_search {
3601   my( $self, $fuzzy, $hash, @opt) = @_;
3602   #$self
3603   $hash ||= {};
3604   my @cust_main = ();
3605
3606   check_and_rebuild_fuzzyfiles();
3607   foreach my $field ( keys %$fuzzy ) {
3608     my $sub = \&{"all_$field"};
3609     my %match = ();
3610     $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
3611
3612     foreach ( keys %match ) {
3613       push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3614       push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
3615         if defined dbdef->table('cust_main')->column('ship_last');
3616     }
3617   }
3618
3619   my %saw = ();
3620   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
3621
3622   @cust_main;
3623
3624 }
3625
3626 =back
3627
3628 =head1 SUBROUTINES
3629
3630 =over 4
3631
3632 =item smart_search OPTION => VALUE ...
3633
3634 Accepts the following options: I<search>, the string to search for.  The string
3635 will be searched for as a customer number, last name or company name, first
3636 searching for an exact match then fuzzy and substring matches.
3637
3638 Any additional options treated as an additional qualifier on the search
3639 (i.e. I<agentnum>).
3640
3641 Returns a (possibly empty) array of FS::cust_main objects.
3642
3643 =cut
3644
3645 sub smart_search {
3646   my %options = @_;
3647   my $search = delete $options{'search'};
3648   my @cust_main = ();
3649
3650   if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3651
3652     push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } );
3653
3654   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3655
3656     my $value = lc($1);
3657     my $q_value = dbh->quote($value);
3658
3659     #exact
3660     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3661     $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3662     $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3663       if defined dbdef->table('cust_main')->column('ship_last');
3664     $sql .= ' )';
3665
3666     push @cust_main, qsearch( 'cust_main', \%options, '', $sql );
3667
3668     unless ( @cust_main ) {  #no exact match, trying substring/fuzzy
3669
3670       #still some false laziness w/ search/cust_main.cgi
3671
3672       #substring
3673       push @cust_main, qsearch( 'cust_main',
3674                                 { 'last'     => { 'op'    => 'ILIKE',
3675                                                   'value' => "%$q_value%" },
3676                                   %options,
3677                                 }
3678                               );
3679       push @cust_main, qsearch( 'cust_main',
3680                                 { 'ship_last' => { 'op'    => 'ILIKE',
3681                                                    'value' => "%$q_value%" },
3682                                   %options,
3683
3684                                 }
3685                               )
3686         if defined dbdef->table('cust_main')->column('ship_last');
3687
3688       push @cust_main, qsearch( 'cust_main',
3689                                 { 'company'  => { 'op'    => 'ILIKE',
3690                                                   'value' => "%$q_value%" },
3691                                   %options,
3692                                 }
3693                               );
3694       push @cust_main, qsearch( 'cust_main',
3695                                 { 'ship_company' => { 'op' => 'ILIKE',
3696                                                    'value' => "%$q_value%" },
3697                                   %options,
3698                                 }
3699                               )
3700         if defined dbdef->table('cust_main')->column('ship_last');
3701
3702       #fuzzy
3703       push @cust_main, FS::cust_main->fuzzy_search(
3704         { 'last'     => $value },
3705         \%options,
3706       );
3707       push @cust_main, FS::cust_main->fuzzy_search(
3708         { 'company'  => $value },
3709         \%options,
3710       );
3711
3712     }
3713
3714   }
3715
3716   @cust_main;
3717
3718 }
3719
3720 =item check_and_rebuild_fuzzyfiles
3721
3722 =cut
3723
3724 sub check_and_rebuild_fuzzyfiles {
3725   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3726   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3727     or &rebuild_fuzzyfiles;
3728 }
3729
3730 =item rebuild_fuzzyfiles
3731
3732 =cut
3733
3734 sub rebuild_fuzzyfiles {
3735
3736   use Fcntl qw(:flock);
3737
3738   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3739
3740   #last
3741
3742   open(LASTLOCK,">>$dir/cust_main.last")
3743     or die "can't open $dir/cust_main.last: $!";
3744   flock(LASTLOCK,LOCK_EX)
3745     or die "can't lock $dir/cust_main.last: $!";
3746
3747   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3748   push @all_last,
3749                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3750     if defined dbdef->table('cust_main')->column('ship_last');
3751
3752   open (LASTCACHE,">$dir/cust_main.last.tmp")
3753     or die "can't open $dir/cust_main.last.tmp: $!";
3754   print LASTCACHE join("\n", @all_last), "\n";
3755   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3756
3757   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3758   close LASTLOCK;
3759
3760   #company
3761
3762   open(COMPANYLOCK,">>$dir/cust_main.company")
3763     or die "can't open $dir/cust_main.company: $!";
3764   flock(COMPANYLOCK,LOCK_EX)
3765     or die "can't lock $dir/cust_main.company: $!";
3766
3767   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3768   push @all_company,
3769        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3770     if defined dbdef->table('cust_main')->column('ship_last');
3771
3772   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3773     or die "can't open $dir/cust_main.company.tmp: $!";
3774   print COMPANYCACHE join("\n", @all_company), "\n";
3775   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3776
3777   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3778   close COMPANYLOCK;
3779
3780 }
3781
3782 =item all_last
3783
3784 =cut
3785
3786 sub all_last {
3787   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3788   open(LASTCACHE,"<$dir/cust_main.last")
3789     or die "can't open $dir/cust_main.last: $!";
3790   my @array = map { chomp; $_; } <LASTCACHE>;
3791   close LASTCACHE;
3792   \@array;
3793 }
3794
3795 =item all_company
3796
3797 =cut
3798
3799 sub all_company {
3800   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3801   open(COMPANYCACHE,"<$dir/cust_main.company")
3802     or die "can't open $dir/cust_main.last: $!";
3803   my @array = map { chomp; $_; } <COMPANYCACHE>;
3804   close COMPANYCACHE;
3805   \@array;
3806 }
3807
3808 =item append_fuzzyfiles LASTNAME COMPANY
3809
3810 =cut
3811
3812 sub append_fuzzyfiles {
3813   my( $last, $company ) = @_;
3814
3815   &check_and_rebuild_fuzzyfiles;
3816
3817   use Fcntl qw(:flock);
3818
3819   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3820
3821   if ( $last ) {
3822
3823     open(LAST,">>$dir/cust_main.last")
3824       or die "can't open $dir/cust_main.last: $!";
3825     flock(LAST,LOCK_EX)
3826       or die "can't lock $dir/cust_main.last: $!";
3827
3828     print LAST "$last\n";
3829
3830     flock(LAST,LOCK_UN)
3831       or die "can't unlock $dir/cust_main.last: $!";
3832     close LAST;
3833   }
3834
3835   if ( $company ) {
3836
3837     open(COMPANY,">>$dir/cust_main.company")
3838       or die "can't open $dir/cust_main.company: $!";
3839     flock(COMPANY,LOCK_EX)
3840       or die "can't lock $dir/cust_main.company: $!";
3841
3842     print COMPANY "$company\n";
3843
3844     flock(COMPANY,LOCK_UN)
3845       or die "can't unlock $dir/cust_main.company: $!";
3846
3847     close COMPANY;
3848   }
3849
3850   1;
3851 }
3852
3853 =item batch_import
3854
3855 =cut
3856
3857 sub batch_import {
3858   my $param = shift;
3859   #warn join('-',keys %$param);
3860   my $fh = $param->{filehandle};
3861   my $agentnum = $param->{agentnum};
3862   my $refnum = $param->{refnum};
3863   my $pkgpart = $param->{pkgpart};
3864   my @fields = @{$param->{fields}};
3865
3866   eval "use Date::Parse;";
3867   die $@ if $@;
3868   eval "use Text::CSV_XS;";
3869   die $@ if $@;
3870
3871   my $csv = new Text::CSV_XS;
3872   #warn $csv;
3873   #warn $fh;
3874
3875   my $imported = 0;
3876   #my $columns;
3877
3878   local $SIG{HUP} = 'IGNORE';
3879   local $SIG{INT} = 'IGNORE';
3880   local $SIG{QUIT} = 'IGNORE';
3881   local $SIG{TERM} = 'IGNORE';
3882   local $SIG{TSTP} = 'IGNORE';
3883   local $SIG{PIPE} = 'IGNORE';
3884
3885   my $oldAutoCommit = $FS::UID::AutoCommit;
3886   local $FS::UID::AutoCommit = 0;
3887   my $dbh = dbh;
3888
3889   #while ( $columns = $csv->getline($fh) ) {
3890   my $line;
3891   while ( defined($line=<$fh>) ) {
3892
3893     $csv->parse($line) or do {
3894       $dbh->rollback if $oldAutoCommit;
3895       return "can't parse: ". $csv->error_input();
3896     };
3897
3898     my @columns = $csv->fields();
3899     #warn join('-',@columns);
3900
3901     my %cust_main = (
3902       agentnum => $agentnum,
3903       refnum   => $refnum,
3904       country  => $conf->config('countrydefault') || 'US',
3905       payby    => 'BILL', #default
3906       paydate  => '12/2037', #default
3907     );
3908     my $billtime = time;
3909     my %cust_pkg = ( pkgpart => $pkgpart );
3910     foreach my $field ( @fields ) {
3911       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
3912         #$cust_pkg{$1} = str2time( shift @$columns );
3913         if ( $1 eq 'setup' ) {
3914           $billtime = str2time(shift @columns);
3915         } else {
3916           $cust_pkg{$1} = str2time( shift @columns );
3917         }
3918       } else {
3919         #$cust_main{$field} = shift @$columns;
3920         $cust_main{$field} = shift @columns;
3921       }
3922     }
3923
3924     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
3925     my $cust_main = new FS::cust_main ( \%cust_main );
3926     use Tie::RefHash;
3927     tie my %hash, 'Tie::RefHash'; #this part is important
3928     $hash{$cust_pkg} = [] if $pkgpart;
3929     my $error = $cust_main->insert( \%hash );
3930
3931     if ( $error ) {
3932       $dbh->rollback if $oldAutoCommit;
3933       return "can't insert customer for $line: $error";
3934     }
3935
3936     #false laziness w/bill.cgi
3937     $error = $cust_main->bill( 'time' => $billtime );
3938     if ( $error ) {
3939       $dbh->rollback if $oldAutoCommit;
3940       return "can't bill customer for $line: $error";
3941     }
3942
3943     $cust_main->apply_payments;
3944     $cust_main->apply_credits;
3945
3946     $error = $cust_main->collect();
3947     if ( $error ) {
3948       $dbh->rollback if $oldAutoCommit;
3949       return "can't collect customer for $line: $error";
3950     }
3951
3952     $imported++;
3953   }
3954
3955   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3956
3957   return "Empty file!" unless $imported;
3958
3959   ''; #no error
3960
3961 }
3962
3963 =item batch_charge
3964
3965 =cut
3966
3967 sub batch_charge {
3968   my $param = shift;
3969   #warn join('-',keys %$param);
3970   my $fh = $param->{filehandle};
3971   my @fields = @{$param->{fields}};
3972
3973   eval "use Date::Parse;";
3974   die $@ if $@;
3975   eval "use Text::CSV_XS;";
3976   die $@ if $@;
3977
3978   my $csv = new Text::CSV_XS;
3979   #warn $csv;
3980   #warn $fh;
3981
3982   my $imported = 0;
3983   #my $columns;
3984
3985   local $SIG{HUP} = 'IGNORE';
3986   local $SIG{INT} = 'IGNORE';
3987   local $SIG{QUIT} = 'IGNORE';
3988   local $SIG{TERM} = 'IGNORE';
3989   local $SIG{TSTP} = 'IGNORE';
3990   local $SIG{PIPE} = 'IGNORE';
3991
3992   my $oldAutoCommit = $FS::UID::AutoCommit;
3993   local $FS::UID::AutoCommit = 0;
3994   my $dbh = dbh;
3995
3996   #while ( $columns = $csv->getline($fh) ) {
3997   my $line;
3998   while ( defined($line=<$fh>) ) {
3999
4000     $csv->parse($line) or do {
4001       $dbh->rollback if $oldAutoCommit;
4002       return "can't parse: ". $csv->error_input();
4003     };
4004
4005     my @columns = $csv->fields();
4006     #warn join('-',@columns);
4007
4008     my %row = ();
4009     foreach my $field ( @fields ) {
4010       $row{$field} = shift @columns;
4011     }
4012
4013     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
4014     unless ( $cust_main ) {
4015       $dbh->rollback if $oldAutoCommit;
4016       return "unknown custnum $row{'custnum'}";
4017     }
4018
4019     if ( $row{'amount'} > 0 ) {
4020       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4021       if ( $error ) {
4022         $dbh->rollback if $oldAutoCommit;
4023         return $error;
4024       }
4025       $imported++;
4026     } elsif ( $row{'amount'} < 0 ) {
4027       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4028                                       $row{'pkg'}                         );
4029       if ( $error ) {
4030         $dbh->rollback if $oldAutoCommit;
4031         return $error;
4032       }
4033       $imported++;
4034     } else {
4035       #hmm?
4036     }
4037
4038   }
4039
4040   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4041
4042   return "Empty file!" unless $imported;
4043
4044   ''; #no error
4045
4046 }
4047
4048 =back
4049
4050 =head1 BUGS
4051
4052 The delete method.
4053
4054 The delete method should possibly take an FS::cust_main object reference
4055 instead of a scalar customer number.
4056
4057 Bill and collect options should probably be passed as references instead of a
4058 list.
4059
4060 There should probably be a configuration file with a list of allowed credit
4061 card types.
4062
4063 No multiple currency support (probably a larger project than just this module).
4064
4065 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4066
4067 =head1 SEE ALSO
4068
4069 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4070 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4071 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
4072
4073 =cut
4074
4075 1;
4076