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