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   warn "$me replace called\n"
 927     if $DEBUG;
 928
 929   local $SIG{HUP} = 'IGNORE';
 930   local $SIG{INT} = 'IGNORE';
 931   local $SIG{QUIT} = 'IGNORE';
 932   local $SIG{TERM} = 'IGNORE';
 933   local $SIG{TSTP} = 'IGNORE';
 934   local $SIG{PIPE} = 'IGNORE';
 935
 936   # If the mask is blank then try to set it - if we can...
 937   if (!defined($self->getfield('paymask')) || $self->getfield('paymask') eq '') {
 938     $self->paymask($self->payinfo);
 939   }
 940
 941   # We absolutely have to have an old vs. new record to make this work.
 942   if (!defined($old)) {
 943     $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 944   }
 945
 946   if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
 947        && $conf->config('users-allow_comp')                  ) {
 948     return "You are not permitted to create complimentary accounts."
 949       unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
 950   }
 951
 952   local($ignore_expired_card) = 1
 953     if $old->payby  =~ /^(CARD|DCRD)$/
 954     && $self->payby =~ /^(CARD|DCRD)$/
 955     && $old->payinfo eq $self->payinfo;
 956
 957   my $oldAutoCommit = $FS::UID::AutoCommit;
 958   local $FS::UID::AutoCommit = 0;
 959   my $dbh = dbh;
 960
 961   my $error = $self->SUPER::replace($old);
 962
 963   if ( $error ) {
 964     $dbh->rollback if $oldAutoCommit;
 965     return $error;
 966   }
 967
 968   if ( @param ) { # INVOICING_LIST_ARYREF
 969     my $invoicing_list = shift @param;
 970     $error = $self->check_invoicing_list( $invoicing_list );
 971     if ( $error ) {
 972       $dbh->rollback if $oldAutoCommit;
 973       return $error;
 974     }
 975     $self->invoicing_list( $invoicing_list );
 976   }
 977
 978   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
 979        grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
 980     # card/check/lec info has changed, want to retry realtime_ invoice events
 981     my $error = $self->retry_realtime;
 982     if ( $error ) {
 983       $dbh->rollback if $oldAutoCommit;
 984       return $error;
 985     }
 986   }
 987
 988   unless ( $import || $skip_fuzzyfiles ) {
 989     $error = $self->queue_fuzzyfiles_update;
 990     if ( $error ) {
 991       $dbh->rollback if $oldAutoCommit;
 992       return "updating fuzzy search cache: $error";
 993     }
 994   }
 995
 996   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 997   '';
 998
 999 }
1000
1001 =item queue_fuzzyfiles_update
1002
1003 Used by insert & replace to update the fuzzy search cache
1004
1005 =cut
1006
1007 sub queue_fuzzyfiles_update {
1008   my $self = shift;
1009
1010   local $SIG{HUP} = 'IGNORE';
1011   local $SIG{INT} = 'IGNORE';
1012   local $SIG{QUIT} = 'IGNORE';
1013   local $SIG{TERM} = 'IGNORE';
1014   local $SIG{TSTP} = 'IGNORE';
1015   local $SIG{PIPE} = 'IGNORE';
1016
1017   my $oldAutoCommit = $FS::UID::AutoCommit;
1018   local $FS::UID::AutoCommit = 0;
1019   my $dbh = dbh;
1020
1021   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1022   my $error = $queue->insert($self->getfield('last'), $self->company);
1023   if ( $error ) {
1024     $dbh->rollback if $oldAutoCommit;
1025     return "queueing job (transaction rolled back): $error";
1026   }
1027
1028   if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
1029     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1030     $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
1031     if ( $error ) {
1032       $dbh->rollback if $oldAutoCommit;
1033       return "queueing job (transaction rolled back): $error";
1034     }
1035   }
1036
1037   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1038   '';
1039
1040 }
1041
1042 =item check
1043
1044 Checks all fields to make sure this is a valid customer record.  If there is
1045 an error, returns the error, otherwise returns false.  Called by the insert
1046 and replace methods.
1047
1048 =cut
1049
1050 sub check {
1051   my $self = shift;
1052
1053   warn "$me check BEFORE: \n". $self->_dump
1054     if $DEBUG > 2;
1055
1056   my $error =
1057     $self->ut_numbern('custnum')
1058     || $self->ut_number('agentnum')
1059     || $self->ut_number('refnum')
1060     || $self->ut_name('last')
1061     || $self->ut_name('first')
1062     || $self->ut_textn('company')
1063     || $self->ut_text('address1')
1064     || $self->ut_textn('address2')
1065     || $self->ut_text('city')
1066     || $self->ut_textn('county')
1067     || $self->ut_textn('state')
1068     || $self->ut_country('country')
1069     || $self->ut_anything('comments')
1070     || $self->ut_numbern('referral_custnum')
1071   ;
1072   #barf.  need message catalogs.  i18n.  etc.
1073   $error .= "Please select an advertising source."
1074     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1075   return $error if $error;
1076
1077   return "Unknown agent"
1078     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1079
1080   return "Unknown refnum"
1081     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1082
1083   return "Unknown referring custnum: ". $self->referral_custnum
1084     unless ! $self->referral_custnum
1085            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1086
1087   if ( $self->ss eq '' ) {
1088     $self->ss('');
1089   } else {
1090     my $ss = $self->ss;
1091     $ss =~ s/\D//g;
1092     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1093       or return "Illegal social security number: ". $self->ss;
1094     $self->ss("$1-$2-$3");
1095   }
1096
1097
1098 # bad idea to disable, causes billing to fail because of no tax rates later
1099 #  unless ( $import ) {
1100     unless ( qsearch('cust_main_county', {
1101       'country' => $self->country,
1102       'state'   => '',
1103      } ) ) {
1104       return "Unknown state/county/country: ".
1105         $self->state. "/". $self->county. "/". $self->country
1106         unless qsearch('cust_main_county',{
1107           'state'   => $self->state,
1108           'county'  => $self->county,
1109           'country' => $self->country,
1110         } );
1111     }
1112 #  }
1113
1114   $error =
1115     $self->ut_phonen('daytime', $self->country)
1116     || $self->ut_phonen('night', $self->country)
1117     || $self->ut_phonen('fax', $self->country)
1118     || $self->ut_zip('zip', $self->country)
1119   ;
1120   return $error if $error;
1121
1122   my @addfields = qw(
1123     last first company address1 address2 city county state zip
1124     country daytime night fax
1125   );
1126
1127   if ( defined $self->dbdef_table->column('ship_last') ) {
1128     if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1129                        @addfields )
1130          && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
1131        )
1132     {
1133       my $error =
1134         $self->ut_name('ship_last')
1135         || $self->ut_name('ship_first')
1136         || $self->ut_textn('ship_company')
1137         || $self->ut_text('ship_address1')
1138         || $self->ut_textn('ship_address2')
1139         || $self->ut_text('ship_city')
1140         || $self->ut_textn('ship_county')
1141         || $self->ut_textn('ship_state')
1142         || $self->ut_country('ship_country')
1143       ;
1144       return $error if $error;
1145
1146       #false laziness with above
1147       unless ( qsearchs('cust_main_county', {
1148         'country' => $self->ship_country,
1149         'state'   => '',
1150        } ) ) {
1151         return "Unknown ship_state/ship_county/ship_country: ".
1152           $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1153           unless qsearch('cust_main_county',{
1154             'state'   => $self->ship_state,
1155             'county'  => $self->ship_county,
1156             'country' => $self->ship_country,
1157           } );
1158       }
1159       #eofalse
1160
1161       $error =
1162         $self->ut_phonen('ship_daytime', $self->ship_country)
1163         || $self->ut_phonen('ship_night', $self->ship_country)
1164         || $self->ut_phonen('ship_fax', $self->ship_country)
1165         || $self->ut_zip('ship_zip', $self->ship_country)
1166       ;
1167       return $error if $error;
1168
1169     } else { # ship_ info eq billing info, so don't store dup info in database
1170       $self->setfield("ship_$_", '')
1171         foreach qw( last first company address1 address2 city county state zip
1172                     country daytime night fax );
1173     }
1174   }
1175
1176   $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1177     or return "Illegal payby: ". $self->payby;
1178
1179   $error =    $self->ut_numbern('paystart_month')
1180            || $self->ut_numbern('paystart_year')
1181            || $self->ut_numbern('payissue')
1182   ;
1183   return $error if $error;
1184
1185   if ( $self->payip eq '' ) {
1186     $self->payip('');
1187   } else {
1188     $error = $self->ut_ip('payip');
1189     return $error if $error;
1190   }
1191
1192   # If it is encrypted and the private key is not availaible then we can't
1193   # check the credit card.
1194
1195   my $check_payinfo = 1;
1196
1197   if ($self->is_encrypted($self->payinfo)) {
1198     $check_payinfo = 0;
1199   }
1200
1201   $self->payby($1);
1202
1203   if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1204
1205     my $payinfo = $self->payinfo;
1206     $payinfo =~ s/\D//g;
1207     $payinfo =~ /^(\d{13,16})$/
1208       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1209     $payinfo = $1;
1210     $self->payinfo($payinfo);
1211     validate($payinfo)
1212       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1213
1214     return gettext('unknown_card_type')
1215       if cardtype($self->payinfo) eq "Unknown";
1216
1217     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1218     return "Banned credit card" if $ban;
1219
1220     if ( defined $self->dbdef_table->column('paycvv') ) {
1221       if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1222         if ( cardtype($self->payinfo) eq 'American Express card' ) {
1223           $self->paycvv =~ /^(\d{4})$/
1224             or return "CVV2 (CID) for American Express cards is four digits.";
1225           $self->paycvv($1);
1226         } else {
1227           $self->paycvv =~ /^(\d{3})$/
1228             or return "CVV2 (CVC2/CID) is three digits.";
1229           $self->paycvv($1);
1230         }
1231       } else {
1232         $self->paycvv('');
1233       }
1234     }
1235
1236     my $cardtype = cardtype($payinfo);
1237     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1238
1239       return "Start date or issue number is required for $cardtype cards"
1240         unless $self->paystart_month && $self->paystart_year or $self->payissue;
1241
1242       return "Start month must be between 1 and 12"
1243         if $self->paystart_month
1244            and $self->paystart_month < 1 || $self->paystart_month > 12;
1245
1246       return "Start year must be 1990 or later"
1247         if $self->paystart_year
1248            and $self->paystart_year < 1990;
1249
1250       return "Issue number must be beween 1 and 99"
1251         if $self->payissue
1252           and $self->payissue < 1 || $self->payissue > 99;
1253
1254     } else {
1255       $self->paystart_month('');
1256       $self->paystart_year('');
1257       $self->payissue('');
1258     }
1259
1260   } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1261
1262     my $payinfo = $self->payinfo;
1263     $payinfo =~ s/[^\d\@]//g;
1264     if ( $conf->exists('echeck-nonus') ) {
1265       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1266       $payinfo = "$1\@$2";
1267     } else {
1268       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1269       $payinfo = "$1\@$2";
1270     }
1271     $self->payinfo($payinfo);
1272     $self->paycvv('') if $self->dbdef_table->column('paycvv');
1273
1274     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1275     return "Banned ACH account" if $ban;
1276
1277   } elsif ( $self->payby eq 'LECB' ) {
1278
1279     my $payinfo = $self->payinfo;
1280     $payinfo =~ s/\D//g;
1281     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1282     $payinfo = $1;
1283     $self->payinfo($payinfo);
1284     $self->paycvv('') if $self->dbdef_table->column('paycvv');
1285
1286   } elsif ( $self->payby eq 'BILL' ) {
1287
1288     $error = $self->ut_textn('payinfo');
1289     return "Illegal P.O. number: ". $self->payinfo if $error;
1290     $self->paycvv('') if $self->dbdef_table->column('paycvv');
1291
1292   } elsif ( $self->payby eq 'COMP' ) {
1293
1294     if ( !$self->custnum && $conf->config('users-allow_comp') ) {
1295       return "You are not permitted to create complimentary accounts."
1296         unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
1297     }
1298
1299     $error = $self->ut_textn('payinfo');
1300     return "Illegal comp account issuer: ". $self->payinfo if $error;
1301     $self->paycvv('') if $self->dbdef_table->column('paycvv');
1302
1303   } elsif ( $self->payby eq 'PREPAY' ) {
1304
1305     my $payinfo = $self->payinfo;
1306     $payinfo =~ s/\W//g; #anything else would just confuse things
1307     $self->payinfo($payinfo);
1308     $error = $self->ut_alpha('payinfo');
1309     return "Illegal prepayment identifier: ". $self->payinfo if $error;
1310     return "Unknown prepayment identifier"
1311       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1312     $self->paycvv('') if $self->dbdef_table->column('paycvv');
1313
1314   }
1315
1316   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1317     return "Expiration date required"
1318       unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1319     $self->paydate('');
1320   } else {
1321     my( $m, $y );
1322     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1323       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1324     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1325       ( $m, $y ) = ( $3, "20$2" );
1326     } else {
1327       return "Illegal expiration date: ". $self->paydate;
1328     }
1329     $self->paydate("$y-$m-01");
1330     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1331     return gettext('expired_card')
1332       if !$import
1333       && !$ignore_expired_card
1334       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1335   }
1336
1337   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1338        ( ! $conf->exists('require_cardname')
1339          || $self->payby !~ /^(CARD|DCRD)$/  )
1340   ) {
1341     $self->payname( $self->first. " ". $self->getfield('last') );
1342   } else {
1343     $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1344       or return gettext('illegal_name'). " payname: ". $self->payname;
1345     $self->payname($1);
1346   }
1347
1348   foreach my $flag (qw( tax spool_cdr )) {
1349     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1350     $self->$flag($1);
1351   }
1352
1353   $self->otaker(getotaker) unless $self->otaker;
1354
1355   warn "$me check AFTER: \n". $self->_dump
1356     if $DEBUG > 2;
1357
1358   $self->SUPER::check;
1359 }
1360
1361 =item all_pkgs
1362
1363 Returns all packages (see L<FS::cust_pkg>) for this customer.
1364
1365 =cut
1366
1367 sub all_pkgs {
1368   my $self = shift;
1369   if ( $self->{'_pkgnum'} ) {
1370     values %{ $self->{'_pkgnum'}->cache };
1371   } else {
1372     qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1373   }
1374 }
1375
1376 =item ncancelled_pkgs
1377
1378 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1379
1380 =cut
1381
1382 sub ncancelled_pkgs {
1383   my $self = shift;
1384   if ( $self->{'_pkgnum'} ) {
1385     grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
1386   } else {
1387     @{ [ # force list context
1388       qsearch( 'cust_pkg', {
1389         'custnum' => $self->custnum,
1390         'cancel'  => '',
1391       }),
1392       qsearch( 'cust_pkg', {
1393         'custnum' => $self->custnum,
1394         'cancel'  => 0,
1395       }),
1396     ] };
1397   }
1398 }
1399
1400 =item suspended_pkgs
1401
1402 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1403
1404 =cut
1405
1406 sub suspended_pkgs {
1407   my $self = shift;
1408   grep { $_->susp } $self->ncancelled_pkgs;
1409 }
1410
1411 =item unflagged_suspended_pkgs
1412
1413 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1414 customer (thouse packages without the `manual_flag' set).
1415
1416 =cut
1417
1418 sub unflagged_suspended_pkgs {
1419   my $self = shift;
1420   return $self->suspended_pkgs
1421     unless dbdef->table('cust_pkg')->column('manual_flag');
1422   grep { ! $_->manual_flag } $self->suspended_pkgs;
1423 }
1424
1425 =item unsuspended_pkgs
1426
1427 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1428 this customer.
1429
1430 =cut
1431
1432 sub unsuspended_pkgs {
1433   my $self = shift;
1434   grep { ! $_->susp } $self->ncancelled_pkgs;
1435 }
1436
1437 =item num_cancelled_pkgs
1438
1439 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1440 customer.
1441
1442 =cut
1443
1444 sub num_cancelled_pkgs {
1445   my $self = shift;
1446   $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0");
1447 }
1448
1449 sub num_pkgs {
1450   my( $self, $sql ) = @_;
1451   my $sth = dbh->prepare(
1452     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql"
1453   ) or die dbh->errstr;
1454   $sth->execute($self->custnum) or die $sth->errstr;
1455   $sth->fetchrow_arrayref->[0];
1456 }
1457
1458 =item unsuspend
1459
1460 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1461 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
1462 on success or a list of errors.
1463
1464 =cut
1465
1466 sub unsuspend {
1467   my $self = shift;
1468   grep { $_->unsuspend } $self->suspended_pkgs;
1469 }
1470
1471 =item suspend
1472
1473 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1474
1475 Returns a list: an empty list on success or a list of errors.
1476
1477 =cut
1478
1479 sub suspend {
1480   my $self = shift;
1481   grep { $_->suspend } $self->unsuspended_pkgs;
1482 }
1483
1484 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1485
1486 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1487 PKGPARTs (see L<FS::part_pkg>).
1488
1489 Returns a list: an empty list on success or a list of errors.
1490
1491 =cut
1492
1493 sub suspend_if_pkgpart {
1494   my $self = shift;
1495   my @pkgparts = @_;
1496   grep { $_->suspend }
1497     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1498       $self->unsuspended_pkgs;
1499 }
1500
1501 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1502
1503 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1504 listed PKGPARTs (see L<FS::part_pkg>).
1505
1506 Returns a list: an empty list on success or a list of errors.
1507
1508 =cut
1509
1510 sub suspend_unless_pkgpart {
1511   my $self = shift;
1512   my @pkgparts = @_;
1513   grep { $_->suspend }
1514     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1515       $self->unsuspended_pkgs;
1516 }
1517
1518 =item cancel [ OPTION => VALUE ... ]
1519
1520 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1521
1522 Available options are: I<quiet>, I<reasonnum>, and I<ban>
1523
1524 I<quiet> can be set true to supress email cancellation notices.
1525
1526 # I<reasonnum> can be set to a cancellation reason (see L<FS::cancel_reason>)
1527
1528 I<ban> can be set true to ban this customer's credit card or ACH information,
1529 if present.
1530
1531 Always returns a list: an empty list on success or a list of errors.
1532
1533 =cut
1534
1535 sub cancel {
1536   my $self = shift;
1537   my %opt = @_;
1538
1539   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1540
1541     #should try decryption (we might have the private key)
1542     # and if not maybe queue a job for the server that does?
1543     return ( "Can't (yet) ban encrypted credit cards" )
1544       if $self->is_encrypted($self->payinfo);
1545
1546     my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1547     my $error = $ban->insert;
1548     return ( $error ) if $error;
1549
1550   }
1551
1552   grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1553 }
1554
1555 sub _banned_pay_hashref {
1556   my $self = shift;
1557
1558   my %payby2ban = (
1559     'CARD' => 'CARD',
1560     'DCRD' => 'CARD',
1561     'CHEK' => 'CHEK',
1562     'DCHK' => 'CHEK'
1563   );
1564
1565   {
1566     'payby'   => $payby2ban{$self->payby},
1567     'payinfo' => md5_base64($self->payinfo),
1568     #'reason'  =>
1569   };
1570 }
1571
1572 =item agent
1573
1574 Returns the agent (see L<FS::agent>) for this customer.
1575
1576 =cut
1577
1578 sub agent {
1579   my $self = shift;
1580   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1581 }
1582
1583 =item bill OPTIONS
1584
1585 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
1586 conjunction with the collect method.
1587
1588 Options are passed as name-value pairs.
1589
1590 Currently available options are:
1591
1592 resetup - if set true, re-charges setup fees.
1593
1594 time - bills the customer as if it were that time.  Specified as a UNIX
1595 timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and
1596 L<Date::Parse> for conversion functions.  For example:
1597
1598  use Date::Parse;
1599  ...
1600  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1601
1602
1603 If there is an error, returns the error, otherwise returns false.
1604
1605 =cut
1606
1607 sub bill {
1608   my( $self, %options ) = @_;
1609   return '' if $self->payby eq 'COMP';
1610   warn "$me bill customer ". $self->custnum. "\n"
1611     if $DEBUG;
1612
1613   my $time = $options{'time'} || time;
1614
1615   my $error;
1616
1617   #put below somehow?
1618   local $SIG{HUP} = 'IGNORE';
1619   local $SIG{INT} = 'IGNORE';
1620   local $SIG{QUIT} = 'IGNORE';
1621   local $SIG{TERM} = 'IGNORE';
1622   local $SIG{TSTP} = 'IGNORE';
1623   local $SIG{PIPE} = 'IGNORE';
1624
1625   my $oldAutoCommit = $FS::UID::AutoCommit;
1626   local $FS::UID::AutoCommit = 0;
1627   my $dbh = dbh;
1628
1629   $self->select_for_update; #mutex
1630
1631   #create a new invoice
1632   #(we'll remove it later if it doesn't actually need to be generated [contains
1633   # no line items] and we're inside a transaciton so nothing else will see it)
1634   my $cust_bill = new FS::cust_bill ( {
1635     'custnum' => $self->custnum,
1636     '_date'   => $time,
1637     #'charged' => $charged,
1638     'charged' => 0,
1639   } );
1640   $error = $cust_bill->insert;
1641   if ( $error ) {
1642     $dbh->rollback if $oldAutoCommit;
1643     return "can't create invoice for customer #". $self->custnum. ": $error";
1644   }
1645   my $invnum = $cust_bill->invnum;
1646
1647   ###
1648   # find the packages which are due for billing, find out how much they are
1649   # & generate invoice database.
1650   ###
1651
1652   my( $total_setup, $total_recur ) = ( 0, 0 );
1653   my %tax;
1654   my @precommit_hooks = ();
1655
1656   foreach my $cust_pkg (
1657     qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1658   ) {
1659
1660     #NO!! next if $cust_pkg->cancel;
1661     next if $cust_pkg->getfield('cancel');
1662
1663     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
1664
1665     #? to avoid use of uninitialized value errors... ?
1666     $cust_pkg->setfield('bill', '')
1667       unless defined($cust_pkg->bill);
1668
1669     my $part_pkg = $cust_pkg->part_pkg;
1670
1671     my %hash = $cust_pkg->hash;
1672     my $old_cust_pkg = new FS::cust_pkg \%hash;
1673
1674     my @details = ();
1675
1676     ###
1677     # bill setup
1678     ###
1679
1680     my $setup = 0;
1681     if ( !$cust_pkg->setup || $options{'resetup'} ) {
1682
1683       warn "    bill setup\n" if $DEBUG > 1;
1684
1685       $setup = eval { $cust_pkg->calc_setup( $time ) };
1686       if ( $@ ) {
1687         $dbh->rollback if $oldAutoCommit;
1688         return "$@ running calc_setup for $cust_pkg\n";
1689       }
1690
1691       $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1692     }
1693
1694     ###
1695     # bill recurring fee
1696     ###
1697
1698     my $recur = 0;
1699     my $sdate;
1700     if ( $part_pkg->getfield('freq') ne '0' &&
1701          ! $cust_pkg->getfield('susp') &&
1702          ( $cust_pkg->getfield('bill') || 0 ) <= $time
1703     ) {
1704
1705       warn "    bill recur\n" if $DEBUG > 1;
1706
1707       # XXX shared with $recur_prog
1708       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1709
1710       #over two params!  lets at least switch to a hashref for the rest...
1711       my %param = ( 'precommit_hooks' => \@precommit_hooks, );
1712
1713       $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
1714       if ( $@ ) {
1715         $dbh->rollback if $oldAutoCommit;
1716         return "$@ running calc_recur for $cust_pkg\n";
1717       }
1718
1719       #change this bit to use Date::Manip? CAREFUL with timezones (see
1720       # mailing list archive)
1721       my ($sec,$min,$hour,$mday,$mon,$year) =
1722         (localtime($sdate) )[0,1,2,3,4,5];
1723
1724       #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1725       # only for figuring next bill date, nothing else, so, reset $sdate again
1726       # here
1727       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1728       $cust_pkg->last_bill($sdate)
1729         if $cust_pkg->dbdef_table->column('last_bill');
1730
1731       if ( $part_pkg->freq =~ /^\d+$/ ) {
1732         $mon += $part_pkg->freq;
1733         until ( $mon < 12 ) { $mon -= 12; $year++; }
1734       } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1735         my $weeks = $1;
1736         $mday += $weeks * 7;
1737       } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1738         my $days = $1;
1739         $mday += $days;
1740       } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
1741         my $hours = $1;
1742         $hour += $hours;
1743       } else {
1744         $dbh->rollback if $oldAutoCommit;
1745         return "unparsable frequency: ". $part_pkg->freq;
1746       }
1747       $cust_pkg->setfield('bill',
1748         timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1749     }
1750
1751     warn "\$setup is undefined" unless defined($setup);
1752     warn "\$recur is undefined" unless defined($recur);
1753     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1754
1755     ###
1756     # If $cust_pkg has been modified, update it and create cust_bill_pkg records
1757     ###
1758
1759     if ( $cust_pkg->modified ) {
1760
1761       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
1762         if $DEBUG >1;
1763
1764       $error=$cust_pkg->replace($old_cust_pkg);
1765       if ( $error ) { #just in case
1766         $dbh->rollback if $oldAutoCommit;
1767         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1768       }
1769
1770       $setup = sprintf( "%.2f", $setup );
1771       $recur = sprintf( "%.2f", $recur );
1772       if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1773         $dbh->rollback if $oldAutoCommit;
1774         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1775       }
1776       if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1777         $dbh->rollback if $oldAutoCommit;
1778         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1779       }
1780
1781       if ( $setup != 0 || $recur != 0 ) {
1782
1783         warn "    charges (setup=$setup, recur=$recur); adding line items\n"
1784           if $DEBUG > 1;
1785         my $cust_bill_pkg = new FS::cust_bill_pkg ({
1786           'invnum'  => $invnum,
1787           'pkgnum'  => $cust_pkg->pkgnum,
1788           'setup'   => $setup,
1789           'recur'   => $recur,
1790           'sdate'   => $sdate,
1791           'edate'   => $cust_pkg->bill,
1792           'details' => \@details,
1793         });
1794         $error = $cust_bill_pkg->insert;
1795         if ( $error ) {
1796           $dbh->rollback if $oldAutoCommit;
1797           return "can't create invoice line item for invoice #$invnum: $error";
1798         }
1799         $total_setup += $setup;
1800         $total_recur += $recur;
1801
1802         ###
1803         # handle taxes
1804         ###
1805
1806         unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1807
1808           my @taxes = qsearch( 'cust_main_county', {
1809                                  'state'    => $self->state,
1810                                  'county'   => $self->county,
1811                                  'country'  => $self->country,
1812                                  'taxclass' => $part_pkg->taxclass,
1813                                                                       } );
1814           unless ( @taxes ) {
1815             @taxes =  qsearch( 'cust_main_county', {
1816                                   'state'    => $self->state,
1817                                   'county'   => $self->county,
1818                                   'country'  => $self->country,
1819                                   'taxclass' => '',
1820                                                                       } );
1821           }
1822
1823           #one more try at a whole-country tax rate
1824           unless ( @taxes ) {
1825             @taxes =  qsearch( 'cust_main_county', {
1826                                   'state'    => '',
1827                                   'county'   => '',
1828                                   'country'  => $self->country,
1829                                   'taxclass' => '',
1830                                                                       } );
1831           }
1832
1833           # maybe eliminate this entirely, along with all the 0% records
1834           unless ( @taxes ) {
1835             $dbh->rollback if $oldAutoCommit;
1836             return
1837               "fatal: can't find tax rate for state/county/country/taxclass ".
1838               join('/', ( map $self->$_(), qw(state county country) ),
1839                         $part_pkg->taxclass ).  "\n";
1840           }
1841
1842           foreach my $tax ( @taxes ) {
1843
1844             my $taxable_charged = 0;
1845             $taxable_charged += $setup
1846               unless $part_pkg->setuptax =~ /^Y$/i
1847                   || $tax->setuptax =~ /^Y$/i;
1848             $taxable_charged += $recur
1849               unless $part_pkg->recurtax =~ /^Y$/i
1850                   || $tax->recurtax =~ /^Y$/i;
1851             next unless $taxable_charged;
1852
1853             if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
1854               #my ($mon,$year) = (localtime($sdate) )[4,5];
1855               my ($mon,$year) = (localtime( $sdate || $cust_bill->_date ) )[4,5];
1856               $mon++;
1857               my $freq = $part_pkg->freq || 1;
1858               if ( $freq !~ /(\d+)$/ ) {
1859                 $dbh->rollback if $oldAutoCommit;
1860                 return "daily/weekly package definitions not (yet?)".
1861                        " compatible with monthly tax exemptions";
1862               }
1863               my $taxable_per_month =
1864                 sprintf("%.2f", $taxable_charged / $freq );
1865
1866               #call the whole thing off if this customer has any old
1867               #exemption records...
1868               my @cust_tax_exempt =
1869                 qsearch( 'cust_tax_exempt' => { custnum=> $self->custnum } );
1870               if ( @cust_tax_exempt ) {
1871                 $dbh->rollback if $oldAutoCommit;
1872                 return
1873                   'this customer still has old-style tax exemption records; '.
1874                   'run bin/fs-migrate-cust_tax_exempt?';
1875               }
1876
1877               foreach my $which_month ( 1 .. $freq ) {
1878
1879                 #maintain the new exemption table now
1880                 my $sql = "
1881                   SELECT SUM(amount)
1882                     FROM cust_tax_exempt_pkg
1883                       LEFT JOIN cust_bill_pkg USING ( billpkgnum )
1884                       LEFT JOIN cust_bill     USING ( invnum     )
1885                     WHERE custnum = ?
1886                       AND taxnum  = ?
1887                       AND year    = ?
1888                       AND month   = ?
1889                 ";
1890                 my $sth = dbh->prepare($sql) or do {
1891                   $dbh->rollback if $oldAutoCommit;
1892                   return "fatal: can't lookup exising exemption: ". dbh->errstr;
1893                 };
1894                 $sth->execute(
1895                   $self->custnum,
1896                   $tax->taxnum,
1897                   1900+$year,
1898                   $mon,
1899                 ) or do {
1900                   $dbh->rollback if $oldAutoCommit;
1901                   return "fatal: can't lookup exising exemption: ". dbh->errstr;
1902                 };
1903                 my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0;
1904
1905                 my $remaining_exemption =
1906                   $tax->exempt_amount - $existing_exemption;
1907                 if ( $remaining_exemption > 0 ) {
1908                   my $addl = $remaining_exemption > $taxable_per_month
1909                     ? $taxable_per_month
1910                     : $remaining_exemption;
1911                   $taxable_charged -= $addl;
1912
1913                   my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( {
1914                     'billpkgnum' => $cust_bill_pkg->billpkgnum,
1915                     'taxnum'     => $tax->taxnum,
1916                     'year'       => 1900+$year,
1917                     'month'      => $mon,
1918                     'amount'     => sprintf("%.2f", $addl ),
1919                   } );
1920                   $error = $cust_tax_exempt_pkg->insert;
1921                   if ( $error ) {
1922                     $dbh->rollback if $oldAutoCommit;
1923                     return "fatal: can't insert cust_tax_exempt_pkg: $error";
1924                   }
1925                 } # if $remaining_exemption > 0
1926
1927                 #++
1928                 $mon++;
1929                 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1930                 until ( $mon < 13 ) { $mon -= 12; $year++; }
1931
1932               } #foreach $which_month
1933
1934             } #if $tax->exempt_amount
1935
1936             $taxable_charged = sprintf( "%.2f", $taxable_charged);
1937
1938             #$tax += $taxable_charged * $cust_main_county->tax / 100
1939             $tax{ $tax->taxname || 'Tax' } +=
1940               $taxable_charged * $tax->tax / 100
1941
1942           } #foreach my $tax ( @taxes )
1943
1944         } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1945
1946       } #if $setup != 0 || $recur != 0
1947
1948     } #if $cust_pkg->modified
1949
1950   } #foreach my $cust_pkg
1951
1952   unless ( $cust_bill->cust_bill_pkg ) {
1953     $cust_bill->delete; #don't create an invoice w/o line items
1954     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1955     return '';
1956   }
1957
1958   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1959
1960   foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1961     my $tax = sprintf("%.2f", $tax{$taxname} );
1962     $charged = sprintf( "%.2f", $charged+$tax );
1963
1964     my $cust_bill_pkg = new FS::cust_bill_pkg ({
1965       'invnum'   => $invnum,
1966       'pkgnum'   => 0,
1967       'setup'    => $tax,
1968       'recur'    => 0,
1969       'sdate'    => '',
1970       'edate'    => '',
1971       'itemdesc' => $taxname,
1972     });
1973     $error = $cust_bill_pkg->insert;
1974     if ( $error ) {
1975       $dbh->rollback if $oldAutoCommit;
1976       return "can't create invoice line item for invoice #$invnum: $error";
1977     }
1978     $total_setup += $tax;
1979
1980   }
1981
1982   $cust_bill->charged( sprintf( "%.2f", $total_setup + $total_recur ) );
1983   $error = $cust_bill->replace;
1984   if ( $error ) {
1985     $dbh->rollback if $oldAutoCommit;
1986     return "can't update charged for invoice #$invnum: $error";
1987   }
1988
1989   foreach my $hook ( @precommit_hooks ) {
1990     eval {
1991       &{$hook}; #($self) ?
1992     };
1993     if ( $@ ) {
1994       $dbh->rollback if $oldAutoCommit;
1995       return "$@ running precommit hook $hook\n";
1996     }
1997   }
1998
1999   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2000   ''; #no error
2001 }
2002
2003 =item collect OPTIONS
2004
2005 (Attempt to) collect money for this customer's outstanding invoices (see
2006 L<FS::cust_bill>).  Usually used after the bill method.
2007
2008 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
2009 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
2010 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
2011
2012 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
2013 and the invoice events web interface.
2014
2015 If there is an error, returns the error, otherwise returns false.
2016
2017 Options are passed as name-value pairs.
2018
2019 Currently available options are:
2020
2021 invoice_time - Use this time when deciding when to print invoices and
2022 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>
2023 for conversion functions.
2024
2025 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
2026 events.
2027
2028 quiet - set true to surpress email card/ACH decline notices.
2029
2030 freq - "1d" for the traditional, daily events (the default), or "1m" for the
2031 new monthly events
2032
2033 =cut
2034
2035 sub collect {
2036   my( $self, %options ) = @_;
2037   my $invoice_time = $options{'invoice_time'} || time;
2038
2039   #put below somehow?
2040   local $SIG{HUP} = 'IGNORE';
2041   local $SIG{INT} = 'IGNORE';
2042   local $SIG{QUIT} = 'IGNORE';
2043   local $SIG{TERM} = 'IGNORE';
2044   local $SIG{TSTP} = 'IGNORE';
2045   local $SIG{PIPE} = 'IGNORE';
2046
2047   my $oldAutoCommit = $FS::UID::AutoCommit;
2048   local $FS::UID::AutoCommit = 0;
2049   my $dbh = dbh;
2050
2051   $self->select_for_update; #mutex
2052
2053   my $balance = $self->balance;
2054   warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2055     if $DEBUG;
2056   unless ( $balance > 0 ) { #redundant?????
2057     $dbh->rollback if $oldAutoCommit; #hmm
2058     return '';
2059   }
2060
2061   if ( exists($options{'retry_card'}) ) {
2062     carp 'retry_card option passed to collect is deprecated; use retry';
2063     $options{'retry'} ||= $options{'retry_card'};
2064   }
2065   if ( exists($options{'retry'}) && $options{'retry'} ) {
2066     my $error = $self->retry_realtime;
2067     if ( $error ) {
2068       $dbh->rollback if $oldAutoCommit;
2069       return $error;
2070     }
2071   }
2072
2073   my $extra_sql = '';
2074   if ( defined $options{'freq'} && $options{'freq'} eq '1m' ) {
2075     $extra_sql = " AND freq = '1m' ";
2076   } else {
2077     $extra_sql = " AND ( freq = '1d' OR freq IS NULL OR freq = '' ) ";
2078   }
2079
2080   foreach my $cust_bill ( $self->open_cust_bill ) {
2081
2082     # don't try to charge for the same invoice if it's already in a batch
2083     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
2084
2085     last if $self->balance <= 0;
2086
2087     warn "  invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n"
2088       if $DEBUG > 1;
2089
2090     foreach my $part_bill_event (
2091       sort {    $a->seconds   <=> $b->seconds
2092              || $a->weight    <=> $b->weight
2093              || $a->eventpart <=> $b->eventpart }
2094         grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
2095                && ! qsearch( 'cust_bill_event', {
2096                                 'invnum'    => $cust_bill->invnum,
2097                                 'eventpart' => $_->eventpart,
2098                                 'status'    => 'done',
2099                                                                    } )
2100              }
2101           qsearch( {
2102             'table'     => 'part_bill_event',
2103             'hashref'   => { 'payby'    => $self->payby,
2104                              'disabled' => '',           },
2105             'extra_sql' => $extra_sql,
2106           } )
2107     ) {
2108
2109       last if $cust_bill->owed <= 0  # don't run subsequent events if owed<=0
2110            || $self->balance   <= 0; # or if balance<=0
2111
2112       warn "  calling invoice event (". $part_bill_event->eventcode. ")\n"
2113         if $DEBUG > 1;
2114       my $cust_main = $self; #for callback
2115
2116       my $error;
2117       {
2118         local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2119         local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
2120         $error = eval $part_bill_event->eventcode;
2121       }
2122
2123       my $status = '';
2124       my $statustext = '';
2125       if ( $@ ) {
2126         $status = 'failed';
2127         $statustext = $@;
2128       } elsif ( $error ) {
2129         $status = 'done';
2130         $statustext = $error;
2131       } else {
2132         $status = 'done'
2133       }
2134
2135       #add cust_bill_event
2136       my $cust_bill_event = new FS::cust_bill_event {
2137         'invnum'     => $cust_bill->invnum,
2138         'eventpart'  => $part_bill_event->eventpart,
2139         #'_date'      => $invoice_time,
2140         '_date'      => time,
2141         'status'     => $status,
2142         'statustext' => $statustext,
2143       };
2144       $error = $cust_bill_event->insert;
2145       if ( $error ) {
2146         #$dbh->rollback if $oldAutoCommit;
2147         #return "error: $error";
2148
2149         # gah, even with transactions.
2150         $dbh->commit if $oldAutoCommit; #well.
2151         my $e = 'WARNING: Event run but database not updated - '.
2152                 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
2153                 ', eventpart '. $part_bill_event->eventpart.
2154                 ": $error";
2155         warn $e;
2156         return $e;
2157       }
2158
2159
2160     }
2161
2162   }
2163
2164   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2165   '';
2166
2167 }
2168
2169 =item retry_realtime
2170
2171 Schedules realtime credit card / electronic check / LEC billing events for
2172 for retry.  Useful if card information has changed or manual retry is desired.
2173 The 'collect' method must be called to actually retry the transaction.
2174
2175 Implementation details: For each of this customer's open invoices, changes
2176 the status of the first "done" (with statustext error) realtime processing
2177 event to "failed".
2178
2179 =cut
2180
2181 sub retry_realtime {
2182   my $self = shift;
2183
2184   local $SIG{HUP} = 'IGNORE';
2185   local $SIG{INT} = 'IGNORE';
2186   local $SIG{QUIT} = 'IGNORE';
2187   local $SIG{TERM} = 'IGNORE';
2188   local $SIG{TSTP} = 'IGNORE';
2189   local $SIG{PIPE} = 'IGNORE';
2190
2191   my $oldAutoCommit = $FS::UID::AutoCommit;
2192   local $FS::UID::AutoCommit = 0;
2193   my $dbh = dbh;
2194
2195   foreach my $cust_bill (
2196     grep { $_->cust_bill_event }
2197       $self->open_cust_bill
2198   ) {
2199     my @cust_bill_event =
2200       sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
2201         grep {
2202                #$_->part_bill_event->plan eq 'realtime-card'
2203                $_->part_bill_event->eventcode =~
2204                    /\$cust_bill\->realtime_(card|ach|lec)/
2205                  && $_->status eq 'done'
2206                  && $_->statustext
2207              }
2208           $cust_bill->cust_bill_event;
2209     next unless @cust_bill_event;
2210     my $error = $cust_bill_event[0]->retry;
2211     if ( $error ) {
2212       $dbh->rollback if $oldAutoCommit;
2213       return "error scheduling invoice event for retry: $error";
2214     }
2215
2216   }
2217
2218   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2219   '';
2220
2221 }
2222
2223 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
2224
2225 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
2226 via a Business::OnlinePayment realtime gateway.  See
2227 L<http://420.am/business-onlinepayment> for supported gateways.
2228
2229 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2230
2231 Available options are: I<description>, I<invnum>, I<quiet>
2232
2233 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2234 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2235 if set, will override the value from the customer record.
2236
2237 I<description> is a free-text field passed to the gateway.  It defaults to
2238 "Internet services".
2239
2240 If an I<invnum> is specified, this payment (if successful) is applied to the
2241 specified invoice.  If you don't specify an I<invnum> you might want to
2242 call the B<apply_payments> method.
2243
2244 I<quiet> can be set true to surpress email decline notices.
2245
2246 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
2247
2248 =cut
2249
2250 sub realtime_bop {
2251   my( $self, $method, $amount, %options ) = @_;
2252   if ( $DEBUG ) {
2253     warn "$me realtime_bop: $method $amount\n";
2254     warn "  $_ => $options{$_}\n" foreach keys %options;
2255   }
2256
2257   $options{'description'} ||= 'Internet services';
2258
2259   eval "use Business::OnlinePayment";
2260   die $@ if $@;
2261
2262   my $payinfo = exists($options{'payinfo'})
2263                   ? $options{'payinfo'}
2264                   : $self->payinfo;
2265
2266   ###
2267   # select a gateway
2268   ###
2269
2270   my $taxclass = '';
2271   if ( $options{'invnum'} ) {
2272     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
2273     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
2274     my @taxclasses =
2275       map  { $_->part_pkg->taxclass }
2276       grep { $_ }
2277       map  { $_->cust_pkg }
2278       $cust_bill->cust_bill_pkg;
2279     unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
2280                                                            #different taxclasses
2281       $taxclass = $taxclasses[0];
2282     }
2283   }
2284
2285   #look for an agent gateway override first
2286   my $cardtype;
2287   if ( $method eq 'CC' ) {
2288     $cardtype = cardtype($payinfo);
2289   } elsif ( $method eq 'ECHECK' ) {
2290     $cardtype = 'ACH';
2291   } else {
2292     $cardtype = $method;
2293   }
2294
2295   my $override =
2296        qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2297                                            cardtype => $cardtype,
2298                                            taxclass => $taxclass,       } )
2299     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2300                                            cardtype => '',
2301                                            taxclass => $taxclass,       } )
2302     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2303                                            cardtype => $cardtype,
2304                                            taxclass => '',              } )
2305     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2306                                            cardtype => '',
2307                                            taxclass => '',              } );
2308
2309   my $payment_gateway = '';
2310   my( $processor, $login, $password, $action, @bop_options );
2311   if ( $override ) { #use a payment gateway override
2312
2313     $payment_gateway = $override->payment_gateway;
2314
2315     $processor   = $payment_gateway->gateway_module;
2316     $login       = $payment_gateway->gateway_username;
2317     $password    = $payment_gateway->gateway_password;
2318     $action      = $payment_gateway->gateway_action;
2319     @bop_options = $payment_gateway->options;
2320
2321   } else { #use the standard settings from the config
2322
2323     ( $processor, $login, $password, $action, @bop_options ) =
2324       $self->default_payment_gateway($method);
2325
2326   }
2327
2328   ###
2329   # massage data
2330   ###
2331
2332   my $address = exists($options{'address1'})
2333                     ? $options{'address1'}
2334                     : $self->address1;
2335   my $address2 = exists($options{'address2'})
2336                     ? $options{'address2'}
2337                     : $self->address2;
2338   $address .= ", ". $address2 if length($address2);
2339
2340   my $o_payname = exists($options{'payname'})
2341                     ? $options{'payname'}
2342                     : $self->payname;
2343   my($payname, $payfirst, $paylast);
2344   if ( $o_payname && $method ne 'ECHECK' ) {
2345     ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2346       or return "Illegal payname $payname";
2347     ($payfirst, $paylast) = ($1, $2);
2348   } else {
2349     $payfirst = $self->getfield('first');
2350     $paylast = $self->getfield('last');
2351     $payname =  "$payfirst $paylast";
2352   }
2353
2354   my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
2355   if ( $conf->exists('emailinvoiceauto')
2356        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
2357     push @invoicing_list, $self->all_emails;
2358   }
2359
2360   my $email = ($conf->exists('business-onlinepayment-email-override'))
2361               ? $conf->config('business-onlinepayment-email-override')
2362               : $invoicing_list[0];
2363
2364   my %content = ();
2365
2366   my $payip = exists($options{'payip'})
2367                 ? $options{'payip'}
2368                 : $self->payip;
2369   $content{customer_ip} = $payip
2370     if length($payip);
2371
2372   if ( $method eq 'CC' ) {
2373
2374     $content{card_number} = $payinfo;
2375     my $paydate = exists($options{'paydate'})
2376                     ? $options{'paydate'}
2377                     : $self->paydate;
2378     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2379     $content{expiration} = "$2/$1";
2380
2381     my $paycvv = exists($options{'paycvv'})
2382                    ? $options{'paycvv'}
2383                    : $self->paycvv;
2384     $content{cvv2} = $self->paycvv
2385       if length($paycvv);
2386
2387     my $paystart_month = exists($options{'paystart_month'})
2388                            ? $options{'paystart_month'}
2389                            : $self->paystart_month;
2390
2391     my $paystart_year  = exists($options{'paystart_year'})
2392                            ? $options{'paystart_year'}
2393                            : $self->paystart_year;
2394
2395     $content{card_start} = "$paystart_month/$paystart_year"
2396       if $paystart_month && $paystart_year;
2397
2398     my $payissue       = exists($options{'payissue'})
2399                            ? $options{'payissue'}
2400                            : $self->payissue;
2401     $content{issue_number} = $payissue if $payissue;
2402
2403     $content{recurring_billing} = 'YES'
2404       if qsearch('cust_pay', { 'custnum' => $self->custnum,
2405                                'payby'   => 'CARD',
2406                                'payinfo' => $payinfo,
2407                              } );
2408
2409   } elsif ( $method eq 'ECHECK' ) {
2410     ( $content{account_number}, $content{routing_code} ) =
2411       split('@', $payinfo);
2412     $content{bank_name} = $o_payname;
2413     $content{account_type} = 'CHECKING';
2414     $content{account_name} = $payname;
2415     $content{customer_org} = $self->company ? 'B' : 'I';
2416     $content{customer_ssn} = exists($options{'ss'})
2417                                ? $options{'ss'}
2418                                : $self->ss;
2419   } elsif ( $method eq 'LEC' ) {
2420     $content{phone} = $payinfo;
2421   }
2422
2423   ###
2424   # run transaction(s)
2425   ###
2426
2427   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
2428
2429   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
2430   $transaction->content(
2431     'type'           => $method,
2432     'login'          => $login,
2433     'password'       => $password,
2434     'action'         => $action1,
2435     'description'    => $options{'description'},
2436     'amount'         => $amount,
2437     'invoice_number' => $options{'invnum'},
2438     'customer_id'    => $self->custnum,
2439     'last_name'      => $paylast,
2440     'first_name'     => $payfirst,
2441     'name'           => $payname,
2442     'address'        => $address,
2443     'city'           => ( exists($options{'city'})
2444                             ? $options{'city'}
2445                             : $self->city          ),
2446     'state'          => ( exists($options{'state'})
2447                             ? $options{'state'}
2448                             : $self->state          ),
2449     'zip'            => ( exists($options{'zip'})
2450                             ? $options{'zip'}
2451                             : $self->zip          ),
2452     'country'        => ( exists($options{'country'})
2453                             ? $options{'country'}
2454                             : $self->country          ),
2455     'referer'        => 'http://cleanwhisker.420.am/',
2456     'email'          => $email,
2457     'phone'          => $self->daytime || $self->night,
2458     %content, #after
2459   );
2460   $transaction->submit();
2461
2462   if ( $transaction->is_success() && $action2 ) {
2463     my $auth = $transaction->authorization;
2464     my $ordernum = $transaction->can('order_number')
2465                    ? $transaction->order_number
2466                    : '';
2467
2468     my $capture =
2469       new Business::OnlinePayment( $processor, @bop_options );
2470
2471     my %capture = (
2472       %content,
2473       type           => $method,
2474       action         => $action2,
2475       login          => $login,
2476       password       => $password,
2477       order_number   => $ordernum,
2478       amount         => $amount,
2479       authorization  => $auth,
2480       description    => $options{'description'},
2481     );
2482
2483     foreach my $field (qw( authorization_source_code returned_ACI                                          transaction_identifier validation_code
2484                            transaction_sequence_num local_transaction_date
2485                            local_transaction_time AVS_result_code          )) {
2486       $capture{$field} = $transaction->$field() if $transaction->can($field);
2487     }
2488
2489     $capture->content( %capture );
2490
2491     $capture->submit();
2492
2493     unless ( $capture->is_success ) {
2494       my $e = "Authorization successful but capture failed, custnum #".
2495               $self->custnum. ': '.  $capture->result_code.
2496               ": ". $capture->error_message;
2497       warn $e;
2498       return $e;
2499     }
2500
2501   }
2502
2503   ###
2504   # remove paycvv after initial transaction
2505   ###
2506
2507   #false laziness w/misc/process/payment.cgi - check both to make sure working
2508   # correctly
2509   if ( defined $self->dbdef_table->column('paycvv')
2510        && length($self->paycvv)
2511        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2512   ) {
2513     my $error = $self->remove_cvv;
2514     if ( $error ) {
2515       warn "WARNING: error removing cvv: $error\n";
2516     }
2517   }
2518
2519   ###
2520   # result handling
2521   ###
2522
2523   if ( $transaction->is_success() ) {
2524
2525     my %method2payby = (
2526       'CC'     => 'CARD',
2527       'ECHECK' => 'CHEK',
2528       'LEC'    => 'LECB',
2529     );
2530
2531     my $paybatch = '';
2532     if ( $payment_gateway ) { # agent override
2533       $paybatch = $payment_gateway->gatewaynum. '-';
2534     }
2535
2536     $paybatch .= "$processor:". $transaction->authorization;
2537
2538     $paybatch .= ':'. $transaction->order_number
2539       if $transaction->can('order_number')
2540       && length($transaction->order_number);
2541
2542     my $cust_pay = new FS::cust_pay ( {
2543        'custnum'  => $self->custnum,
2544        'invnum'   => $options{'invnum'},
2545        'paid'     => $amount,
2546        '_date'     => '',
2547        'payby'    => $method2payby{$method},
2548        'payinfo'  => $payinfo,
2549        'paybatch' => $paybatch,
2550     } );
2551     my $error = $cust_pay->insert;
2552     if ( $error ) {
2553       $cust_pay->invnum(''); #try again with no specific invnum
2554       my $error2 = $cust_pay->insert;
2555       if ( $error2 ) {
2556         # gah, even with transactions.
2557         my $e = 'WARNING: Card/ACH debited but database not updated - '.
2558                 "error inserting payment ($processor): $error2".
2559                 " (previously tried insert with invnum #$options{'invnum'}" .
2560                 ": $error )";
2561         warn $e;
2562         return $e;
2563       }
2564     }
2565     return ''; #no error
2566
2567   } else {
2568
2569     my $perror = "$processor error: ". $transaction->error_message;
2570
2571     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2572          && $conf->exists('emaildecline')
2573          && grep { $_ ne 'POST' } $self->invoicing_list
2574          && ! grep { $transaction->error_message =~ /$_/ }
2575                    $conf->config('emaildecline-exclude')
2576     ) {
2577       my @templ = $conf->config('declinetemplate');
2578       my $template = new Text::Template (
2579         TYPE   => 'ARRAY',
2580         SOURCE => [ map "$_\n", @templ ],
2581       ) or return "($perror) can't create template: $Text::Template::ERROR";
2582       $template->compile()
2583         or return "($perror) can't compile template: $Text::Template::ERROR";
2584
2585       my $templ_hash = { error => $transaction->error_message };
2586
2587       my $error = send_email(
2588         'from'    => $conf->config('invoice_from'),
2589         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2590         'subject' => 'Your payment could not be processed',
2591         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
2592       );
2593
2594       $perror .= " (also received error sending decline notification: $error)"
2595         if $error;
2596
2597     }
2598
2599     return $perror;
2600   }
2601
2602 }
2603
2604 =item default_payment_gateway
2605
2606 =cut
2607
2608 sub default_payment_gateway {
2609   my( $self, $method ) = @_;
2610
2611   die "Real-time processing not enabled\n"
2612     unless $conf->exists('business-onlinepayment');
2613
2614   #load up config
2615   my $bop_config = 'business-onlinepayment';
2616   $bop_config .= '-ach'
2617     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2618   my ( $processor, $login, $password, $action, @bop_options ) =
2619     $conf->config($bop_config);
2620   $action ||= 'normal authorization';
2621   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2622   die "No real-time processor is enabled - ".
2623       "did you set the business-onlinepayment configuration value?\n"
2624     unless $processor;
2625
2626   ( $processor, $login, $password, $action, @bop_options )
2627 }
2628
2629 =item remove_cvv
2630
2631 Removes the I<paycvv> field from the database directly.
2632
2633 If there is an error, returns the error, otherwise returns false.
2634
2635 =cut
2636
2637 sub remove_cvv {
2638   my $self = shift;
2639   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2640     or return dbh->errstr;
2641   $sth->execute($self->custnum)
2642     or return $sth->errstr;
2643   $self->paycvv('');
2644   '';
2645 }
2646
2647 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2648
2649 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2650 via a Business::OnlinePayment realtime gateway.  See
2651 L<http://420.am/business-onlinepayment> for supported gateways.
2652
2653 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2654
2655 Available options are: I<amount>, I<reason>, I<paynum>
2656
2657 Most gateways require a reference to an original payment transaction to refund,
2658 so you probably need to specify a I<paynum>.
2659
2660 I<amount> defaults to the original amount of the payment if not specified.
2661
2662 I<reason> specifies a reason for the refund.
2663
2664 Implementation note: If I<amount> is unspecified or equal to the amount of the
2665 orignal payment, first an attempt is made to "void" the transaction via
2666 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2667 the normal attempt is made to "refund" ("credit") the transaction via the
2668 gateway is attempted.
2669
2670 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2671 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2672 #if set, will override the value from the customer record.
2673
2674 #If an I<invnum> is specified, this payment (if successful) is applied to the
2675 #specified invoice.  If you don't specify an I<invnum> you might want to
2676 #call the B<apply_payments> method.
2677
2678 =cut
2679
2680 #some false laziness w/realtime_bop, not enough to make it worth merging
2681 #but some useful small subs should be pulled out
2682 sub realtime_refund_bop {
2683   my( $self, $method, %options ) = @_;
2684   if ( $DEBUG ) {
2685     warn "$me realtime_refund_bop: $method refund\n";
2686     warn "  $_ => $options{$_}\n" foreach keys %options;
2687   }
2688
2689   eval "use Business::OnlinePayment";
2690   die $@ if $@;
2691
2692   ###
2693   # look up the original payment and optionally a gateway for that payment
2694   ###
2695
2696   my $cust_pay = '';
2697   my $amount = $options{'amount'};
2698
2699   my( $processor, $login, $password, @bop_options ) ;
2700   my( $auth, $order_number ) = ( '', '', '' );
2701
2702   if ( $options{'paynum'} ) {
2703
2704     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
2705     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2706       or return "Unknown paynum $options{'paynum'}";
2707     $amount ||= $cust_pay->paid;
2708
2709     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/
2710       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2711                 $cust_pay->paybatch;
2712     my $gatewaynum = '';
2713     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
2714
2715     if ( $gatewaynum ) { #gateway for the payment to be refunded
2716
2717       my $payment_gateway =
2718         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
2719       die "payment gateway $gatewaynum not found"
2720         unless $payment_gateway;
2721
2722       $processor   = $payment_gateway->gateway_module;
2723       $login       = $payment_gateway->gateway_username;
2724       $password    = $payment_gateway->gateway_password;
2725       @bop_options = $payment_gateway->options;
2726
2727     } else { #try the default gateway
2728
2729       my( $conf_processor, $unused_action );
2730       ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
2731         $self->default_payment_gateway($method);
2732
2733       return "processor of payment $options{'paynum'} $processor does not".
2734              " match default processor $conf_processor"
2735         unless $processor eq $conf_processor;
2736
2737     }
2738
2739
2740   } else { # didn't specify a paynum, so look for agent gateway overrides
2741            # like a normal transaction
2742
2743     my $cardtype;
2744     if ( $method eq 'CC' ) {
2745       $cardtype = cardtype($self->payinfo);
2746     } elsif ( $method eq 'ECHECK' ) {
2747       $cardtype = 'ACH';
2748     } else {
2749       $cardtype = $method;
2750     }
2751     my $override =
2752            qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2753                                                cardtype => $cardtype,
2754                                                taxclass => '',              } )
2755         || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2756                                                cardtype => '',
2757                                                taxclass => '',              } );
2758
2759     if ( $override ) { #use a payment gateway override
2760
2761       my $payment_gateway = $override->payment_gateway;
2762
2763       $processor   = $payment_gateway->gateway_module;
2764       $login       = $payment_gateway->gateway_username;
2765       $password    = $payment_gateway->gateway_password;
2766       #$action      = $payment_gateway->gateway_action;
2767       @bop_options = $payment_gateway->options;
2768
2769     } else { #use the standard settings from the config
2770
2771       my $unused_action;
2772       ( $processor, $login, $password, $unused_action, @bop_options ) =
2773         $self->default_payment_gateway($method);
2774
2775     }
2776
2777   }
2778   return "neither amount nor paynum specified" unless $amount;
2779
2780   my %content = (
2781     'type'           => $method,
2782     'login'          => $login,
2783     'password'       => $password,
2784     'order_number'   => $order_number,
2785     'amount'         => $amount,
2786     'referer'        => 'http://cleanwhisker.420.am/',
2787   );
2788   $content{authorization} = $auth
2789     if length($auth); #echeck/ACH transactions have an order # but no auth
2790                       #(at least with authorize.net)
2791
2792   #first try void if applicable
2793   if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2794     warn "  attempting void\n" if $DEBUG > 1;
2795     my $void = new Business::OnlinePayment( $processor, @bop_options );
2796     $void->content( 'action' => 'void', %content );
2797     $void->submit();
2798     if ( $void->is_success ) {
2799       my $error = $cust_pay->void($options{'reason'});
2800       if ( $error ) {
2801         # gah, even with transactions.
2802         my $e = 'WARNING: Card/ACH voided but database not updated - '.
2803                 "error voiding payment: $error";
2804         warn $e;
2805         return $e;
2806       }
2807       warn "  void successful\n" if $DEBUG > 1;
2808       return '';
2809     }
2810   }
2811
2812   warn "  void unsuccessful, trying refund\n"
2813     if $DEBUG > 1;
2814
2815   #massage data
2816   my $address = $self->address1;
2817   $address .= ", ". $self->address2 if $self->address2;
2818
2819   my($payname, $payfirst, $paylast);
2820   if ( $self->payname && $method ne 'ECHECK' ) {
2821     $payname = $self->payname;
2822     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2823       or return "Illegal payname $payname";
2824     ($payfirst, $paylast) = ($1, $2);
2825   } else {
2826     $payfirst = $self->getfield('first');
2827     $paylast = $self->getfield('last');
2828     $payname =  "$payfirst $paylast";
2829   }
2830
2831   my $payinfo = '';
2832   if ( $method eq 'CC' ) {
2833
2834     if ( $cust_pay ) {
2835       $content{card_number} = $payinfo = $cust_pay->payinfo;
2836       #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2837       #$content{expiration} = "$2/$1";
2838     } else {
2839       $content{card_number} = $payinfo = $self->payinfo;
2840       $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2841       $content{expiration} = "$2/$1";
2842     }
2843
2844   } elsif ( $method eq 'ECHECK' ) {
2845     ( $content{account_number}, $content{routing_code} ) =
2846       split('@', $payinfo = $self->payinfo);
2847     $content{bank_name} = $self->payname;
2848     $content{account_type} = 'CHECKING';
2849     $content{account_name} = $payname;
2850     $content{customer_org} = $self->company ? 'B' : 'I';
2851     $content{customer_ssn} = $self->ss;
2852   } elsif ( $method eq 'LEC' ) {
2853     $content{phone} = $payinfo = $self->payinfo;
2854   }
2855
2856   #then try refund
2857   my $refund = new Business::OnlinePayment( $processor, @bop_options );
2858   my %sub_content = $refund->content(
2859     'action'         => 'credit',
2860     'customer_id'    => $self->custnum,
2861     'last_name'      => $paylast,
2862     'first_name'     => $payfirst,
2863     'name'           => $payname,
2864     'address'        => $address,
2865     'city'           => $self->city,
2866     'state'          => $self->state,
2867     'zip'            => $self->zip,
2868     'country'        => $self->country,
2869     %content, #after
2870   );
2871   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
2872     if $DEBUG > 1;
2873   $refund->submit();
2874
2875   return "$processor error: ". $refund->error_message
2876     unless $refund->is_success();
2877
2878   my %method2payby = (
2879     'CC'     => 'CARD',
2880     'ECHECK' => 'CHEK',
2881     'LEC'    => 'LECB',
2882   );
2883
2884   my $paybatch = "$processor:". $refund->authorization;
2885   $paybatch .= ':'. $refund->order_number
2886     if $refund->can('order_number') && $refund->order_number;
2887
2888   while ( $cust_pay && $cust_pay->unappled < $amount ) {
2889     my @cust_bill_pay = $cust_pay->cust_bill_pay;
2890     last unless @cust_bill_pay;
2891     my $cust_bill_pay = pop @cust_bill_pay;
2892     my $error = $cust_bill_pay->delete;
2893     last if $error;
2894   }
2895
2896   my $cust_refund = new FS::cust_refund ( {
2897     'custnum'  => $self->custnum,
2898     'paynum'   => $options{'paynum'},
2899     'refund'   => $amount,
2900     '_date'    => '',
2901     'payby'    => $method2payby{$method},
2902     'payinfo'  => $payinfo,
2903     'paybatch' => $paybatch,
2904     'reason'   => $options{'reason'} || 'card or ACH refund',
2905   } );
2906   my $error = $cust_refund->insert;
2907   if ( $error ) {
2908     $cust_refund->paynum(''); #try again with no specific paynum
2909     my $error2 = $cust_refund->insert;
2910     if ( $error2 ) {
2911       # gah, even with transactions.
2912       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2913               "error inserting refund ($processor): $error2".
2914               " (previously tried insert with paynum #$options{'paynum'}" .
2915               ": $error )";
2916       warn $e;
2917       return $e;
2918     }
2919   }
2920
2921   ''; #no error
2922
2923 }
2924
2925 =item total_owed
2926
2927 Returns the total owed for this customer on all invoices
2928 (see L<FS::cust_bill/owed>).
2929
2930 =cut
2931
2932 sub total_owed {
2933   my $self = shift;
2934   $self->total_owed_date(2145859200); #12/31/2037
2935 }
2936
2937 =item total_owed_date TIME
2938
2939 Returns the total owed for this customer on all invoices with date earlier than
2940 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2941 see L<Time::Local> and L<Date::Parse> for conversion functions.
2942
2943 =cut
2944
2945 sub total_owed_date {
2946   my $self = shift;
2947   my $time = shift;
2948   my $total_bill = 0;
2949   foreach my $cust_bill (
2950     grep { $_->_date <= $time }
2951       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2952   ) {
2953     $total_bill += $cust_bill->owed;
2954   }
2955   sprintf( "%.2f", $total_bill );
2956 }
2957
2958 =item apply_credits OPTION => VALUE ...
2959
2960 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2961 to outstanding invoice balances in chronological order (or reverse
2962 chronological order if the I<order> option is set to B<newest>) and returns the
2963 value of any remaining unapplied credits available for refund (see
2964 L<FS::cust_refund>).
2965
2966 =cut
2967
2968 sub apply_credits {
2969   my $self = shift;
2970   my %opt = @_;
2971
2972   return 0 unless $self->total_credited;
2973
2974   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2975       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2976
2977   my @invoices = $self->open_cust_bill;
2978   @invoices = sort { $b->_date <=> $a->_date } @invoices
2979     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2980
2981   my $credit;
2982   foreach my $cust_bill ( @invoices ) {
2983     my $amount;
2984
2985     if ( !defined($credit) || $credit->credited == 0) {
2986       $credit = pop @credits or last;
2987     }
2988
2989     if ($cust_bill->owed >= $credit->credited) {
2990       $amount=$credit->credited;
2991     }else{
2992       $amount=$cust_bill->owed;
2993     }
2994
2995     my $cust_credit_bill = new FS::cust_credit_bill ( {
2996       'crednum' => $credit->crednum,
2997       'invnum'  => $cust_bill->invnum,
2998       'amount'  => $amount,
2999     } );
3000     my $error = $cust_credit_bill->insert;
3001     die $error if $error;
3002
3003     redo if ($cust_bill->owed > 0);
3004
3005   }
3006
3007   return $self->total_credited;
3008 }
3009
3010 =item apply_payments
3011
3012 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
3013 to outstanding invoice balances in chronological order.
3014
3015  #and returns the value of any remaining unapplied payments.
3016
3017 =cut
3018
3019 sub apply_payments {
3020   my $self = shift;
3021
3022   #return 0 unless
3023
3024   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
3025       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
3026
3027   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
3028       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
3029
3030   my $payment;
3031
3032   foreach my $cust_bill ( @invoices ) {
3033     my $amount;
3034
3035     if ( !defined($payment) || $payment->unapplied == 0 ) {
3036       $payment = pop @payments or last;
3037     }
3038
3039     if ( $cust_bill->owed >= $payment->unapplied ) {
3040       $amount = $payment->unapplied;
3041     } else {
3042       $amount = $cust_bill->owed;
3043     }
3044
3045     my $cust_bill_pay = new FS::cust_bill_pay ( {
3046       'paynum' => $payment->paynum,
3047       'invnum' => $cust_bill->invnum,
3048       'amount' => $amount,
3049     } );
3050     my $error = $cust_bill_pay->insert;
3051     die $error if $error;
3052
3053     redo if ( $cust_bill->owed > 0);
3054
3055   }
3056
3057   return $self->total_unapplied_payments;
3058 }
3059
3060 =item total_credited
3061
3062 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3063 customer.  See L<FS::cust_credit/credited>.
3064
3065 =cut
3066
3067 sub total_credited {
3068   my $self = shift;
3069   my $total_credit = 0;
3070   foreach my $cust_credit ( qsearch('cust_credit', {
3071     'custnum' => $self->custnum,
3072   } ) ) {
3073     $total_credit += $cust_credit->credited;
3074   }
3075   sprintf( "%.2f", $total_credit );
3076 }
3077
3078 =item total_unapplied_payments
3079
3080 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3081 See L<FS::cust_pay/unapplied>.
3082
3083 =cut
3084
3085 sub total_unapplied_payments {
3086   my $self = shift;
3087   my $total_unapplied = 0;
3088   foreach my $cust_pay ( qsearch('cust_pay', {
3089     'custnum' => $self->custnum,
3090   } ) ) {
3091     $total_unapplied += $cust_pay->unapplied;
3092   }
3093   sprintf( "%.2f", $total_unapplied );
3094 }
3095
3096 =item balance
3097
3098 Returns the balance for this customer (total_owed minus total_credited
3099 minus total_unapplied_payments).
3100
3101 =cut
3102
3103 sub balance {
3104   my $self = shift;
3105   sprintf( "%.2f",
3106     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
3107   );
3108 }
3109
3110 =item balance_date TIME
3111
3112 Returns the balance for this customer, only considering invoices with date
3113 earlier than TIME (total_owed_date minus total_credited minus
3114 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
3115 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
3116 functions.
3117
3118 =cut
3119
3120 sub balance_date {
3121   my $self = shift;
3122   my $time = shift;
3123   sprintf( "%.2f",
3124     $self->total_owed_date($time)
3125       - $self->total_credited
3126       - $self->total_unapplied_payments
3127   );
3128 }
3129
3130 =item paydate_monthyear
3131
3132 Returns a two-element list consisting of the month and year of this customer's
3133 paydate (credit card expiration date for CARD customers)
3134
3135 =cut
3136
3137 sub paydate_monthyear {
3138   my $self = shift;
3139   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3140     ( $2, $1 );
3141   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3142     ( $1, $3 );
3143   } else {
3144     ('', '');
3145   }
3146 }
3147
3148 =item payinfo_masked
3149
3150 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.
3151
3152 Credit Cards - Mask all but the last four characters.
3153 Checks - Mask all but last 2 of account number and bank routing number.
3154 Others - Do nothing, return the unmasked string.
3155
3156 =cut
3157
3158 sub payinfo_masked {
3159   my $self = shift;
3160   return $self->paymask;
3161 }
3162
3163 =item invoicing_list [ ARRAYREF ]
3164
3165 If an arguement is given, sets these email addresses as invoice recipients
3166 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
3167 (except as warnings), so use check_invoicing_list first.
3168
3169 Returns a list of email addresses (with svcnum entries expanded).
3170
3171 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
3172 check it without disturbing anything by passing nothing.
3173
3174 This interface may change in the future.
3175
3176 =cut
3177
3178 sub invoicing_list {
3179   my( $self, $arrayref ) = @_;
3180   if ( $arrayref ) {
3181     my @cust_main_invoice;
3182     if ( $self->custnum ) {
3183       @cust_main_invoice =
3184         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3185     } else {
3186       @cust_main_invoice = ();
3187     }
3188     foreach my $cust_main_invoice ( @cust_main_invoice ) {
3189       #warn $cust_main_invoice->destnum;
3190       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3191         #warn $cust_main_invoice->destnum;
3192         my $error = $cust_main_invoice->delete;
3193         warn $error if $error;
3194       }
3195     }
3196     if ( $self->custnum ) {
3197       @cust_main_invoice =
3198         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3199     } else {
3200       @cust_main_invoice = ();
3201     }
3202     my %seen = map { $_->address => 1 } @cust_main_invoice;
3203     foreach my $address ( @{$arrayref} ) {
3204       next if exists $seen{$address} && $seen{$address};
3205       $seen{$address} = 1;
3206       my $cust_main_invoice = new FS::cust_main_invoice ( {
3207         'custnum' => $self->custnum,
3208         'dest'    => $address,
3209       } );
3210       my $error = $cust_main_invoice->insert;
3211       warn $error if $error;
3212     }
3213   }
3214   if ( $self->custnum ) {
3215     map { $_->address }
3216       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3217   } else {
3218     ();
3219   }
3220 }
3221
3222 =item check_invoicing_list ARRAYREF
3223
3224 Checks these arguements as valid input for the invoicing_list method.  If there
3225 is an error, returns the error, otherwise returns false.
3226
3227 =cut
3228
3229 sub check_invoicing_list {
3230   my( $self, $arrayref ) = @_;
3231   foreach my $address ( @{$arrayref} ) {
3232
3233     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3234       return 'Can\'t add FAX invoice destination with a blank FAX number.';
3235     }
3236
3237     my $cust_main_invoice = new FS::cust_main_invoice ( {
3238       'custnum' => $self->custnum,
3239       'dest'    => $address,
3240     } );
3241     my $error = $self->custnum
3242                 ? $cust_main_invoice->check
3243                 : $cust_main_invoice->checkdest
3244     ;
3245     return $error if $error;
3246   }
3247   '';
3248 }
3249
3250 =item set_default_invoicing_list
3251
3252 Sets the invoicing list to all accounts associated with this customer,
3253 overwriting any previous invoicing list.
3254
3255 =cut
3256
3257 sub set_default_invoicing_list {
3258   my $self = shift;
3259   $self->invoicing_list($self->all_emails);
3260 }
3261
3262 =item all_emails
3263
3264 Returns the email addresses of all accounts provisioned for this customer.
3265
3266 =cut
3267
3268 sub all_emails {
3269   my $self = shift;
3270   my %list;
3271   foreach my $cust_pkg ( $self->all_pkgs ) {
3272     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3273     my @svc_acct =
3274       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3275         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3276           @cust_svc;
3277     $list{$_}=1 foreach map { $_->email } @svc_acct;
3278   }
3279   keys %list;
3280 }
3281
3282 =item invoicing_list_addpost
3283
3284 Adds postal invoicing to this customer.  If this customer is already configured
3285 to receive postal invoices, does nothing.
3286
3287 =cut
3288
3289 sub invoicing_list_addpost {
3290   my $self = shift;
3291   return if grep { $_ eq 'POST' } $self->invoicing_list;
3292   my @invoicing_list = $self->invoicing_list;
3293   push @invoicing_list, 'POST';
3294   $self->invoicing_list(\@invoicing_list);
3295 }
3296
3297 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3298
3299 Returns an array of customers referred by this customer (referral_custnum set
3300 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3301 customers referred by customers referred by this customer and so on, inclusive.
3302 The default behavior is DEPTH 1 (no recursion).
3303
3304 =cut
3305
3306 sub referral_cust_main {
3307   my $self = shift;
3308   my $depth = @_ ? shift : 1;
3309   my $exclude = @_ ? shift : {};
3310
3311   my @cust_main =
3312     map { $exclude->{$_->custnum}++; $_; }
3313       grep { ! $exclude->{ $_->custnum } }
3314         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3315
3316   if ( $depth > 1 ) {
3317     push @cust_main,
3318       map { $_->referral_cust_main($depth-1, $exclude) }
3319         @cust_main;
3320   }
3321
3322   @cust_main;
3323 }
3324
3325 =item referral_cust_main_ncancelled
3326
3327 Same as referral_cust_main, except only returns customers with uncancelled
3328 packages.
3329
3330 =cut
3331
3332 sub referral_cust_main_ncancelled {
3333   my $self = shift;
3334   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3335 }
3336
3337 =item referral_cust_pkg [ DEPTH ]
3338
3339 Like referral_cust_main, except returns a flat list of all unsuspended (and
3340 uncancelled) packages for each customer.  The number of items in this list may
3341 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3342
3343 =cut
3344
3345 sub referral_cust_pkg {
3346   my $self = shift;
3347   my $depth = @_ ? shift : 1;
3348
3349   map { $_->unsuspended_pkgs }
3350     grep { $_->unsuspended_pkgs }
3351       $self->referral_cust_main($depth);
3352 }
3353
3354 =item referring_cust_main
3355
3356 Returns the single cust_main record for the customer who referred this customer
3357 (referral_custnum), or false.
3358
3359 =cut
3360
3361 sub referring_cust_main {
3362   my $self = shift;
3363   return '' unless $self->referral_custnum;
3364   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3365 }
3366
3367 =item credit AMOUNT, REASON
3368
3369 Applies a credit to this customer.  If there is an error, returns the error,
3370 otherwise returns false.
3371
3372 =cut
3373
3374 sub credit {
3375   my( $self, $amount, $reason ) = @_;
3376   my $cust_credit = new FS::cust_credit {
3377     'custnum' => $self->custnum,
3378     'amount'  => $amount,
3379     'reason'  => $reason,
3380   };
3381   $cust_credit->insert;
3382 }
3383
3384 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3385
3386 Creates a one-time charge for this customer.  If there is an error, returns
3387 the error, otherwise returns false.
3388
3389 =cut
3390
3391 sub charge {
3392   my ( $self, $amount ) = ( shift, shift );
3393   my $pkg      = @_ ? shift : 'One-time charge';
3394   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
3395   my $taxclass = @_ ? shift : '';
3396
3397   local $SIG{HUP} = 'IGNORE';
3398   local $SIG{INT} = 'IGNORE';
3399   local $SIG{QUIT} = 'IGNORE';
3400   local $SIG{TERM} = 'IGNORE';
3401   local $SIG{TSTP} = 'IGNORE';
3402   local $SIG{PIPE} = 'IGNORE';
3403
3404   my $oldAutoCommit = $FS::UID::AutoCommit;
3405   local $FS::UID::AutoCommit = 0;
3406   my $dbh = dbh;
3407
3408   my $part_pkg = new FS::part_pkg ( {
3409     'pkg'      => $pkg,
3410     'comment'  => $comment,
3411     #'setup'    => $amount,
3412     #'recur'    => '0',
3413     'plan'     => 'flat',
3414     'plandata' => "setup_fee=$amount",
3415     'freq'     => 0,
3416     'disabled' => 'Y',
3417     'taxclass' => $taxclass,
3418   } );
3419
3420   my $error = $part_pkg->insert;
3421   if ( $error ) {
3422     $dbh->rollback if $oldAutoCommit;
3423     return $error;
3424   }
3425
3426   my $pkgpart = $part_pkg->pkgpart;
3427   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3428   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3429     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3430     $error = $type_pkgs->insert;
3431     if ( $error ) {
3432       $dbh->rollback if $oldAutoCommit;
3433       return $error;
3434     }
3435   }
3436
3437   my $cust_pkg = new FS::cust_pkg ( {
3438     'custnum' => $self->custnum,
3439     'pkgpart' => $pkgpart,
3440   } );
3441
3442   $error = $cust_pkg->insert;
3443   if ( $error ) {
3444     $dbh->rollback if $oldAutoCommit;
3445     return $error;
3446   }
3447
3448   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3449   '';
3450
3451 }
3452
3453 =item cust_bill
3454
3455 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3456
3457 =cut
3458
3459 sub cust_bill {
3460   my $self = shift;
3461   sort { $a->_date <=> $b->_date }
3462     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3463 }
3464
3465 =item open_cust_bill
3466
3467 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3468 customer.
3469
3470 =cut
3471
3472 sub open_cust_bill {
3473   my $self = shift;
3474   grep { $_->owed > 0 } $self->cust_bill;
3475 }
3476
3477 =item cust_credit
3478
3479 Returns all the credits (see L<FS::cust_credit>) for this customer.
3480
3481 =cut
3482
3483 sub cust_credit {
3484   my $self = shift;
3485   sort { $a->_date <=> $b->_date }
3486     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3487 }
3488
3489 =item cust_pay
3490
3491 Returns all the payments (see L<FS::cust_pay>) for this customer.
3492
3493 =cut
3494
3495 sub cust_pay {
3496   my $self = shift;
3497   sort { $a->_date <=> $b->_date }
3498     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3499 }
3500
3501 =item cust_pay_void
3502
3503 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3504
3505 =cut
3506
3507 sub cust_pay_void {
3508   my $self = shift;
3509   sort { $a->_date <=> $b->_date }
3510     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3511 }
3512
3513
3514 =item cust_refund
3515
3516 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3517
3518 =cut
3519
3520 sub cust_refund {
3521   my $self = shift;
3522   sort { $a->_date <=> $b->_date }
3523     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3524 }
3525
3526 =item select_for_update
3527
3528 Selects this record with the SQL "FOR UPDATE" command.  This can be useful as
3529 a mutex.
3530
3531 =cut
3532
3533 sub select_for_update {
3534   my $self = shift;
3535   qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
3536 }
3537
3538 =item name
3539
3540 Returns a name string for this customer, either "Company (Last, First)" or
3541 "Last, First".
3542
3543 =cut
3544
3545 sub name {
3546   my $self = shift;
3547   my $name = $self->contact;
3548   $name = $self->company. " ($name)" if $self->company;
3549   $name;
3550 }
3551
3552 =item ship_name
3553
3554 Returns a name string for this (service/shipping) contact, either
3555 "Company (Last, First)" or "Last, First".
3556
3557 =cut
3558
3559 sub ship_name {
3560   my $self = shift;
3561   if ( $self->get('ship_last') ) {
3562     my $name = $self->ship_contact;
3563     $name = $self->ship_company. " ($name)" if $self->ship_company;
3564     $name;
3565   } else {
3566     $self->name;
3567   }
3568 }
3569
3570 =item contact
3571
3572 Returns this customer's full (billing) contact name only, "Last, First"
3573
3574 =cut
3575
3576 sub contact {
3577   my $self = shift;
3578   $self->get('last'). ', '. $self->first;
3579 }
3580
3581 =item ship_contact
3582
3583 Returns this customer's full (shipping) contact name only, "Last, First"
3584
3585 =cut
3586
3587 sub ship_contact {
3588   my $self = shift;
3589   $self->get('ship_last')
3590     ? $self->get('ship_last'). ', '. $self->ship_first
3591     : $self->contact;
3592 }
3593
3594 =item status
3595
3596 Returns a status string for this customer, currently:
3597
3598 =over 4
3599
3600 =item prospect - No packages have ever been ordered
3601
3602 =item active - One or more recurring packages is active
3603
3604 =item suspended - All non-cancelled recurring packages are suspended
3605
3606 =item cancelled - All recurring packages are cancelled
3607
3608 =back
3609
3610 =cut
3611
3612 sub status {
3613   my $self = shift;
3614   for my $status (qw( prospect active suspended cancelled )) {
3615     my $method = $status.'_sql';
3616     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3617     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3618     $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
3619     return $status if $sth->fetchrow_arrayref->[0];
3620   }
3621 }
3622
3623 =item statuscolor
3624
3625 Returns a hex triplet color string for this customer's status.
3626
3627 =cut
3628
3629 my %statuscolor = (
3630   'prospect'  => '000000',
3631   'active'    => '00CC00',
3632   'suspended' => 'FF9900',
3633   'cancelled' => 'FF0000',
3634 );
3635 sub statuscolor {
3636   my $self = shift;
3637   $statuscolor{$self->status};
3638 }
3639
3640 =back
3641
3642 =head1 CLASS METHODS
3643
3644 =over 4
3645
3646 =item prospect_sql
3647
3648 Returns an SQL expression identifying prospective cust_main records (customers
3649 with no packages ever ordered)
3650
3651 =cut
3652
3653 sub prospect_sql { "
3654   0 = ( SELECT COUNT(*) FROM cust_pkg
3655           WHERE cust_pkg.custnum = cust_main.custnum
3656       )
3657 "; }
3658
3659 =item active_sql
3660
3661 Returns an SQL expression identifying active cust_main records.
3662
3663 =cut
3664
3665 sub active_sql { "
3666   0 < ( SELECT COUNT(*) FROM cust_pkg
3667           WHERE cust_pkg.custnum = cust_main.custnum
3668             AND ". FS::cust_pkg->active_sql. "
3669       )
3670 "; }
3671
3672 =item susp_sql
3673 =item suspended_sql
3674
3675 Returns an SQL expression identifying suspended cust_main records.
3676
3677 =cut
3678
3679 #my $recurring_sql = FS::cust_pkg->recurring_sql;
3680 my $recurring_sql = "
3681   '0' != ( select freq from part_pkg
3682              where cust_pkg.pkgpart = part_pkg.pkgpart )
3683 ";
3684
3685 sub suspended_sql { susp_sql(@_); }
3686 sub susp_sql { "
3687     0 < ( SELECT COUNT(*) FROM cust_pkg
3688             WHERE cust_pkg.custnum = cust_main.custnum
3689               AND $recurring_sql
3690               AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3691         )
3692     AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3693                 WHERE cust_pkg.custnum = cust_main.custnum
3694                   AND ". FS::cust_pkg->active_sql. "
3695             )
3696 "; }
3697
3698 =item cancel_sql
3699 =item cancelled_sql
3700
3701 Returns an SQL expression identifying cancelled cust_main records.
3702
3703 =cut
3704
3705 sub cancelled_sql { cancel_sql(@_); }
3706 sub cancel_sql { "
3707   0 < ( SELECT COUNT(*) FROM cust_pkg
3708           WHERE cust_pkg.custnum = cust_main.custnum
3709       )
3710   AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3711               WHERE cust_pkg.custnum = cust_main.custnum
3712                 AND $recurring_sql
3713                 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3714           )
3715 "; }
3716
3717 =item uncancel_sql
3718 =item uncancelled_sql
3719
3720 Returns an SQL expression identifying un-cancelled cust_main records.
3721
3722 =cut
3723
3724 sub uncancelled_sql { uncancel_sql(@_); }
3725 sub uncancel_sql { "
3726   ( 0 < ( SELECT COUNT(*) FROM cust_pkg
3727                  WHERE cust_pkg.custnum = cust_main.custnum
3728                    AND ( cust_pkg.cancel IS NULL
3729                          OR cust_pkg.cancel = 0
3730                        )
3731         )
3732     OR 0 = ( SELECT COUNT(*) FROM cust_pkg
3733                WHERE cust_pkg.custnum = cust_main.custnum
3734            )
3735   )
3736 "; }
3737
3738 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3739
3740 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3741 records.  Currently, only I<last> or I<company> may be specified (the
3742 appropriate ship_ field is also searched if applicable).
3743
3744 Additional options are the same as FS::Record::qsearch
3745
3746 =cut
3747
3748 sub fuzzy_search {
3749   my( $self, $fuzzy, $hash, @opt) = @_;
3750   #$self
3751   $hash ||= {};
3752   my @cust_main = ();
3753
3754   check_and_rebuild_fuzzyfiles();
3755   foreach my $field ( keys %$fuzzy ) {
3756     my $sub = \&{"all_$field"};
3757     my %match = ();
3758     $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
3759
3760     foreach ( keys %match ) {
3761       push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3762       push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
3763         if defined dbdef->table('cust_main')->column('ship_last');
3764     }
3765   }
3766
3767   my %saw = ();
3768   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
3769
3770   @cust_main;
3771
3772 }
3773
3774 =back
3775
3776 =head1 SUBROUTINES
3777
3778 =over 4
3779
3780 =item smart_search OPTION => VALUE ...
3781
3782 Accepts the following options: I<search>, the string to search for.  The string
3783 will be searched for as a customer number, last name or company name, first
3784 searching for an exact match then fuzzy and substring matches.
3785
3786 Any additional options treated as an additional qualifier on the search
3787 (i.e. I<agentnum>).
3788
3789 Returns a (possibly empty) array of FS::cust_main objects.
3790
3791 =cut
3792
3793 sub smart_search {
3794   my %options = @_;
3795   my $search = delete $options{'search'};
3796   my @cust_main = ();
3797
3798   if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3799
3800     push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } );
3801
3802   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3803
3804     my $value = lc($1);
3805     my $q_value = dbh->quote($value);
3806
3807     #exact
3808     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3809     $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3810     $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3811       if defined dbdef->table('cust_main')->column('ship_last');
3812     $sql .= ' )';
3813
3814     push @cust_main, qsearch( 'cust_main', \%options, '', $sql );
3815
3816     unless ( @cust_main ) {  #no exact match, trying substring/fuzzy
3817
3818       #still some false laziness w/ search/cust_main.cgi
3819
3820       #substring
3821       push @cust_main, qsearch( 'cust_main',
3822                                 { 'last'     => { 'op'    => 'ILIKE',
3823                                                   'value' => "%$q_value%" },
3824                                   %options,
3825                                 }
3826                               );
3827       push @cust_main, qsearch( 'cust_main',
3828                                 { 'ship_last' => { 'op'    => 'ILIKE',
3829                                                    'value' => "%$q_value%" },
3830                                   %options,
3831
3832                                 }
3833                               )
3834         if defined dbdef->table('cust_main')->column('ship_last');
3835
3836       push @cust_main, qsearch( 'cust_main',
3837                                 { 'company'  => { 'op'    => 'ILIKE',
3838                                                   'value' => "%$q_value%" },
3839                                   %options,
3840                                 }
3841                               );
3842       push @cust_main, qsearch( 'cust_main',
3843                                 { 'ship_company' => { 'op' => 'ILIKE',
3844                                                    'value' => "%$q_value%" },
3845                                   %options,
3846                                 }
3847                               )
3848         if defined dbdef->table('cust_main')->column('ship_last');
3849
3850       #fuzzy
3851       push @cust_main, FS::cust_main->fuzzy_search(
3852         { 'last'     => $value },
3853         \%options,
3854       );
3855       push @cust_main, FS::cust_main->fuzzy_search(
3856         { 'company'  => $value },
3857         \%options,
3858       );
3859
3860     }
3861
3862   }
3863
3864   @cust_main;
3865
3866 }
3867
3868 =item check_and_rebuild_fuzzyfiles
3869
3870 =cut
3871
3872 sub check_and_rebuild_fuzzyfiles {
3873   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3874   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3875     or &rebuild_fuzzyfiles;
3876 }
3877
3878 =item rebuild_fuzzyfiles
3879
3880 =cut
3881
3882 sub rebuild_fuzzyfiles {
3883
3884   use Fcntl qw(:flock);
3885
3886   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3887   mkdir $dir, 0700 unless -d $dir;
3888
3889   #last
3890
3891   open(LASTLOCK,">>$dir/cust_main.last")
3892     or die "can't open $dir/cust_main.last: $!";
3893   flock(LASTLOCK,LOCK_EX)
3894     or die "can't lock $dir/cust_main.last: $!";
3895
3896   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3897   push @all_last,
3898                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3899     if defined dbdef->table('cust_main')->column('ship_last');
3900
3901   open (LASTCACHE,">$dir/cust_main.last.tmp")
3902     or die "can't open $dir/cust_main.last.tmp: $!";
3903   print LASTCACHE join("\n", @all_last), "\n";
3904   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3905
3906   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3907   close LASTLOCK;
3908
3909   #company
3910
3911   open(COMPANYLOCK,">>$dir/cust_main.company")
3912     or die "can't open $dir/cust_main.company: $!";
3913   flock(COMPANYLOCK,LOCK_EX)
3914     or die "can't lock $dir/cust_main.company: $!";
3915
3916   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3917   push @all_company,
3918        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3919     if defined dbdef->table('cust_main')->column('ship_last');
3920
3921   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3922     or die "can't open $dir/cust_main.company.tmp: $!";
3923   print COMPANYCACHE join("\n", @all_company), "\n";
3924   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3925
3926   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3927   close COMPANYLOCK;
3928
3929 }
3930
3931 =item all_last
3932
3933 =cut
3934
3935 sub all_last {
3936   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3937   open(LASTCACHE,"<$dir/cust_main.last")
3938     or die "can't open $dir/cust_main.last: $!";
3939   my @array = map { chomp; $_; } <LASTCACHE>;
3940   close LASTCACHE;
3941   \@array;
3942 }
3943
3944 =item all_company
3945
3946 =cut
3947
3948 sub all_company {
3949   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3950   open(COMPANYCACHE,"<$dir/cust_main.company")
3951     or die "can't open $dir/cust_main.last: $!";
3952   my @array = map { chomp; $_; } <COMPANYCACHE>;
3953   close COMPANYCACHE;
3954   \@array;
3955 }
3956
3957 =item append_fuzzyfiles LASTNAME COMPANY
3958
3959 =cut
3960
3961 sub append_fuzzyfiles {
3962   my( $last, $company ) = @_;
3963
3964   &check_and_rebuild_fuzzyfiles;
3965
3966   use Fcntl qw(:flock);
3967
3968   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3969
3970   if ( $last ) {
3971
3972     open(LAST,">>$dir/cust_main.last")
3973       or die "can't open $dir/cust_main.last: $!";
3974     flock(LAST,LOCK_EX)
3975       or die "can't lock $dir/cust_main.last: $!";
3976
3977     print LAST "$last\n";
3978
3979     flock(LAST,LOCK_UN)
3980       or die "can't unlock $dir/cust_main.last: $!";
3981     close LAST;
3982   }
3983
3984   if ( $company ) {
3985
3986     open(COMPANY,">>$dir/cust_main.company")
3987       or die "can't open $dir/cust_main.company: $!";
3988     flock(COMPANY,LOCK_EX)
3989       or die "can't lock $dir/cust_main.company: $!";
3990
3991     print COMPANY "$company\n";
3992
3993     flock(COMPANY,LOCK_UN)
3994       or die "can't unlock $dir/cust_main.company: $!";
3995
3996     close COMPANY;
3997   }
3998
3999   1;
4000 }
4001
4002 =item batch_import
4003
4004 =cut
4005
4006 sub batch_import {
4007   my $param = shift;
4008   #warn join('-',keys %$param);
4009   my $fh = $param->{filehandle};
4010   my $agentnum = $param->{agentnum};
4011   my $refnum = $param->{refnum};
4012   my $pkgpart = $param->{pkgpart};
4013   my @fields = @{$param->{fields}};
4014
4015   eval "use Text::CSV_XS;";
4016   die $@ if $@;
4017
4018   my $csv = new Text::CSV_XS;
4019   #warn $csv;
4020   #warn $fh;
4021
4022   my $imported = 0;
4023   #my $columns;
4024
4025   local $SIG{HUP} = 'IGNORE';
4026   local $SIG{INT} = 'IGNORE';
4027   local $SIG{QUIT} = 'IGNORE';
4028   local $SIG{TERM} = 'IGNORE';
4029   local $SIG{TSTP} = 'IGNORE';
4030   local $SIG{PIPE} = 'IGNORE';
4031
4032   my $oldAutoCommit = $FS::UID::AutoCommit;
4033   local $FS::UID::AutoCommit = 0;
4034   my $dbh = dbh;
4035
4036   #while ( $columns = $csv->getline($fh) ) {
4037   my $line;
4038   while ( defined($line=<$fh>) ) {
4039
4040     $csv->parse($line) or do {
4041       $dbh->rollback if $oldAutoCommit;
4042       return "can't parse: ". $csv->error_input();
4043     };
4044
4045     my @columns = $csv->fields();
4046     #warn join('-',@columns);
4047
4048     my %cust_main = (
4049       agentnum => $agentnum,
4050       refnum   => $refnum,
4051       country  => $conf->config('countrydefault') || 'US',
4052       payby    => 'BILL', #default
4053       paydate  => '12/2037', #default
4054     );
4055     my $billtime = time;
4056     my %cust_pkg = ( pkgpart => $pkgpart );
4057     foreach my $field ( @fields ) {
4058       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
4059         #$cust_pkg{$1} = str2time( shift @$columns );
4060         if ( $1 eq 'setup' ) {
4061           $billtime = str2time(shift @columns);
4062         } else {
4063           $cust_pkg{$1} = str2time( shift @columns );
4064         }
4065       } else {
4066         #$cust_main{$field} = shift @$columns;
4067         $cust_main{$field} = shift @columns;
4068       }
4069     }
4070
4071     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
4072     my $cust_main = new FS::cust_main ( \%cust_main );
4073     use Tie::RefHash;
4074     tie my %hash, 'Tie::RefHash'; #this part is important
4075     $hash{$cust_pkg} = [] if $pkgpart;
4076     my $error = $cust_main->insert( \%hash );
4077
4078     if ( $error ) {
4079       $dbh->rollback if $oldAutoCommit;
4080       return "can't insert customer for $line: $error";
4081     }
4082
4083     #false laziness w/bill.cgi
4084     $error = $cust_main->bill( 'time' => $billtime );
4085     if ( $error ) {
4086       $dbh->rollback if $oldAutoCommit;
4087       return "can't bill customer for $line: $error";
4088     }
4089
4090     $cust_main->apply_payments;
4091     $cust_main->apply_credits;
4092
4093     $error = $cust_main->collect();
4094     if ( $error ) {
4095       $dbh->rollback if $oldAutoCommit;
4096       return "can't collect customer for $line: $error";
4097     }
4098
4099     $imported++;
4100   }
4101
4102   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4103
4104   return "Empty file!" unless $imported;
4105
4106   ''; #no error
4107
4108 }
4109
4110 =item batch_charge
4111
4112 =cut
4113
4114 sub batch_charge {
4115   my $param = shift;
4116   #warn join('-',keys %$param);
4117   my $fh = $param->{filehandle};
4118   my @fields = @{$param->{fields}};
4119
4120   eval "use Text::CSV_XS;";
4121   die $@ if $@;
4122
4123   my $csv = new Text::CSV_XS;
4124   #warn $csv;
4125   #warn $fh;
4126
4127   my $imported = 0;
4128   #my $columns;
4129
4130   local $SIG{HUP} = 'IGNORE';
4131   local $SIG{INT} = 'IGNORE';
4132   local $SIG{QUIT} = 'IGNORE';
4133   local $SIG{TERM} = 'IGNORE';
4134   local $SIG{TSTP} = 'IGNORE';
4135   local $SIG{PIPE} = 'IGNORE';
4136
4137   my $oldAutoCommit = $FS::UID::AutoCommit;
4138   local $FS::UID::AutoCommit = 0;
4139   my $dbh = dbh;
4140
4141   #while ( $columns = $csv->getline($fh) ) {
4142   my $line;
4143   while ( defined($line=<$fh>) ) {
4144
4145     $csv->parse($line) or do {
4146       $dbh->rollback if $oldAutoCommit;
4147       return "can't parse: ". $csv->error_input();
4148     };
4149
4150     my @columns = $csv->fields();
4151     #warn join('-',@columns);
4152
4153     my %row = ();
4154     foreach my $field ( @fields ) {
4155       $row{$field} = shift @columns;
4156     }
4157
4158     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
4159     unless ( $cust_main ) {
4160       $dbh->rollback if $oldAutoCommit;
4161       return "unknown custnum $row{'custnum'}";
4162     }
4163
4164     if ( $row{'amount'} > 0 ) {
4165       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4166       if ( $error ) {
4167         $dbh->rollback if $oldAutoCommit;
4168         return $error;
4169       }
4170       $imported++;
4171     } elsif ( $row{'amount'} < 0 ) {
4172       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4173                                       $row{'pkg'}                         );
4174       if ( $error ) {
4175         $dbh->rollback if $oldAutoCommit;
4176         return $error;
4177       }
4178       $imported++;
4179     } else {
4180       #hmm?
4181     }
4182
4183   }
4184
4185   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4186
4187   return "Empty file!" unless $imported;
4188
4189   ''; #no error
4190
4191 }
4192
4193 =back
4194
4195 =head1 BUGS
4196
4197 The delete method.
4198
4199 The delete method should possibly take an FS::cust_main object reference
4200 instead of a scalar customer number.
4201
4202 Bill and collect options should probably be passed as references instead of a
4203 list.
4204
4205 There should probably be a configuration file with a list of allowed credit
4206 card types.
4207
4208 No multiple currency support (probably a larger project than just this module).
4209
4210 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4211
4212 =head1 SEE ALSO
4213
4214 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4215 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4216 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
4217
4218 =cut
4219
4220 1;
4221