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