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