FS/FS/cust_main.pm

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