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