FS/FS/cust_main.pm

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