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 notes
1736
1737 Returns all notes (see L<FS::cust_main_note>) for this customer.
1738
1739 =cut
1740
1741 sub notes {
1742   my $self = shift;
1743   #order by?
1744   qsearch( 'cust_main_note',
1745            { 'custnum' => $self->custnum },
1746            '',
1747            'ORDER BY _DATE DESC'
1748          );
1749 }
1750
1751 =item agent
1752
1753 Returns the agent (see L<FS::agent>) for this customer.
1754
1755 =cut
1756
1757 sub agent {
1758   my $self = shift;
1759   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1760 }
1761
1762 =item bill OPTIONS
1763
1764 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
1765 conjunction with the collect method.
1766
1767 Options are passed as name-value pairs.
1768
1769 Currently available options are:
1770
1771 resetup - if set true, re-charges setup fees.
1772
1773 time - bills the customer as if it were that time.  Specified as a UNIX
1774 timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and
1775 L<Date::Parse> for conversion functions.  For example:
1776
1777  use Date::Parse;
1778  ...
1779  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1780
1781
1782 If there is an error, returns the error, otherwise returns false.
1783
1784 =cut
1785
1786 sub bill {
1787   my( $self, %options ) = @_;
1788   return '' if $self->payby eq 'COMP';
1789   warn "$me bill customer ". $self->custnum. "\n"
1790     if $DEBUG;
1791
1792   my $time = $options{'time'} || time;
1793
1794   my $error;
1795
1796   #put below somehow?
1797   local $SIG{HUP} = 'IGNORE';
1798   local $SIG{INT} = 'IGNORE';
1799   local $SIG{QUIT} = 'IGNORE';
1800   local $SIG{TERM} = 'IGNORE';
1801   local $SIG{TSTP} = 'IGNORE';
1802   local $SIG{PIPE} = 'IGNORE';
1803
1804   my $oldAutoCommit = $FS::UID::AutoCommit;
1805   local $FS::UID::AutoCommit = 0;
1806   my $dbh = dbh;
1807
1808   $self->select_for_update; #mutex
1809
1810   #create a new invoice
1811   #(we'll remove it later if it doesn't actually need to be generated [contains
1812   # no line items] and we're inside a transaciton so nothing else will see it)
1813   my $cust_bill = new FS::cust_bill ( {
1814     'custnum' => $self->custnum,
1815     '_date'   => $time,
1816     #'charged' => $charged,
1817     'charged' => 0,
1818   } );
1819   $error = $cust_bill->insert;
1820   if ( $error ) {
1821     $dbh->rollback if $oldAutoCommit;
1822     return "can't create invoice for customer #". $self->custnum. ": $error";
1823   }
1824   my $invnum = $cust_bill->invnum;
1825
1826   ###
1827   # find the packages which are due for billing, find out how much they are
1828   # & generate invoice database.
1829   ###
1830
1831   my( $total_setup, $total_recur ) = ( 0, 0 );
1832   my %tax;
1833   my @precommit_hooks = ();
1834
1835   foreach my $cust_pkg (
1836     qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1837   ) {
1838
1839     #NO!! next if $cust_pkg->cancel;
1840     next if $cust_pkg->getfield('cancel');
1841
1842     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
1843
1844     #? to avoid use of uninitialized value errors... ?
1845     $cust_pkg->setfield('bill', '')
1846       unless defined($cust_pkg->bill);
1847
1848     my $part_pkg = $cust_pkg->part_pkg;
1849
1850     my %hash = $cust_pkg->hash;
1851     my $old_cust_pkg = new FS::cust_pkg \%hash;
1852
1853     my @details = ();
1854
1855     ###
1856     # bill setup
1857     ###
1858
1859     my $setup = 0;
1860     if ( !$cust_pkg->setup || $options{'resetup'} ) {
1861
1862       warn "    bill setup\n" if $DEBUG > 1;
1863
1864       $setup = eval { $cust_pkg->calc_setup( $time ) };
1865       if ( $@ ) {
1866         $dbh->rollback if $oldAutoCommit;
1867         return "$@ running calc_setup for $cust_pkg\n";
1868       }
1869
1870       $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1871     }
1872
1873     ###
1874     # bill recurring fee
1875     ###
1876
1877     my $recur = 0;
1878     my $sdate;
1879     if ( $part_pkg->getfield('freq') ne '0' &&
1880          ! $cust_pkg->getfield('susp') &&
1881          ( $cust_pkg->getfield('bill') || 0 ) <= $time
1882     ) {
1883
1884       warn "    bill recur\n" if $DEBUG > 1;
1885
1886       # XXX shared with $recur_prog
1887       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1888
1889       #over two params!  lets at least switch to a hashref for the rest...
1890       my %param = ( 'precommit_hooks' => \@precommit_hooks, );
1891
1892       $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
1893       if ( $@ ) {
1894         $dbh->rollback if $oldAutoCommit;
1895         return "$@ running calc_recur for $cust_pkg\n";
1896       }
1897
1898       #change this bit to use Date::Manip? CAREFUL with timezones (see
1899       # mailing list archive)
1900       my ($sec,$min,$hour,$mday,$mon,$year) =
1901         (localtime($sdate) )[0,1,2,3,4,5];
1902
1903       #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1904       # only for figuring next bill date, nothing else, so, reset $sdate again
1905       # here
1906       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1907       $cust_pkg->last_bill($sdate)
1908         if $cust_pkg->dbdef_table->column('last_bill');
1909
1910       if ( $part_pkg->freq =~ /^\d+$/ ) {
1911         $mon += $part_pkg->freq;
1912         until ( $mon < 12 ) { $mon -= 12; $year++; }
1913       } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1914         my $weeks = $1;
1915         $mday += $weeks * 7;
1916       } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1917         my $days = $1;
1918         $mday += $days;
1919       } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
1920         my $hours = $1;
1921         $hour += $hours;
1922       } else {
1923         $dbh->rollback if $oldAutoCommit;
1924         return "unparsable frequency: ". $part_pkg->freq;
1925       }
1926       $cust_pkg->setfield('bill',
1927         timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1928     }
1929
1930     warn "\$setup is undefined" unless defined($setup);
1931     warn "\$recur is undefined" unless defined($recur);
1932     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1933
1934     ###
1935     # If $cust_pkg has been modified, update it and create cust_bill_pkg records
1936     ###
1937
1938     if ( $cust_pkg->modified ) {
1939
1940       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
1941         if $DEBUG >1;
1942
1943       $error=$cust_pkg->replace($old_cust_pkg);
1944       if ( $error ) { #just in case
1945         $dbh->rollback if $oldAutoCommit;
1946         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1947       }
1948
1949       $setup = sprintf( "%.2f", $setup );
1950       $recur = sprintf( "%.2f", $recur );
1951       if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1952         $dbh->rollback if $oldAutoCommit;
1953         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1954       }
1955       if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1956         $dbh->rollback if $oldAutoCommit;
1957         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1958       }
1959
1960       if ( $setup != 0 || $recur != 0 ) {
1961
1962         warn "    charges (setup=$setup, recur=$recur); adding line items\n"
1963           if $DEBUG > 1;
1964         my $cust_bill_pkg = new FS::cust_bill_pkg ({
1965           'invnum'  => $invnum,
1966           'pkgnum'  => $cust_pkg->pkgnum,
1967           'setup'   => $setup,
1968           'recur'   => $recur,
1969           'sdate'   => $sdate,
1970           'edate'   => $cust_pkg->bill,
1971           'details' => \@details,
1972         });
1973         $error = $cust_bill_pkg->insert;
1974         if ( $error ) {
1975           $dbh->rollback if $oldAutoCommit;
1976           return "can't create invoice line item for invoice #$invnum: $error";
1977         }
1978         $total_setup += $setup;
1979         $total_recur += $recur;
1980
1981         ###
1982         # handle taxes
1983         ###
1984
1985         unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1986
1987           my $prefix =
1988             ( $conf->exists('tax-ship_address') && length($self->ship_last) )
1989             ? 'ship_'
1990             : '';
1991           my %taxhash = map { $_ => $self->get("$prefix$_") }
1992                             qw( state county country );
1993
1994           $taxhash{'taxclass'} = $part_pkg->taxclass;
1995
1996           my @taxes = qsearch( 'cust_main_county', \%taxhash );
1997
1998           unless ( @taxes ) {
1999             $taxhash{'taxclass'} = '';
2000             @taxes =  qsearch( 'cust_main_county', \%taxhash );
2001           }
2002
2003           #one more try at a whole-country tax rate
2004           unless ( @taxes ) {
2005             $taxhash{$_} = '' foreach qw( state county );
2006             @taxes =  qsearch( 'cust_main_county', \%taxhash );
2007           }
2008
2009           # maybe eliminate this entirely, along with all the 0% records
2010           unless ( @taxes ) {
2011             $dbh->rollback if $oldAutoCommit;
2012             return
2013               "fatal: can't find tax rate for state/county/country/taxclass ".
2014               join('/', ( map $self->get("$prefix$_"),
2015                               qw(state county country)
2016                         ),
2017                         $part_pkg->taxclass ). "\n";
2018           }
2019
2020           foreach my $tax ( @taxes ) {
2021
2022             my $taxable_charged = 0;
2023             $taxable_charged += $setup
2024               unless $part_pkg->setuptax =~ /^Y$/i
2025                   || $tax->setuptax =~ /^Y$/i;
2026             $taxable_charged += $recur
2027               unless $part_pkg->recurtax =~ /^Y$/i
2028                   || $tax->recurtax =~ /^Y$/i;
2029             next unless $taxable_charged;
2030
2031             if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
2032               #my ($mon,$year) = (localtime($sdate) )[4,5];
2033               my ($mon,$year) = (localtime( $sdate || $cust_bill->_date ) )[4,5];
2034               $mon++;
2035               my $freq = $part_pkg->freq || 1;
2036               if ( $freq !~ /(\d+)$/ ) {
2037                 $dbh->rollback if $oldAutoCommit;
2038                 return "daily/weekly package definitions not (yet?)".
2039                        " compatible with monthly tax exemptions";
2040               }
2041               my $taxable_per_month =
2042                 sprintf("%.2f", $taxable_charged / $freq );
2043
2044               #call the whole thing off if this customer has any old
2045               #exemption records...
2046               my @cust_tax_exempt =
2047                 qsearch( 'cust_tax_exempt' => { custnum=> $self->custnum } );
2048               if ( @cust_tax_exempt ) {
2049                 $dbh->rollback if $oldAutoCommit;
2050                 return
2051                   'this customer still has old-style tax exemption records; '.
2052                   'run bin/fs-migrate-cust_tax_exempt?';
2053               }
2054
2055               foreach my $which_month ( 1 .. $freq ) {
2056
2057                 #maintain the new exemption table now
2058                 my $sql = "
2059                   SELECT SUM(amount)
2060                     FROM cust_tax_exempt_pkg
2061                       LEFT JOIN cust_bill_pkg USING ( billpkgnum )
2062                       LEFT JOIN cust_bill     USING ( invnum     )
2063                     WHERE custnum = ?
2064                       AND taxnum  = ?
2065                       AND year    = ?
2066                       AND month   = ?
2067                 ";
2068                 my $sth = dbh->prepare($sql) or do {
2069                   $dbh->rollback if $oldAutoCommit;
2070                   return "fatal: can't lookup exising exemption: ". dbh->errstr;
2071                 };
2072                 $sth->execute(
2073                   $self->custnum,
2074                   $tax->taxnum,
2075                   1900+$year,
2076                   $mon,
2077                 ) or do {
2078                   $dbh->rollback if $oldAutoCommit;
2079                   return "fatal: can't lookup exising exemption: ". dbh->errstr;
2080                 };
2081                 my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0;
2082
2083                 my $remaining_exemption =
2084                   $tax->exempt_amount - $existing_exemption;
2085                 if ( $remaining_exemption > 0 ) {
2086                   my $addl = $remaining_exemption > $taxable_per_month
2087                     ? $taxable_per_month
2088                     : $remaining_exemption;
2089                   $taxable_charged -= $addl;
2090
2091                   my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( {
2092                     'billpkgnum' => $cust_bill_pkg->billpkgnum,
2093                     'taxnum'     => $tax->taxnum,
2094                     'year'       => 1900+$year,
2095                     'month'      => $mon,
2096                     'amount'     => sprintf("%.2f", $addl ),
2097                   } );
2098                   $error = $cust_tax_exempt_pkg->insert;
2099                   if ( $error ) {
2100                     $dbh->rollback if $oldAutoCommit;
2101                     return "fatal: can't insert cust_tax_exempt_pkg: $error";
2102                   }
2103                 } # if $remaining_exemption > 0
2104
2105                 #++
2106                 $mon++;
2107                 #until ( $mon < 12 ) { $mon -= 12; $year++; }
2108                 until ( $mon < 13 ) { $mon -= 12; $year++; }
2109
2110               } #foreach $which_month
2111
2112             } #if $tax->exempt_amount
2113
2114             $taxable_charged = sprintf( "%.2f", $taxable_charged);
2115
2116             #$tax += $taxable_charged * $cust_main_county->tax / 100
2117             $tax{ $tax->taxname || 'Tax' } +=
2118               $taxable_charged * $tax->tax / 100
2119
2120           } #foreach my $tax ( @taxes )
2121
2122         } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
2123
2124       } #if $setup != 0 || $recur != 0
2125
2126     } #if $cust_pkg->modified
2127
2128   } #foreach my $cust_pkg
2129
2130   unless ( $cust_bill->cust_bill_pkg ) {
2131     $cust_bill->delete; #don't create an invoice w/o line items
2132     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2133     return '';
2134   }
2135
2136   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
2137
2138   foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
2139     my $tax = sprintf("%.2f", $tax{$taxname} );
2140     $charged = sprintf( "%.2f", $charged+$tax );
2141
2142     my $cust_bill_pkg = new FS::cust_bill_pkg ({
2143       'invnum'   => $invnum,
2144       'pkgnum'   => 0,
2145       'setup'    => $tax,
2146       'recur'    => 0,
2147       'sdate'    => '',
2148       'edate'    => '',
2149       'itemdesc' => $taxname,
2150     });
2151     $error = $cust_bill_pkg->insert;
2152     if ( $error ) {
2153       $dbh->rollback if $oldAutoCommit;
2154       return "can't create invoice line item for invoice #$invnum: $error";
2155     }
2156     $total_setup += $tax;
2157
2158   }
2159
2160   $cust_bill->charged( sprintf( "%.2f", $total_setup + $total_recur ) );
2161   $error = $cust_bill->replace;
2162   if ( $error ) {
2163     $dbh->rollback if $oldAutoCommit;
2164     return "can't update charged for invoice #$invnum: $error";
2165   }
2166
2167   foreach my $hook ( @precommit_hooks ) {
2168     eval {
2169       &{$hook}; #($self) ?
2170     };
2171     if ( $@ ) {
2172       $dbh->rollback if $oldAutoCommit;
2173       return "$@ running precommit hook $hook\n";
2174     }
2175   }
2176
2177   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2178   ''; #no error
2179 }
2180
2181 =item collect OPTIONS
2182
2183 (Attempt to) collect money for this customer's outstanding invoices (see
2184 L<FS::cust_bill>).  Usually used after the bill method.
2185
2186 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
2187 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
2188 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
2189
2190 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
2191 and the invoice events web interface.
2192
2193 If there is an error, returns the error, otherwise returns false.
2194
2195 Options are passed as name-value pairs.
2196
2197 Currently available options are:
2198
2199 invoice_time - Use this time when deciding when to print invoices and
2200 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>
2201 for conversion functions.
2202
2203 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
2204 events.
2205
2206 quiet - set true to surpress email card/ACH decline notices.
2207
2208 freq - "1d" for the traditional, daily events (the default), or "1m" for the
2209 new monthly events
2210
2211 payby - allows for one time override of normal customer billing method
2212
2213 =cut
2214
2215 sub collect {
2216   my( $self, %options ) = @_;
2217   my $invoice_time = $options{'invoice_time'} || time;
2218
2219   #put below somehow?
2220   local $SIG{HUP} = 'IGNORE';
2221   local $SIG{INT} = 'IGNORE';
2222   local $SIG{QUIT} = 'IGNORE';
2223   local $SIG{TERM} = 'IGNORE';
2224   local $SIG{TSTP} = 'IGNORE';
2225   local $SIG{PIPE} = 'IGNORE';
2226
2227   my $oldAutoCommit = $FS::UID::AutoCommit;
2228   local $FS::UID::AutoCommit = 0;
2229   my $dbh = dbh;
2230
2231   $self->select_for_update; #mutex
2232
2233   my $balance = $self->balance;
2234   warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2235     if $DEBUG;
2236   unless ( $balance > 0 ) { #redundant?????
2237     $dbh->rollback if $oldAutoCommit; #hmm
2238     return '';
2239   }
2240
2241   if ( exists($options{'retry_card'}) ) {
2242     carp 'retry_card option passed to collect is deprecated; use retry';
2243     $options{'retry'} ||= $options{'retry_card'};
2244   }
2245   if ( exists($options{'retry'}) && $options{'retry'} ) {
2246     my $error = $self->retry_realtime;
2247     if ( $error ) {
2248       $dbh->rollback if $oldAutoCommit;
2249       return $error;
2250     }
2251   }
2252
2253   my $extra_sql = '';
2254   if ( defined $options{'freq'} && $options{'freq'} eq '1m' ) {
2255     $extra_sql = " AND freq = '1m' ";
2256   } else {
2257     $extra_sql = " AND ( freq = '1d' OR freq IS NULL OR freq = '' ) ";
2258   }
2259
2260   foreach my $cust_bill ( $self->open_cust_bill ) {
2261
2262     # don't try to charge for the same invoice if it's already in a batch
2263     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
2264
2265     last if $self->balance <= 0;
2266
2267     warn "  invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n"
2268       if $DEBUG > 1;
2269
2270     foreach my $part_bill_event ( due_events ( $cust_bill,
2271                                                exists($options{'payby'})
2272                                                  ? $options{'payby'}
2273                                                  : $self->payby,
2274                                                $invoice_time,
2275                                                $extra_sql ) ) {
2276
2277       last if $cust_bill->owed <= 0  # don't run subsequent events if owed<=0
2278            || $self->balance   <= 0; # or if balance<=0
2279
2280       {
2281         local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2282         warn "  do_event " .  $cust_bill . " ". (%options) .  "\n"
2283           if $DEBUG > 1;
2284
2285         if (my $error = $part_bill_event->do_event($cust_bill, %options)) {
2286           # gah, even with transactions.
2287           $dbh->commit if $oldAutoCommit; #well.
2288           return $error;
2289         }
2290       }
2291
2292     }
2293
2294   }
2295
2296   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2297   '';
2298
2299 }
2300
2301 =item retry_realtime
2302
2303 Schedules realtime / batch  credit card / electronic check / LEC billing
2304 events for for retry.  Useful if card information has changed or manual
2305 retry is desired.  The 'collect' method must be called to actually retry
2306 the transaction.
2307
2308 Implementation details: For each of this customer's open invoices, changes
2309 the status of the first "done" (with statustext error) realtime processing
2310 event to "failed".
2311
2312 =cut
2313
2314 sub retry_realtime {
2315   my $self = shift;
2316
2317   local $SIG{HUP} = 'IGNORE';
2318   local $SIG{INT} = 'IGNORE';
2319   local $SIG{QUIT} = 'IGNORE';
2320   local $SIG{TERM} = 'IGNORE';
2321   local $SIG{TSTP} = 'IGNORE';
2322   local $SIG{PIPE} = 'IGNORE';
2323
2324   my $oldAutoCommit = $FS::UID::AutoCommit;
2325   local $FS::UID::AutoCommit = 0;
2326   my $dbh = dbh;
2327
2328   foreach my $cust_bill (
2329     grep { $_->cust_bill_event }
2330       $self->open_cust_bill
2331   ) {
2332     my @cust_bill_event =
2333       sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
2334         grep {
2335                #$_->part_bill_event->plan eq 'realtime-card'
2336                $_->part_bill_event->eventcode =~
2337                    /\$cust_bill\->(batch|realtime)_(card|ach|lec)/
2338                  && $_->status eq 'done'
2339                  && $_->statustext
2340              }
2341           $cust_bill->cust_bill_event;
2342     next unless @cust_bill_event;
2343     my $error = $cust_bill_event[0]->retry;
2344     if ( $error ) {
2345       $dbh->rollback if $oldAutoCommit;
2346       return "error scheduling invoice event for retry: $error";
2347     }
2348
2349   }
2350
2351   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2352   '';
2353
2354 }
2355
2356 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
2357
2358 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
2359 via a Business::OnlinePayment realtime gateway.  See
2360 L<http://420.am/business-onlinepayment> for supported gateways.
2361
2362 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2363
2364 Available options are: I<description>, I<invnum>, I<quiet>
2365
2366 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2367 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2368 if set, will override the value from the customer record.
2369
2370 I<description> is a free-text field passed to the gateway.  It defaults to
2371 "Internet services".
2372
2373 If an I<invnum> is specified, this payment (if successful) is applied to the
2374 specified invoice.  If you don't specify an I<invnum> you might want to
2375 call the B<apply_payments> method.
2376
2377 I<quiet> can be set true to surpress email decline notices.
2378
2379 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
2380
2381 =cut
2382
2383 sub realtime_bop {
2384   my( $self, $method, $amount, %options ) = @_;
2385   if ( $DEBUG ) {
2386     warn "$me realtime_bop: $method $amount\n";
2387     warn "  $_ => $options{$_}\n" foreach keys %options;
2388   }
2389
2390   $options{'description'} ||= 'Internet services';
2391
2392   eval "use Business::OnlinePayment";
2393   die $@ if $@;
2394
2395   my $payinfo = exists($options{'payinfo'})
2396                   ? $options{'payinfo'}
2397                   : $self->payinfo;
2398
2399   ###
2400   # select a gateway
2401   ###
2402
2403   my $taxclass = '';
2404   if ( $options{'invnum'} ) {
2405     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
2406     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
2407     my @taxclasses =
2408       map  { $_->part_pkg->taxclass }
2409       grep { $_ }
2410       map  { $_->cust_pkg }
2411       $cust_bill->cust_bill_pkg;
2412     unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
2413                                                            #different taxclasses
2414       $taxclass = $taxclasses[0];
2415     }
2416   }
2417
2418   #look for an agent gateway override first
2419   my $cardtype;
2420   if ( $method eq 'CC' ) {
2421     $cardtype = cardtype($payinfo);
2422   } elsif ( $method eq 'ECHECK' ) {
2423     $cardtype = 'ACH';
2424   } else {
2425     $cardtype = $method;
2426   }
2427
2428   my $override =
2429        qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2430                                            cardtype => $cardtype,
2431                                            taxclass => $taxclass,       } )
2432     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2433                                            cardtype => '',
2434                                            taxclass => $taxclass,       } )
2435     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2436                                            cardtype => $cardtype,
2437                                            taxclass => '',              } )
2438     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2439                                            cardtype => '',
2440                                            taxclass => '',              } );
2441
2442   my $payment_gateway = '';
2443   my( $processor, $login, $password, $action, @bop_options );
2444   if ( $override ) { #use a payment gateway override
2445
2446     $payment_gateway = $override->payment_gateway;
2447
2448     $processor   = $payment_gateway->gateway_module;
2449     $login       = $payment_gateway->gateway_username;
2450     $password    = $payment_gateway->gateway_password;
2451     $action      = $payment_gateway->gateway_action;
2452     @bop_options = $payment_gateway->options;
2453
2454   } else { #use the standard settings from the config
2455
2456     ( $processor, $login, $password, $action, @bop_options ) =
2457       $self->default_payment_gateway($method);
2458
2459   }
2460
2461   ###
2462   # massage data
2463   ###
2464
2465   my $address = exists($options{'address1'})
2466                     ? $options{'address1'}
2467                     : $self->address1;
2468   my $address2 = exists($options{'address2'})
2469                     ? $options{'address2'}
2470                     : $self->address2;
2471   $address .= ", ". $address2 if length($address2);
2472
2473   my $o_payname = exists($options{'payname'})
2474                     ? $options{'payname'}
2475                     : $self->payname;
2476   my($payname, $payfirst, $paylast);
2477   if ( $o_payname && $method ne 'ECHECK' ) {
2478     ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2479       or return "Illegal payname $payname";
2480     ($payfirst, $paylast) = ($1, $2);
2481   } else {
2482     $payfirst = $self->getfield('first');
2483     $paylast = $self->getfield('last');
2484     $payname =  "$payfirst $paylast";
2485   }
2486
2487   my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
2488   if ( $conf->exists('emailinvoiceauto')
2489        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
2490     push @invoicing_list, $self->all_emails;
2491   }
2492
2493   my $email = ($conf->exists('business-onlinepayment-email-override'))
2494               ? $conf->config('business-onlinepayment-email-override')
2495               : $invoicing_list[0];
2496
2497   my %content = ();
2498
2499   my $payip = exists($options{'payip'})
2500                 ? $options{'payip'}
2501                 : $self->payip;
2502   $content{customer_ip} = $payip
2503     if length($payip);
2504
2505   if ( $method eq 'CC' ) {
2506
2507     $content{card_number} = $payinfo;
2508     my $paydate = exists($options{'paydate'})
2509                     ? $options{'paydate'}
2510                     : $self->paydate;
2511     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2512     $content{expiration} = "$2/$1";
2513
2514     my $paycvv = exists($options{'paycvv'})
2515                    ? $options{'paycvv'}
2516                    : $self->paycvv;
2517     $content{cvv2} = $self->paycvv
2518       if length($paycvv);
2519
2520     my $paystart_month = exists($options{'paystart_month'})
2521                            ? $options{'paystart_month'}
2522                            : $self->paystart_month;
2523
2524     my $paystart_year  = exists($options{'paystart_year'})
2525                            ? $options{'paystart_year'}
2526                            : $self->paystart_year;
2527
2528     $content{card_start} = "$paystart_month/$paystart_year"
2529       if $paystart_month && $paystart_year;
2530
2531     my $payissue       = exists($options{'payissue'})
2532                            ? $options{'payissue'}
2533                            : $self->payissue;
2534     $content{issue_number} = $payissue if $payissue;
2535
2536     $content{recurring_billing} = 'YES'
2537       if qsearch('cust_pay', { 'custnum' => $self->custnum,
2538                                'payby'   => 'CARD',
2539                                'payinfo' => $payinfo,
2540                              } );
2541
2542   } elsif ( $method eq 'ECHECK' ) {
2543     ( $content{account_number}, $content{routing_code} ) =
2544       split('@', $payinfo);
2545     $content{bank_name} = $o_payname;
2546     $content{account_type} = 'CHECKING';
2547     $content{account_name} = $payname;
2548     $content{customer_org} = $self->company ? 'B' : 'I';
2549     $content{customer_ssn} = exists($options{'ss'})
2550                                ? $options{'ss'}
2551                                : $self->ss;
2552   } elsif ( $method eq 'LEC' ) {
2553     $content{phone} = $payinfo;
2554   }
2555
2556   ###
2557   # run transaction(s)
2558   ###
2559
2560   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
2561
2562   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
2563   $transaction->content(
2564     'type'           => $method,
2565     'login'          => $login,
2566     'password'       => $password,
2567     'action'         => $action1,
2568     'description'    => $options{'description'},
2569     'amount'         => $amount,
2570     'invoice_number' => $options{'invnum'},
2571     'customer_id'    => $self->custnum,
2572     'last_name'      => $paylast,
2573     'first_name'     => $payfirst,
2574     'name'           => $payname,
2575     'address'        => $address,
2576     'city'           => ( exists($options{'city'})
2577                             ? $options{'city'}
2578                             : $self->city          ),
2579     'state'          => ( exists($options{'state'})
2580                             ? $options{'state'}
2581                             : $self->state          ),
2582     'zip'            => ( exists($options{'zip'})
2583                             ? $options{'zip'}
2584                             : $self->zip          ),
2585     'country'        => ( exists($options{'country'})
2586                             ? $options{'country'}
2587                             : $self->country          ),
2588     'referer'        => 'http://cleanwhisker.420.am/',
2589     'email'          => $email,
2590     'phone'          => $self->daytime || $self->night,
2591     %content, #after
2592   );
2593   $transaction->submit();
2594
2595   if ( $transaction->is_success() && $action2 ) {
2596     my $auth = $transaction->authorization;
2597     my $ordernum = $transaction->can('order_number')
2598                    ? $transaction->order_number
2599                    : '';
2600
2601     my $capture =
2602       new Business::OnlinePayment( $processor, @bop_options );
2603
2604     my %capture = (
2605       %content,
2606       type           => $method,
2607       action         => $action2,
2608       login          => $login,
2609       password       => $password,
2610       order_number   => $ordernum,
2611       amount         => $amount,
2612       authorization  => $auth,
2613       description    => $options{'description'},
2614     );
2615
2616     foreach my $field (qw( authorization_source_code returned_ACI                                          transaction_identifier validation_code
2617                            transaction_sequence_num local_transaction_date
2618                            local_transaction_time AVS_result_code          )) {
2619       $capture{$field} = $transaction->$field() if $transaction->can($field);
2620     }
2621
2622     $capture->content( %capture );
2623
2624     $capture->submit();
2625
2626     unless ( $capture->is_success ) {
2627       my $e = "Authorization successful but capture failed, custnum #".
2628               $self->custnum. ': '.  $capture->result_code.
2629               ": ". $capture->error_message;
2630       warn $e;
2631       return $e;
2632     }
2633
2634   }
2635
2636   ###
2637   # remove paycvv after initial transaction
2638   ###
2639
2640   #false laziness w/misc/process/payment.cgi - check both to make sure working
2641   # correctly
2642   if ( defined $self->dbdef_table->column('paycvv')
2643        && length($self->paycvv)
2644        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2645   ) {
2646     my $error = $self->remove_cvv;
2647     if ( $error ) {
2648       warn "WARNING: error removing cvv: $error\n";
2649     }
2650   }
2651
2652   ###
2653   # result handling
2654   ###
2655
2656   if ( $transaction->is_success() ) {
2657
2658     my %method2payby = (
2659       'CC'     => 'CARD',
2660       'ECHECK' => 'CHEK',
2661       'LEC'    => 'LECB',
2662     );
2663
2664     my $paybatch = '';
2665     if ( $payment_gateway ) { # agent override
2666       $paybatch = $payment_gateway->gatewaynum. '-';
2667     }
2668
2669     $paybatch .= "$processor:". $transaction->authorization;
2670
2671     $paybatch .= ':'. $transaction->order_number
2672       if $transaction->can('order_number')
2673       && length($transaction->order_number);
2674
2675     my $cust_pay = new FS::cust_pay ( {
2676        'custnum'  => $self->custnum,
2677        'invnum'   => $options{'invnum'},
2678        'paid'     => $amount,
2679        '_date'     => '',
2680        'payby'    => $method2payby{$method},
2681        'payinfo'  => $payinfo,
2682        'paybatch' => $paybatch,
2683     } );
2684     my $error = $cust_pay->insert;
2685     if ( $error ) {
2686       $cust_pay->invnum(''); #try again with no specific invnum
2687       my $error2 = $cust_pay->insert;
2688       if ( $error2 ) {
2689         # gah, even with transactions.
2690         my $e = 'WARNING: Card/ACH debited but database not updated - '.
2691                 "error inserting payment ($processor): $error2".
2692                 " (previously tried insert with invnum #$options{'invnum'}" .
2693                 ": $error )";
2694         warn $e;
2695         return $e;
2696       }
2697     }
2698     return ''; #no error
2699
2700   } else {
2701
2702     my $perror = "$processor error: ". $transaction->error_message;
2703
2704     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2705          && $conf->exists('emaildecline')
2706          && grep { $_ ne 'POST' } $self->invoicing_list
2707          && ! grep { $transaction->error_message =~ /$_/ }
2708                    $conf->config('emaildecline-exclude')
2709     ) {
2710       my @templ = $conf->config('declinetemplate');
2711       my $template = new Text::Template (
2712         TYPE   => 'ARRAY',
2713         SOURCE => [ map "$_\n", @templ ],
2714       ) or return "($perror) can't create template: $Text::Template::ERROR";
2715       $template->compile()
2716         or return "($perror) can't compile template: $Text::Template::ERROR";
2717
2718       my $templ_hash = { error => $transaction->error_message };
2719
2720       my $error = send_email(
2721         'from'    => $conf->config('invoice_from'),
2722         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2723         'subject' => 'Your payment could not be processed',
2724         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
2725       );
2726
2727       $perror .= " (also received error sending decline notification: $error)"
2728         if $error;
2729
2730     }
2731
2732     return $perror;
2733   }
2734
2735 }
2736
2737 =item default_payment_gateway
2738
2739 =cut
2740
2741 sub default_payment_gateway {
2742   my( $self, $method ) = @_;
2743
2744   die "Real-time processing not enabled\n"
2745     unless $conf->exists('business-onlinepayment');
2746
2747   #load up config
2748   my $bop_config = 'business-onlinepayment';
2749   $bop_config .= '-ach'
2750     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2751   my ( $processor, $login, $password, $action, @bop_options ) =
2752     $conf->config($bop_config);
2753   $action ||= 'normal authorization';
2754   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2755   die "No real-time processor is enabled - ".
2756       "did you set the business-onlinepayment configuration value?\n"
2757     unless $processor;
2758
2759   ( $processor, $login, $password, $action, @bop_options )
2760 }
2761
2762 =item remove_cvv
2763
2764 Removes the I<paycvv> field from the database directly.
2765
2766 If there is an error, returns the error, otherwise returns false.
2767
2768 =cut
2769
2770 sub remove_cvv {
2771   my $self = shift;
2772   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2773     or return dbh->errstr;
2774   $sth->execute($self->custnum)
2775     or return $sth->errstr;
2776   $self->paycvv('');
2777   '';
2778 }
2779
2780 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2781
2782 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2783 via a Business::OnlinePayment realtime gateway.  See
2784 L<http://420.am/business-onlinepayment> for supported gateways.
2785
2786 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2787
2788 Available options are: I<amount>, I<reason>, I<paynum>
2789
2790 Most gateways require a reference to an original payment transaction to refund,
2791 so you probably need to specify a I<paynum>.
2792
2793 I<amount> defaults to the original amount of the payment if not specified.
2794
2795 I<reason> specifies a reason for the refund.
2796
2797 Implementation note: If I<amount> is unspecified or equal to the amount of the
2798 orignal payment, first an attempt is made to "void" the transaction via
2799 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2800 the normal attempt is made to "refund" ("credit") the transaction via the
2801 gateway is attempted.
2802
2803 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2804 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2805 #if set, will override the value from the customer record.
2806
2807 #If an I<invnum> is specified, this payment (if successful) is applied to the
2808 #specified invoice.  If you don't specify an I<invnum> you might want to
2809 #call the B<apply_payments> method.
2810
2811 =cut
2812
2813 #some false laziness w/realtime_bop, not enough to make it worth merging
2814 #but some useful small subs should be pulled out
2815 sub realtime_refund_bop {
2816   my( $self, $method, %options ) = @_;
2817   if ( $DEBUG ) {
2818     warn "$me realtime_refund_bop: $method refund\n";
2819     warn "  $_ => $options{$_}\n" foreach keys %options;
2820   }
2821
2822   eval "use Business::OnlinePayment";
2823   die $@ if $@;
2824
2825   ###
2826   # look up the original payment and optionally a gateway for that payment
2827   ###
2828
2829   my $cust_pay = '';
2830   my $amount = $options{'amount'};
2831
2832   my( $processor, $login, $password, @bop_options ) ;
2833   my( $auth, $order_number ) = ( '', '', '' );
2834
2835   if ( $options{'paynum'} ) {
2836
2837     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
2838     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2839       or return "Unknown paynum $options{'paynum'}";
2840     $amount ||= $cust_pay->paid;
2841
2842     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/
2843       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2844                 $cust_pay->paybatch;
2845     my $gatewaynum = '';
2846     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
2847
2848     if ( $gatewaynum ) { #gateway for the payment to be refunded
2849
2850       my $payment_gateway =
2851         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
2852       die "payment gateway $gatewaynum not found"
2853         unless $payment_gateway;
2854
2855       $processor   = $payment_gateway->gateway_module;
2856       $login       = $payment_gateway->gateway_username;
2857       $password    = $payment_gateway->gateway_password;
2858       @bop_options = $payment_gateway->options;
2859
2860     } else { #try the default gateway
2861
2862       my( $conf_processor, $unused_action );
2863       ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
2864         $self->default_payment_gateway($method);
2865
2866       return "processor of payment $options{'paynum'} $processor does not".
2867              " match default processor $conf_processor"
2868         unless $processor eq $conf_processor;
2869
2870     }
2871
2872
2873   } else { # didn't specify a paynum, so look for agent gateway overrides
2874            # like a normal transaction
2875
2876     my $cardtype;
2877     if ( $method eq 'CC' ) {
2878       $cardtype = cardtype($self->payinfo);
2879     } elsif ( $method eq 'ECHECK' ) {
2880       $cardtype = 'ACH';
2881     } else {
2882       $cardtype = $method;
2883     }
2884     my $override =
2885            qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2886                                                cardtype => $cardtype,
2887                                                taxclass => '',              } )
2888         || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2889                                                cardtype => '',
2890                                                taxclass => '',              } );
2891
2892     if ( $override ) { #use a payment gateway override
2893
2894       my $payment_gateway = $override->payment_gateway;
2895
2896       $processor   = $payment_gateway->gateway_module;
2897       $login       = $payment_gateway->gateway_username;
2898       $password    = $payment_gateway->gateway_password;
2899       #$action      = $payment_gateway->gateway_action;
2900       @bop_options = $payment_gateway->options;
2901
2902     } else { #use the standard settings from the config
2903
2904       my $unused_action;
2905       ( $processor, $login, $password, $unused_action, @bop_options ) =
2906         $self->default_payment_gateway($method);
2907
2908     }
2909
2910   }
2911   return "neither amount nor paynum specified" unless $amount;
2912
2913   my %content = (
2914     'type'           => $method,
2915     'login'          => $login,
2916     'password'       => $password,
2917     'order_number'   => $order_number,
2918     'amount'         => $amount,
2919     'referer'        => 'http://cleanwhisker.420.am/',
2920   );
2921   $content{authorization} = $auth
2922     if length($auth); #echeck/ACH transactions have an order # but no auth
2923                       #(at least with authorize.net)
2924
2925   #first try void if applicable
2926   if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2927     warn "  attempting void\n" if $DEBUG > 1;
2928     my $void = new Business::OnlinePayment( $processor, @bop_options );
2929     $void->content( 'action' => 'void', %content );
2930     $void->submit();
2931     if ( $void->is_success ) {
2932       my $error = $cust_pay->void($options{'reason'});
2933       if ( $error ) {
2934         # gah, even with transactions.
2935         my $e = 'WARNING: Card/ACH voided but database not updated - '.
2936                 "error voiding payment: $error";
2937         warn $e;
2938         return $e;
2939       }
2940       warn "  void successful\n" if $DEBUG > 1;
2941       return '';
2942     }
2943   }
2944
2945   warn "  void unsuccessful, trying refund\n"
2946     if $DEBUG > 1;
2947
2948   #massage data
2949   my $address = $self->address1;
2950   $address .= ", ". $self->address2 if $self->address2;
2951
2952   my($payname, $payfirst, $paylast);
2953   if ( $self->payname && $method ne 'ECHECK' ) {
2954     $payname = $self->payname;
2955     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2956       or return "Illegal payname $payname";
2957     ($payfirst, $paylast) = ($1, $2);
2958   } else {
2959     $payfirst = $self->getfield('first');
2960     $paylast = $self->getfield('last');
2961     $payname =  "$payfirst $paylast";
2962   }
2963
2964   my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
2965   if ( $conf->exists('emailinvoiceauto')
2966        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
2967     push @invoicing_list, $self->all_emails;
2968   }
2969
2970   my $email = ($conf->exists('business-onlinepayment-email-override'))
2971               ? $conf->config('business-onlinepayment-email-override')
2972               : $invoicing_list[0];
2973
2974   my $payip = exists($options{'payip'})
2975                 ? $options{'payip'}
2976                 : $self->payip;
2977   $content{customer_ip} = $payip
2978     if length($payip);
2979
2980   my $payinfo = '';
2981   if ( $method eq 'CC' ) {
2982
2983     if ( $cust_pay ) {
2984       $content{card_number} = $payinfo = $cust_pay->payinfo;
2985       #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2986       #$content{expiration} = "$2/$1";
2987     } else {
2988       $content{card_number} = $payinfo = $self->payinfo;
2989       $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2990       $content{expiration} = "$2/$1";
2991     }
2992
2993   } elsif ( $method eq 'ECHECK' ) {
2994     ( $content{account_number}, $content{routing_code} ) =
2995       split('@', $payinfo = $self->payinfo);
2996     $content{bank_name} = $self->payname;
2997     $content{account_type} = 'CHECKING';
2998     $content{account_name} = $payname;
2999     $content{customer_org} = $self->company ? 'B' : 'I';
3000     $content{customer_ssn} = $self->ss;
3001   } elsif ( $method eq 'LEC' ) {
3002     $content{phone} = $payinfo = $self->payinfo;
3003   }
3004
3005   #then try refund
3006   my $refund = new Business::OnlinePayment( $processor, @bop_options );
3007   my %sub_content = $refund->content(
3008     'action'         => 'credit',
3009     'customer_id'    => $self->custnum,
3010     'last_name'      => $paylast,
3011     'first_name'     => $payfirst,
3012     'name'           => $payname,
3013     'address'        => $address,
3014     'city'           => $self->city,
3015     'state'          => $self->state,
3016     'zip'            => $self->zip,
3017     'country'        => $self->country,
3018     'email'          => $email,
3019     'phone'          => $self->daytime || $self->night,
3020     %content, #after
3021   );
3022   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
3023     if $DEBUG > 1;
3024   $refund->submit();
3025
3026   return "$processor error: ". $refund->error_message
3027     unless $refund->is_success();
3028
3029   my %method2payby = (
3030     'CC'     => 'CARD',
3031     'ECHECK' => 'CHEK',
3032     'LEC'    => 'LECB',
3033   );
3034
3035   my $paybatch = "$processor:". $refund->authorization;
3036   $paybatch .= ':'. $refund->order_number
3037     if $refund->can('order_number') && $refund->order_number;
3038
3039   while ( $cust_pay && $cust_pay->unappled < $amount ) {
3040     my @cust_bill_pay = $cust_pay->cust_bill_pay;
3041     last unless @cust_bill_pay;
3042     my $cust_bill_pay = pop @cust_bill_pay;
3043     my $error = $cust_bill_pay->delete;
3044     last if $error;
3045   }
3046
3047   my $cust_refund = new FS::cust_refund ( {
3048     'custnum'  => $self->custnum,
3049     'paynum'   => $options{'paynum'},
3050     'refund'   => $amount,
3051     '_date'    => '',
3052     'payby'    => $method2payby{$method},
3053     'payinfo'  => $payinfo,
3054     'paybatch' => $paybatch,
3055     'reason'   => $options{'reason'} || 'card or ACH refund',
3056   } );
3057   my $error = $cust_refund->insert;
3058   if ( $error ) {
3059     $cust_refund->paynum(''); #try again with no specific paynum
3060     my $error2 = $cust_refund->insert;
3061     if ( $error2 ) {
3062       # gah, even with transactions.
3063       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
3064               "error inserting refund ($processor): $error2".
3065               " (previously tried insert with paynum #$options{'paynum'}" .
3066               ": $error )";
3067       warn $e;
3068       return $e;
3069     }
3070   }
3071
3072   ''; #no error
3073
3074 }
3075
3076 =item total_owed
3077
3078 Returns the total owed for this customer on all invoices
3079 (see L<FS::cust_bill/owed>).
3080
3081 =cut
3082
3083 sub total_owed {
3084   my $self = shift;
3085   $self->total_owed_date(2145859200); #12/31/2037
3086 }
3087
3088 =item total_owed_date TIME
3089
3090 Returns the total owed for this customer on all invoices with date earlier than
3091 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
3092 see L<Time::Local> and L<Date::Parse> for conversion functions.
3093
3094 =cut
3095
3096 sub total_owed_date {
3097   my $self = shift;
3098   my $time = shift;
3099   my $total_bill = 0;
3100   foreach my $cust_bill (
3101     grep { $_->_date <= $time }
3102       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3103   ) {
3104     $total_bill += $cust_bill->owed;
3105   }
3106   sprintf( "%.2f", $total_bill );
3107 }
3108
3109 =item apply_credits OPTION => VALUE ...
3110
3111 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
3112 to outstanding invoice balances in chronological order (or reverse
3113 chronological order if the I<order> option is set to B<newest>) and returns the
3114 value of any remaining unapplied credits available for refund (see
3115 L<FS::cust_refund>).
3116
3117 =cut
3118
3119 sub apply_credits {
3120   my $self = shift;
3121   my %opt = @_;
3122
3123   return 0 unless $self->total_credited;
3124
3125   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
3126       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
3127
3128   my @invoices = $self->open_cust_bill;
3129   @invoices = sort { $b->_date <=> $a->_date } @invoices
3130     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
3131
3132   my $credit;
3133   foreach my $cust_bill ( @invoices ) {
3134     my $amount;
3135
3136     if ( !defined($credit) || $credit->credited == 0) {
3137       $credit = pop @credits or last;
3138     }
3139
3140     if ($cust_bill->owed >= $credit->credited) {
3141       $amount=$credit->credited;
3142     }else{
3143       $amount=$cust_bill->owed;
3144     }
3145
3146     my $cust_credit_bill = new FS::cust_credit_bill ( {
3147       'crednum' => $credit->crednum,
3148       'invnum'  => $cust_bill->invnum,
3149       'amount'  => $amount,
3150     } );
3151     my $error = $cust_credit_bill->insert;
3152     die $error if $error;
3153
3154     redo if ($cust_bill->owed > 0);
3155
3156   }
3157
3158   return $self->total_credited;
3159 }
3160
3161 =item apply_payments
3162
3163 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
3164 to outstanding invoice balances in chronological order.
3165
3166  #and returns the value of any remaining unapplied payments.
3167
3168 =cut
3169
3170 sub apply_payments {
3171   my $self = shift;
3172
3173   #return 0 unless
3174
3175   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
3176       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
3177
3178   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
3179       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
3180
3181   my $payment;
3182
3183   foreach my $cust_bill ( @invoices ) {
3184     my $amount;
3185
3186     if ( !defined($payment) || $payment->unapplied == 0 ) {
3187       $payment = pop @payments or last;
3188     }
3189
3190     if ( $cust_bill->owed >= $payment->unapplied ) {
3191       $amount = $payment->unapplied;
3192     } else {
3193       $amount = $cust_bill->owed;
3194     }
3195
3196     my $cust_bill_pay = new FS::cust_bill_pay ( {
3197       'paynum' => $payment->paynum,
3198       'invnum' => $cust_bill->invnum,
3199       'amount' => $amount,
3200     } );
3201     my $error = $cust_bill_pay->insert;
3202     die $error if $error;
3203
3204     redo if ( $cust_bill->owed > 0);
3205
3206   }
3207
3208   return $self->total_unapplied_payments;
3209 }
3210
3211 =item total_credited
3212
3213 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3214 customer.  See L<FS::cust_credit/credited>.
3215
3216 =cut
3217
3218 sub total_credited {
3219   my $self = shift;
3220   my $total_credit = 0;
3221   foreach my $cust_credit ( qsearch('cust_credit', {
3222     'custnum' => $self->custnum,
3223   } ) ) {
3224     $total_credit += $cust_credit->credited;
3225   }
3226   sprintf( "%.2f", $total_credit );
3227 }
3228
3229 =item total_unapplied_payments
3230
3231 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3232 See L<FS::cust_pay/unapplied>.
3233
3234 =cut
3235
3236 sub total_unapplied_payments {
3237   my $self = shift;
3238   my $total_unapplied = 0;
3239   foreach my $cust_pay ( qsearch('cust_pay', {
3240     'custnum' => $self->custnum,
3241   } ) ) {
3242     $total_unapplied += $cust_pay->unapplied;
3243   }
3244   sprintf( "%.2f", $total_unapplied );
3245 }
3246
3247 =item balance
3248
3249 Returns the balance for this customer (total_owed minus total_credited
3250 minus total_unapplied_payments).
3251
3252 =cut
3253
3254 sub balance {
3255   my $self = shift;
3256   sprintf( "%.2f",
3257     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
3258   );
3259 }
3260
3261 =item balance_date TIME
3262
3263 Returns the balance for this customer, only considering invoices with date
3264 earlier than TIME (total_owed_date minus total_credited minus
3265 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
3266 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
3267 functions.
3268
3269 =cut
3270
3271 sub balance_date {
3272   my $self = shift;
3273   my $time = shift;
3274   sprintf( "%.2f",
3275     $self->total_owed_date($time)
3276       - $self->total_credited
3277       - $self->total_unapplied_payments
3278   );
3279 }
3280
3281 =item in_transit_payments
3282
3283 Returns the total of requests for payments for this customer pending in
3284 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
3285
3286 =cut
3287
3288 sub in_transit_payments {
3289   my $self = shift;
3290   my $in_transit_payments = 0;
3291   foreach my $pay_batch ( qsearch('pay_batch', {
3292     'status' => 'I',
3293   } ) ) {
3294     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
3295       'batchnum' => $pay_batch->batchnum,
3296       'custnum' => $self->custnum,
3297     } ) ) {
3298       $in_transit_payments += $cust_pay_batch->amount;
3299     }
3300   }
3301   sprintf( "%.2f", $in_transit_payments );
3302 }
3303
3304 =item paydate_monthyear
3305
3306 Returns a two-element list consisting of the month and year of this customer's
3307 paydate (credit card expiration date for CARD customers)
3308
3309 =cut
3310
3311 sub paydate_monthyear {
3312   my $self = shift;
3313   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3314     ( $2, $1 );
3315   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3316     ( $1, $3 );
3317   } else {
3318     ('', '');
3319   }
3320 }
3321
3322 =item payinfo_masked
3323
3324 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.
3325
3326 Credit Cards - Mask all but the last four characters.
3327 Checks - Mask all but last 2 of account number and bank routing number.
3328 Others - Do nothing, return the unmasked string.
3329
3330 =cut
3331
3332 sub payinfo_masked {
3333   my $self = shift;
3334   return $self->paymask;
3335 }
3336
3337 =item invoicing_list [ ARRAYREF ]
3338
3339 If an arguement is given, sets these email addresses as invoice recipients
3340 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
3341 (except as warnings), so use check_invoicing_list first.
3342
3343 Returns a list of email addresses (with svcnum entries expanded).
3344
3345 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
3346 check it without disturbing anything by passing nothing.
3347
3348 This interface may change in the future.
3349
3350 =cut
3351
3352 sub invoicing_list {
3353   my( $self, $arrayref ) = @_;
3354
3355   if ( $arrayref ) {
3356     my @cust_main_invoice;
3357     if ( $self->custnum ) {
3358       @cust_main_invoice =
3359         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3360     } else {
3361       @cust_main_invoice = ();
3362     }
3363     foreach my $cust_main_invoice ( @cust_main_invoice ) {
3364       #warn $cust_main_invoice->destnum;
3365       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3366         #warn $cust_main_invoice->destnum;
3367         my $error = $cust_main_invoice->delete;
3368         warn $error if $error;
3369       }
3370     }
3371     if ( $self->custnum ) {
3372       @cust_main_invoice =
3373         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3374     } else {
3375       @cust_main_invoice = ();
3376     }
3377     my %seen = map { $_->address => 1 } @cust_main_invoice;
3378     foreach my $address ( @{$arrayref} ) {
3379       next if exists $seen{$address} && $seen{$address};
3380       $seen{$address} = 1;
3381       my $cust_main_invoice = new FS::cust_main_invoice ( {
3382         'custnum' => $self->custnum,
3383         'dest'    => $address,
3384       } );
3385       my $error = $cust_main_invoice->insert;
3386       warn $error if $error;
3387     }
3388   }
3389
3390   if ( $self->custnum ) {
3391     map { $_->address }
3392       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3393   } else {
3394     ();
3395   }
3396
3397 }
3398
3399 =item check_invoicing_list ARRAYREF
3400
3401 Checks these arguements as valid input for the invoicing_list method.  If there
3402 is an error, returns the error, otherwise returns false.
3403
3404 =cut
3405
3406 sub check_invoicing_list {
3407   my( $self, $arrayref ) = @_;
3408   foreach my $address ( @{$arrayref} ) {
3409
3410     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3411       return 'Can\'t add FAX invoice destination with a blank FAX number.';
3412     }
3413
3414     my $cust_main_invoice = new FS::cust_main_invoice ( {
3415       'custnum' => $self->custnum,
3416       'dest'    => $address,
3417     } );
3418     my $error = $self->custnum
3419                 ? $cust_main_invoice->check
3420                 : $cust_main_invoice->checkdest
3421     ;
3422     return $error if $error;
3423   }
3424   '';
3425 }
3426
3427 =item set_default_invoicing_list
3428
3429 Sets the invoicing list to all accounts associated with this customer,
3430 overwriting any previous invoicing list.
3431
3432 =cut
3433
3434 sub set_default_invoicing_list {
3435   my $self = shift;
3436   $self->invoicing_list($self->all_emails);
3437 }
3438
3439 =item all_emails
3440
3441 Returns the email addresses of all accounts provisioned for this customer.
3442
3443 =cut
3444
3445 sub all_emails {
3446   my $self = shift;
3447   my %list;
3448   foreach my $cust_pkg ( $self->all_pkgs ) {
3449     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3450     my @svc_acct =
3451       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3452         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3453           @cust_svc;
3454     $list{$_}=1 foreach map { $_->email } @svc_acct;
3455   }
3456   keys %list;
3457 }
3458
3459 =item invoicing_list_addpost
3460
3461 Adds postal invoicing to this customer.  If this customer is already configured
3462 to receive postal invoices, does nothing.
3463
3464 =cut
3465
3466 sub invoicing_list_addpost {
3467   my $self = shift;
3468   return if grep { $_ eq 'POST' } $self->invoicing_list;
3469   my @invoicing_list = $self->invoicing_list;
3470   push @invoicing_list, 'POST';
3471   $self->invoicing_list(\@invoicing_list);
3472 }
3473
3474 =item invoicing_list_emailonly
3475
3476 Returns the list of email invoice recipients (invoicing_list without non-email
3477 destinations such as POST and FAX).
3478
3479 =cut
3480
3481 sub invoicing_list_emailonly {
3482   my $self = shift;
3483   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3484 }
3485
3486 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3487
3488 Returns an array of customers referred by this customer (referral_custnum set
3489 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3490 customers referred by customers referred by this customer and so on, inclusive.
3491 The default behavior is DEPTH 1 (no recursion).
3492
3493 =cut
3494
3495 sub referral_cust_main {
3496   my $self = shift;
3497   my $depth = @_ ? shift : 1;
3498   my $exclude = @_ ? shift : {};
3499
3500   my @cust_main =
3501     map { $exclude->{$_->custnum}++; $_; }
3502       grep { ! $exclude->{ $_->custnum } }
3503         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3504
3505   if ( $depth > 1 ) {
3506     push @cust_main,
3507       map { $_->referral_cust_main($depth-1, $exclude) }
3508         @cust_main;
3509   }
3510
3511   @cust_main;
3512 }
3513
3514 =item referral_cust_main_ncancelled
3515
3516 Same as referral_cust_main, except only returns customers with uncancelled
3517 packages.
3518
3519 =cut
3520
3521 sub referral_cust_main_ncancelled {
3522   my $self = shift;
3523   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3524 }
3525
3526 =item referral_cust_pkg [ DEPTH ]
3527
3528 Like referral_cust_main, except returns a flat list of all unsuspended (and
3529 uncancelled) packages for each customer.  The number of items in this list may
3530 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3531
3532 =cut
3533
3534 sub referral_cust_pkg {
3535   my $self = shift;
3536   my $depth = @_ ? shift : 1;
3537
3538   map { $_->unsuspended_pkgs }
3539     grep { $_->unsuspended_pkgs }
3540       $self->referral_cust_main($depth);
3541 }
3542
3543 =item referring_cust_main
3544
3545 Returns the single cust_main record for the customer who referred this customer
3546 (referral_custnum), or false.
3547
3548 =cut
3549
3550 sub referring_cust_main {
3551   my $self = shift;
3552   return '' unless $self->referral_custnum;
3553   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3554 }
3555
3556 =item credit AMOUNT, REASON
3557
3558 Applies a credit to this customer.  If there is an error, returns the error,
3559 otherwise returns false.
3560
3561 =cut
3562
3563 sub credit {
3564   my( $self, $amount, $reason ) = @_;
3565   my $cust_credit = new FS::cust_credit {
3566     'custnum' => $self->custnum,
3567     'amount'  => $amount,
3568     'reason'  => $reason,
3569   };
3570   $cust_credit->insert;
3571 }
3572
3573 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3574
3575 Creates a one-time charge for this customer.  If there is an error, returns
3576 the error, otherwise returns false.
3577
3578 =cut
3579
3580 sub charge {
3581   my ( $self, $amount ) = ( shift, shift );
3582   my $pkg      = @_ ? shift : 'One-time charge';
3583   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
3584   my $taxclass = @_ ? shift : '';
3585
3586   local $SIG{HUP} = 'IGNORE';
3587   local $SIG{INT} = 'IGNORE';
3588   local $SIG{QUIT} = 'IGNORE';
3589   local $SIG{TERM} = 'IGNORE';
3590   local $SIG{TSTP} = 'IGNORE';
3591   local $SIG{PIPE} = 'IGNORE';
3592
3593   my $oldAutoCommit = $FS::UID::AutoCommit;
3594   local $FS::UID::AutoCommit = 0;
3595   my $dbh = dbh;
3596
3597   my $part_pkg = new FS::part_pkg ( {
3598     'pkg'      => $pkg,
3599     'comment'  => $comment,
3600     #'setup'    => $amount,
3601     #'recur'    => '0',
3602     'plan'     => 'flat',
3603     'plandata' => "setup_fee=$amount",
3604     'freq'     => 0,
3605     'disabled' => 'Y',
3606     'taxclass' => $taxclass,
3607   } );
3608
3609   my $error = $part_pkg->insert;
3610   if ( $error ) {
3611     $dbh->rollback if $oldAutoCommit;
3612     return $error;
3613   }
3614
3615   my $pkgpart = $part_pkg->pkgpart;
3616   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3617   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3618     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3619     $error = $type_pkgs->insert;
3620     if ( $error ) {
3621       $dbh->rollback if $oldAutoCommit;
3622       return $error;
3623     }
3624   }
3625
3626   my $cust_pkg = new FS::cust_pkg ( {
3627     'custnum' => $self->custnum,
3628     'pkgpart' => $pkgpart,
3629   } );
3630
3631   $error = $cust_pkg->insert;
3632   if ( $error ) {
3633     $dbh->rollback if $oldAutoCommit;
3634     return $error;
3635   }
3636
3637   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3638   '';
3639
3640 }
3641
3642 =item cust_bill
3643
3644 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3645
3646 =cut
3647
3648 sub cust_bill {
3649   my $self = shift;
3650   sort { $a->_date <=> $b->_date }
3651     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3652 }
3653
3654 =item open_cust_bill
3655
3656 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3657 customer.
3658
3659 =cut
3660
3661 sub open_cust_bill {
3662   my $self = shift;
3663   grep { $_->owed > 0 } $self->cust_bill;
3664 }
3665
3666 =item cust_credit
3667
3668 Returns all the credits (see L<FS::cust_credit>) for this customer.
3669
3670 =cut
3671
3672 sub cust_credit {
3673   my $self = shift;
3674   sort { $a->_date <=> $b->_date }
3675     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3676 }
3677
3678 =item cust_pay
3679
3680 Returns all the payments (see L<FS::cust_pay>) for this customer.
3681
3682 =cut
3683
3684 sub cust_pay {
3685   my $self = shift;
3686   sort { $a->_date <=> $b->_date }
3687     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3688 }
3689
3690 =item cust_pay_void
3691
3692 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3693
3694 =cut
3695
3696 sub cust_pay_void {
3697   my $self = shift;
3698   sort { $a->_date <=> $b->_date }
3699     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3700 }
3701
3702
3703 =item cust_refund
3704
3705 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3706
3707 =cut
3708
3709 sub cust_refund {
3710   my $self = shift;
3711   sort { $a->_date <=> $b->_date }
3712     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3713 }
3714
3715 =item select_for_update
3716
3717 Selects this record with the SQL "FOR UPDATE" command.  This can be useful as
3718 a mutex.
3719
3720 =cut
3721
3722 sub select_for_update {
3723   my $self = shift;
3724   qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
3725 }
3726
3727 =item name
3728
3729 Returns a name string for this customer, either "Company (Last, First)" or
3730 "Last, First".
3731
3732 =cut
3733
3734 sub name {
3735   my $self = shift;
3736   my $name = $self->contact;
3737   $name = $self->company. " ($name)" if $self->company;
3738   $name;
3739 }
3740
3741 =item ship_name
3742
3743 Returns a name string for this (service/shipping) contact, either
3744 "Company (Last, First)" or "Last, First".
3745
3746 =cut
3747
3748 sub ship_name {
3749   my $self = shift;
3750   if ( $self->get('ship_last') ) {
3751     my $name = $self->ship_contact;
3752     $name = $self->ship_company. " ($name)" if $self->ship_company;
3753     $name;
3754   } else {
3755     $self->name;
3756   }
3757 }
3758
3759 =item contact
3760
3761 Returns this customer's full (billing) contact name only, "Last, First"
3762
3763 =cut
3764
3765 sub contact {
3766   my $self = shift;
3767   $self->get('last'). ', '. $self->first;
3768 }
3769
3770 =item ship_contact
3771
3772 Returns this customer's full (shipping) contact name only, "Last, First"
3773
3774 =cut
3775
3776 sub ship_contact {
3777   my $self = shift;
3778   $self->get('ship_last')
3779     ? $self->get('ship_last'). ', '. $self->ship_first
3780     : $self->contact;
3781 }
3782
3783 =item country_full
3784
3785 Returns this customer's full country name
3786
3787 =cut
3788
3789 sub country_full {
3790   my $self = shift;
3791   code2country($self->country);
3792 }
3793
3794 =item status
3795
3796 Returns a status string for this customer, currently:
3797
3798 =over 4
3799
3800 =item prospect - No packages have ever been ordered
3801
3802 =item active - One or more recurring packages is active
3803
3804 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
3805
3806 =item suspended - All non-cancelled recurring packages are suspended
3807
3808 =item cancelled - All recurring packages are cancelled
3809
3810 =back
3811
3812 =cut
3813
3814 sub status {
3815   my $self = shift;
3816   for my $status (qw( prospect active inactive suspended cancelled )) {
3817     my $method = $status.'_sql';
3818     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3819     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3820     $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
3821     return $status if $sth->fetchrow_arrayref->[0];
3822   }
3823 }
3824
3825 =item statuscolor
3826
3827 Returns a hex triplet color string for this customer's status.
3828
3829 =cut
3830
3831 use vars qw(%statuscolor);
3832 %statuscolor = (
3833   'prospect'  => '7e0079', #'000000', #black?  naw, purple
3834   'active'    => '00CC00', #green
3835   'inactive'  => '0000CC', #blue
3836   'suspended' => 'FF9900', #yellow
3837   'cancelled' => 'FF0000', #red
3838 );
3839
3840 sub statuscolor {
3841   my $self = shift;
3842   $statuscolor{$self->status};
3843 }
3844
3845 =back
3846
3847 =head1 CLASS METHODS
3848
3849 =over 4
3850
3851 =item prospect_sql
3852
3853 Returns an SQL expression identifying prospective cust_main records (customers
3854 with no packages ever ordered)
3855
3856 =cut
3857
3858 use vars qw($select_count_pkgs);
3859 $select_count_pkgs =
3860   "SELECT COUNT(*) FROM cust_pkg
3861     WHERE cust_pkg.custnum = cust_main.custnum";
3862
3863 sub select_count_pkgs_sql {
3864   $select_count_pkgs;
3865 }
3866
3867 sub prospect_sql { "
3868   0 = ( $select_count_pkgs )
3869 "; }
3870
3871 =item active_sql
3872
3873 Returns an SQL expression identifying active cust_main records (customers with
3874 no active recurring packages, but otherwise unsuspended/uncancelled).
3875
3876 =cut
3877
3878 sub active_sql { "
3879   0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
3880       )
3881 "; }
3882
3883 =item inactive_sql
3884
3885 Returns an SQL expression identifying inactive cust_main records (customers with
3886 active recurring packages).
3887
3888 =cut
3889
3890 sub inactive_sql { "
3891   0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
3892   AND
3893   0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
3894 "; }
3895
3896 =item susp_sql
3897 =item suspended_sql
3898
3899 Returns an SQL expression identifying suspended cust_main records.
3900
3901 =cut
3902
3903
3904 sub suspended_sql { susp_sql(@_); }
3905 sub susp_sql { "
3906     0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
3907     AND
3908     0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
3909 "; }
3910
3911 =item cancel_sql
3912 =item cancelled_sql
3913
3914 Returns an SQL expression identifying cancelled cust_main records.
3915
3916 =cut
3917
3918 sub cancelled_sql { cancel_sql(@_); }
3919 sub cancel_sql {
3920
3921   my $recurring_sql = FS::cust_pkg->recurring_sql;
3922   #my $recurring_sql = "
3923   #  '0' != ( select freq from part_pkg
3924   #             where cust_pkg.pkgpart = part_pkg.pkgpart )
3925   #";
3926
3927   "
3928     0 < ( $select_count_pkgs )
3929     AND 0 = ( $select_count_pkgs AND $recurring_sql
3930                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3931             )
3932   ";
3933 }
3934
3935 =item uncancel_sql
3936 =item uncancelled_sql
3937
3938 Returns an SQL expression identifying un-cancelled cust_main records.
3939
3940 =cut
3941
3942 sub uncancelled_sql { uncancel_sql(@_); }
3943 sub uncancel_sql { "
3944   ( 0 < ( $select_count_pkgs
3945                    AND ( cust_pkg.cancel IS NULL
3946                          OR cust_pkg.cancel = 0
3947                        )
3948         )
3949     OR 0 = ( $select_count_pkgs )
3950   )
3951 "; }
3952
3953 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3954
3955 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3956 records.  Currently, I<first>, I<last> and/or I<company> may be specified (the
3957 appropriate ship_ field is also searched).
3958
3959 Additional options are the same as FS::Record::qsearch
3960
3961 =cut
3962
3963 sub fuzzy_search {
3964   my( $self, $fuzzy, $hash, @opt) = @_;
3965   #$self
3966   $hash ||= {};
3967   my @cust_main = ();
3968
3969   check_and_rebuild_fuzzyfiles();
3970   foreach my $field ( keys %$fuzzy ) {
3971     my %match = ();
3972     $match{$_}=1 foreach ( amatch( $fuzzy->{$field},
3973                                    ['i'],
3974                                    @{ $self->all_X($field) }
3975                                  )
3976                          );
3977
3978     my @fcust = ();
3979     foreach ( keys %match ) {
3980       push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3981       push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
3982     }
3983     my %fsaw = ();
3984     push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
3985   }
3986
3987   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
3988   my %saw = ();
3989   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
3990
3991   @cust_main;
3992
3993 }
3994
3995 =back
3996
3997 =head1 SUBROUTINES
3998
3999 =over 4
4000
4001 =item smart_search OPTION => VALUE ...
4002
4003 Accepts the following options: I<search>, the string to search for.  The string
4004 will be searched for as a customer number, phone number, name or company name,
4005 first searching for an exact match then fuzzy and substring matches (in some
4006 cases - see the source code for the exact heuristics used).
4007
4008 Any additional options treated as an additional qualifier on the search
4009 (i.e. I<agentnum>).
4010
4011 Returns a (possibly empty) array of FS::cust_main objects.
4012
4013 =cut
4014
4015 sub smart_search {
4016   my %options = @_;
4017
4018   #here is the agent virtualization
4019   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
4020
4021   my @cust_main = ();
4022
4023   my $search = delete $options{'search'};
4024   ( my $alphanum_search = $search ) =~ s/\W//g;
4025
4026   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
4027
4028     #false laziness w/Record::ut_phone
4029     my $phonen = "$1-$2-$3";
4030     $phonen .= " x$4" if $4;
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 "$_ = '$phonen'",
4038                                           qw( daytime night fax
4039                                               ship_daytime ship_night ship_fax )
4040                              ).
4041                      ' ) '.
4042                      " AND $agentnums_sql", #agent virtualization
4043     } );
4044
4045     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
4046       #try looking for matches with extensions unless one was specified
4047
4048       push @cust_main, qsearch( {
4049         'table'   => 'cust_main',
4050         'hashref' => { %options },
4051         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
4052                        ' ( '.
4053                            join(' OR ', map "$_ LIKE '$phonen\%'",
4054                                             qw( daytime night
4055                                                 ship_daytime ship_night )
4056                                ).
4057                        ' ) '.
4058                        " AND $agentnums_sql", #agent virtualization
4059       } );
4060
4061     }
4062
4063   } elsif ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
4064
4065     push @cust_main, qsearch( {
4066       'table'     => 'cust_main',
4067       'hashref'   => { 'custnum' => $1, %options },
4068       'extra_sql' => " AND $agentnums_sql", #agent virtualization
4069     } );
4070
4071   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
4072
4073     my($company, $last, $first) = ( $1, $2, $3 );
4074
4075     # "Company (Last, First)"
4076     #this is probably something a browser remembered,
4077     #so just do an exact search
4078
4079     foreach my $prefix ( '', 'ship_' ) {
4080       push @cust_main, qsearch( {
4081         'table'     => 'cust_main',
4082         'hashref'   => { $prefix.'first'   => $first,
4083                          $prefix.'last'    => $last,
4084                          $prefix.'company' => $company,
4085                          %options,
4086                        },
4087         'extra_sql' => " AND $agentnums_sql",
4088       } );
4089     }
4090
4091   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
4092                                               # try (ship_){last,company}
4093
4094     my $value = lc($1);
4095
4096     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
4097     # # full strings the browser remembers won't work
4098     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
4099
4100     use Lingua::EN::NameParse;
4101     my $NameParse = new Lingua::EN::NameParse(
4102              auto_clean     => 1,
4103              allow_reversed => 1,
4104     );
4105
4106     my($last, $first) = ( '', '' );
4107     #maybe disable this too and just rely on NameParse?
4108     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
4109
4110       ($last, $first) = ( $1, $2 );
4111
4112     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
4113     } elsif ( ! $NameParse->parse($value) ) {
4114
4115       my %name = $NameParse->components;
4116       $first = $name{'given_name_1'};
4117       $last  = $name{'surname_1'};
4118
4119     }
4120
4121     if ( $first && $last ) {
4122
4123       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
4124
4125       #exact
4126       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
4127       $sql .= "
4128         (     ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
4129            OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
4130         )";
4131
4132       push @cust_main, qsearch( {
4133         'table'     => 'cust_main',
4134         'hashref'   => \%options,
4135         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
4136       } );
4137
4138       # or it just be something that was typed in... (try that in a sec)
4139
4140     }
4141
4142     my $q_value = dbh->quote($value);
4143
4144     #exact
4145     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
4146     $sql .= " (    LOWER(last)         = $q_value
4147                 OR LOWER(company)      = $q_value
4148                 OR LOWER(ship_last)    = $q_value
4149                 OR LOWER(ship_company) = $q_value
4150               )";
4151
4152     push @cust_main, qsearch( {
4153       'table'     => 'cust_main',
4154       'hashref'   => \%options,
4155       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
4156     } );
4157
4158     unless ( @cust_main ) {  #no exact match, trying substring/fuzzy
4159
4160       #still some false laziness w/ search/cust_main.cgi
4161
4162       #substring
4163
4164       my @hashrefs = (
4165         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
4166         { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
4167       );
4168
4169       if ( $first && $last ) {
4170
4171         push @hashrefs,
4172           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
4173             'last'         => { op=>'ILIKE', value=>"%$last%" },
4174           },
4175           { 'ship_first'   => { op=>'ILIKE', value=>"%$first%" },
4176             'ship_last'    => { op=>'ILIKE', value=>"%$last%" },
4177           },
4178         ;
4179
4180       } else {
4181
4182         push @hashrefs,
4183           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
4184           { 'ship_last'    => { op=>'ILIKE', value=>"%$value%" }, },
4185         ;
4186       }
4187
4188       foreach my $hashref ( @hashrefs ) {
4189
4190         push @cust_main, qsearch( {
4191           'table'     => 'cust_main',
4192           'hashref'   => { %$hashref,
4193                            %options,
4194                          },
4195           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
4196         } );
4197
4198       }
4199
4200       #fuzzy
4201       my @fuzopts = (
4202         \%options,                #hashref
4203         '',                       #select
4204         " AND $agentnums_sql",    #extra_sql  #agent virtualization
4205       );
4206
4207       if ( $first && $last ) {
4208         push @cust_main, FS::cust_main->fuzzy_search(
4209           { 'last'   => $last,    #fuzzy hashref
4210             'first'  => $first }, #
4211           @fuzopts
4212         );
4213       }
4214       foreach my $field ( 'last', 'company' ) {
4215         push @cust_main,
4216           FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
4217       }
4218
4219     }
4220
4221     #eliminate duplicates
4222     my %saw = ();
4223     @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
4224
4225   }
4226
4227   @cust_main;
4228
4229 }
4230
4231 =item check_and_rebuild_fuzzyfiles
4232
4233 =cut
4234
4235 use vars qw(@fuzzyfields);
4236 @fuzzyfields = ( 'last', 'first', 'company' );
4237
4238 sub check_and_rebuild_fuzzyfiles {
4239   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4240   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
4241 }
4242
4243 =item rebuild_fuzzyfiles
4244
4245 =cut
4246
4247 sub rebuild_fuzzyfiles {
4248
4249   use Fcntl qw(:flock);
4250
4251   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4252   mkdir $dir, 0700 unless -d $dir;
4253
4254   foreach my $fuzzy ( @fuzzyfields ) {
4255
4256     open(LOCK,">>$dir/cust_main.$fuzzy")
4257       or die "can't open $dir/cust_main.$fuzzy: $!";
4258     flock(LOCK,LOCK_EX)
4259       or die "can't lock $dir/cust_main.$fuzzy: $!";
4260
4261     open (CACHE,">$dir/cust_main.$fuzzy.tmp")
4262       or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
4263
4264     foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
4265       my $sth = dbh->prepare("SELECT $field FROM cust_main".
4266                              " WHERE $field != '' AND $field IS NOT NULL");
4267       $sth->execute or die $sth->errstr;
4268
4269       while ( my $row = $sth->fetchrow_arrayref ) {
4270         print CACHE $row->[0]. "\n";
4271       }
4272
4273     }
4274
4275     close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
4276
4277     rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
4278     close LOCK;
4279   }
4280
4281 }
4282
4283 =item all_X
4284
4285 =cut
4286
4287 sub all_X {
4288   my( $self, $field ) = @_;
4289   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4290   open(CACHE,"<$dir/cust_main.$field")
4291     or die "can't open $dir/cust_main.$field: $!";
4292   my @array = map { chomp; $_; } <CACHE>;
4293   close CACHE;
4294   \@array;
4295 }
4296
4297 =item append_fuzzyfiles LASTNAME COMPANY
4298
4299 =cut
4300
4301 sub append_fuzzyfiles {
4302   #my( $first, $last, $company ) = @_;
4303
4304   &check_and_rebuild_fuzzyfiles;
4305
4306   use Fcntl qw(:flock);
4307
4308   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4309
4310   foreach my $field (qw( first last company )) {
4311     my $value = shift;
4312
4313     if ( $value ) {
4314
4315       open(CACHE,">>$dir/cust_main.$field")
4316         or die "can't open $dir/cust_main.$field: $!";
4317       flock(CACHE,LOCK_EX)
4318         or die "can't lock $dir/cust_main.$field: $!";
4319
4320       print CACHE "$value\n";
4321
4322       flock(CACHE,LOCK_UN)
4323         or die "can't unlock $dir/cust_main.$field: $!";
4324       close CACHE;
4325     }
4326
4327   }
4328
4329   1;
4330 }
4331
4332 =item batch_import
4333
4334 =cut
4335
4336 sub batch_import {
4337   my $param = shift;
4338   #warn join('-',keys %$param);
4339   my $fh = $param->{filehandle};
4340   my $agentnum = $param->{agentnum};
4341
4342   my $refnum = $param->{refnum};
4343   my $pkgpart = $param->{pkgpart};
4344
4345   #my @fields = @{$param->{fields}};
4346   my $format = $param->{'format'};
4347   my @fields;
4348   my $payby;
4349   if ( $format eq 'simple' ) {
4350     @fields = qw( cust_pkg.setup dayphone first last
4351                   address1 address2 city state zip comments );
4352     $payby = 'BILL';
4353   } elsif ( $format eq 'extended' ) {
4354     @fields = qw( agent_custid refnum
4355                   last first address1 address2 city state zip country
4356                   daytime night
4357                   ship_last ship_first ship_address1 ship_address2
4358                   ship_city ship_state ship_zip ship_country
4359                   payinfo paycvv paydate
4360                   invoicing_list
4361                   cust_pkg.pkgpart
4362                   svc_acct.username svc_acct._password
4363                 );
4364     $payby = 'BILL';
4365   } else {
4366     die "unknown format $format";
4367   }
4368
4369   eval "use Text::CSV_XS;";
4370   die $@ if $@;
4371
4372   my $csv = new Text::CSV_XS;
4373   #warn $csv;
4374   #warn $fh;
4375
4376   my $imported = 0;
4377   #my $columns;
4378
4379   local $SIG{HUP} = 'IGNORE';
4380   local $SIG{INT} = 'IGNORE';
4381   local $SIG{QUIT} = 'IGNORE';
4382   local $SIG{TERM} = 'IGNORE';
4383   local $SIG{TSTP} = 'IGNORE';
4384   local $SIG{PIPE} = 'IGNORE';
4385
4386   my $oldAutoCommit = $FS::UID::AutoCommit;
4387   local $FS::UID::AutoCommit = 0;
4388   my $dbh = dbh;
4389
4390   #while ( $columns = $csv->getline($fh) ) {
4391   my $line;
4392   while ( defined($line=<$fh>) ) {
4393
4394     $csv->parse($line) or do {
4395       $dbh->rollback if $oldAutoCommit;
4396       return "can't parse: ". $csv->error_input();
4397     };
4398
4399     my @columns = $csv->fields();
4400     #warn join('-',@columns);
4401
4402     my %cust_main = (
4403       agentnum => $agentnum,
4404       refnum   => $refnum,
4405       country  => $conf->config('countrydefault') || 'US',
4406       payby    => $payby, #default
4407       paydate  => '12/2037', #default
4408     );
4409     my $billtime = time;
4410     my %cust_pkg = ( pkgpart => $pkgpart );
4411     my %svc_acct = ();
4412     foreach my $field ( @fields ) {
4413
4414       if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|expire|cancel)$/ ) {
4415
4416         #$cust_pkg{$1} = str2time( shift @$columns );
4417         if ( $1 eq 'pkgpart' ) {
4418           $cust_pkg{$1} = shift @columns;
4419         } elsif ( $1 eq 'setup' ) {
4420           $billtime = str2time(shift @columns);
4421         } else {
4422           $cust_pkg{$1} = str2time( shift @columns );
4423         }
4424
4425       } elsif ( $field =~ /^svc_acct\.(username|_password)$/ ) {
4426
4427         $svc_acct{$1} = shift @columns;
4428
4429       } else {
4430
4431         #refnum interception
4432         if ( $field eq 'refnum' && $columns[0] !~ /^\s*(\d+)\s*$/ ) {
4433
4434           my $referral = $columns[0];
4435           my %hash = ( 'referral' => $referral,
4436                        'agentnum' => $agentnum,
4437                        'disabled' => '',
4438                      );
4439
4440           my $part_referral = qsearchs('part_referral', \%hash )
4441                               || new FS::part_referral \%hash;
4442
4443           unless ( $part_referral->refnum ) {
4444             my $error = $part_referral->insert;
4445             if ( $error ) {
4446               $dbh->rollback if $oldAutoCommit;
4447               return "can't auto-insert advertising source: $referral: $error";
4448             }
4449           }
4450
4451           $columns[0] = $part_referral->refnum;
4452         }
4453
4454         #$cust_main{$field} = shift @$columns;
4455         $cust_main{$field} = shift @columns;
4456       }
4457     }
4458
4459     $cust_main{'payby'} = 'CARD' if length($cust_main{'payinfo'});
4460
4461     my $invoicing_list = $cust_main{'invoicing_list'}
4462                            ? [ delete $cust_main{'invoicing_list'} ]
4463                            : [];
4464
4465     my $cust_main = new FS::cust_main ( \%cust_main );
4466
4467     use Tie::RefHash;
4468     tie my %hash, 'Tie::RefHash'; #this part is important
4469
4470     if ( $cust_pkg{'pkgpart'} ) {
4471       my $cust_pkg = new FS::cust_pkg ( \%cust_pkg );
4472
4473       my @svc_acct = ();
4474       if ( $svc_acct{'username'} ) {
4475         $svc_acct{svcpart} = $cust_pkg->part_pkg->svcpart( 'svc_acct' );
4476         push @svc_acct, new FS::svc_acct ( \%svc_acct )
4477       }
4478
4479       $hash{$cust_pkg} = \@svc_acct;
4480     }
4481
4482     my $error = $cust_main->insert( \%hash, $invoicing_list );
4483
4484     if ( $error ) {
4485       $dbh->rollback if $oldAutoCommit;
4486       return "can't insert customer for $line: $error";
4487     }
4488
4489     if ( $format eq 'simple' ) {
4490
4491       #false laziness w/bill.cgi
4492       $error = $cust_main->bill( 'time' => $billtime );
4493       if ( $error ) {
4494         $dbh->rollback if $oldAutoCommit;
4495         return "can't bill customer for $line: $error";
4496       }
4497
4498       $cust_main->apply_payments;
4499       $cust_main->apply_credits;
4500
4501       $error = $cust_main->collect();
4502       if ( $error ) {
4503         $dbh->rollback if $oldAutoCommit;
4504         return "can't collect customer for $line: $error";
4505       }
4506
4507     }
4508
4509     $imported++;
4510   }
4511
4512   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4513
4514   return "Empty file!" unless $imported;
4515
4516   ''; #no error
4517
4518 }
4519
4520 =item batch_charge
4521
4522 =cut
4523
4524 sub batch_charge {
4525   my $param = shift;
4526   #warn join('-',keys %$param);
4527   my $fh = $param->{filehandle};
4528   my @fields = @{$param->{fields}};
4529
4530   eval "use Text::CSV_XS;";
4531   die $@ if $@;
4532
4533   my $csv = new Text::CSV_XS;
4534   #warn $csv;
4535   #warn $fh;
4536
4537   my $imported = 0;
4538   #my $columns;
4539
4540   local $SIG{HUP} = 'IGNORE';
4541   local $SIG{INT} = 'IGNORE';
4542   local $SIG{QUIT} = 'IGNORE';
4543   local $SIG{TERM} = 'IGNORE';
4544   local $SIG{TSTP} = 'IGNORE';
4545   local $SIG{PIPE} = 'IGNORE';
4546
4547   my $oldAutoCommit = $FS::UID::AutoCommit;
4548   local $FS::UID::AutoCommit = 0;
4549   my $dbh = dbh;
4550
4551   #while ( $columns = $csv->getline($fh) ) {
4552   my $line;
4553   while ( defined($line=<$fh>) ) {
4554
4555     $csv->parse($line) or do {
4556       $dbh->rollback if $oldAutoCommit;
4557       return "can't parse: ". $csv->error_input();
4558     };
4559
4560     my @columns = $csv->fields();
4561     #warn join('-',@columns);
4562
4563     my %row = ();
4564     foreach my $field ( @fields ) {
4565       $row{$field} = shift @columns;
4566     }
4567
4568     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
4569     unless ( $cust_main ) {
4570       $dbh->rollback if $oldAutoCommit;
4571       return "unknown custnum $row{'custnum'}";
4572     }
4573
4574     if ( $row{'amount'} > 0 ) {
4575       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4576       if ( $error ) {
4577         $dbh->rollback if $oldAutoCommit;
4578         return $error;
4579       }
4580       $imported++;
4581     } elsif ( $row{'amount'} < 0 ) {
4582       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4583                                       $row{'pkg'}                         );
4584       if ( $error ) {
4585         $dbh->rollback if $oldAutoCommit;
4586         return $error;
4587       }
4588       $imported++;
4589     } else {
4590       #hmm?
4591     }
4592
4593   }
4594
4595   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4596
4597   return "Empty file!" unless $imported;
4598
4599   ''; #no error
4600
4601 }
4602
4603 =back
4604
4605 =head1 BUGS
4606
4607 The delete method.
4608
4609 The delete method should possibly take an FS::cust_main object reference
4610 instead of a scalar customer number.
4611
4612 Bill and collect options should probably be passed as references instead of a
4613 list.
4614
4615 There should probably be a configuration file with a list of allowed credit
4616 card types.
4617
4618 No multiple currency support (probably a larger project than just this module).
4619
4620 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4621
4622 =head1 SEE ALSO
4623
4624 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4625 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4626 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
4627
4628 =cut
4629
4630 1;
4631