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