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