FS/FS/cust_main.pm

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