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   $content{invoice_number} = $options{'invnum'}
2522     if exists($options{'payip'}) && length($options{'invnum'});
2523
2524   if ( $method eq 'CC' ) {
2525
2526     $content{card_number} = $payinfo;
2527     my $paydate = exists($options{'paydate'})
2528                     ? $options{'paydate'}
2529                     : $self->paydate;
2530     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2531     $content{expiration} = "$2/$1";
2532
2533     my $paycvv = exists($options{'paycvv'})
2534                    ? $options{'paycvv'}
2535                    : $self->paycvv;
2536     $content{cvv2} = $self->paycvv
2537       if length($paycvv);
2538
2539     my $paystart_month = exists($options{'paystart_month'})
2540                            ? $options{'paystart_month'}
2541                            : $self->paystart_month;
2542
2543     my $paystart_year  = exists($options{'paystart_year'})
2544                            ? $options{'paystart_year'}
2545                            : $self->paystart_year;
2546
2547     $content{card_start} = "$paystart_month/$paystart_year"
2548       if $paystart_month && $paystart_year;
2549
2550     my $payissue       = exists($options{'payissue'})
2551                            ? $options{'payissue'}
2552                            : $self->payissue;
2553     $content{issue_number} = $payissue if $payissue;
2554
2555     $content{recurring_billing} = 'YES'
2556       if qsearch('cust_pay', { 'custnum' => $self->custnum,
2557                                'payby'   => 'CARD',
2558                                'payinfo' => $payinfo,
2559                              } );
2560
2561   } elsif ( $method eq 'ECHECK' ) {
2562     ( $content{account_number}, $content{routing_code} ) =
2563       split('@', $payinfo);
2564     $content{bank_name} = $o_payname;
2565     $content{account_type} = 'CHECKING';
2566     $content{account_name} = $payname;
2567     $content{customer_org} = $self->company ? 'B' : 'I';
2568     $content{customer_ssn} = exists($options{'ss'})
2569                                ? $options{'ss'}
2570                                : $self->ss;
2571   } elsif ( $method eq 'LEC' ) {
2572     $content{phone} = $payinfo;
2573   }
2574
2575   ###
2576   # run transaction(s)
2577   ###
2578
2579   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
2580
2581   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
2582   $transaction->content(
2583     'type'           => $method,
2584     'login'          => $login,
2585     'password'       => $password,
2586     'action'         => $action1,
2587     'description'    => $options{'description'},
2588     'amount'         => $amount,
2589     #'invoice_number' => $options{'invnum'},
2590     'customer_id'    => $self->custnum,
2591     'last_name'      => $paylast,
2592     'first_name'     => $payfirst,
2593     'name'           => $payname,
2594     'address'        => $address,
2595     'city'           => ( exists($options{'city'})
2596                             ? $options{'city'}
2597                             : $self->city          ),
2598     'state'          => ( exists($options{'state'})
2599                             ? $options{'state'}
2600                             : $self->state          ),
2601     'zip'            => ( exists($options{'zip'})
2602                             ? $options{'zip'}
2603                             : $self->zip          ),
2604     'country'        => ( exists($options{'country'})
2605                             ? $options{'country'}
2606                             : $self->country          ),
2607     'referer'        => 'http://cleanwhisker.420.am/',
2608     'email'          => $email,
2609     'phone'          => $self->daytime || $self->night,
2610     %content, #after
2611   );
2612   $transaction->submit();
2613
2614   if ( $transaction->is_success() && $action2 ) {
2615     my $auth = $transaction->authorization;
2616     my $ordernum = $transaction->can('order_number')
2617                    ? $transaction->order_number
2618                    : '';
2619
2620     my $capture =
2621       new Business::OnlinePayment( $processor, @bop_options );
2622
2623     my %capture = (
2624       %content,
2625       type           => $method,
2626       action         => $action2,
2627       login          => $login,
2628       password       => $password,
2629       order_number   => $ordernum,
2630       amount         => $amount,
2631       authorization  => $auth,
2632       description    => $options{'description'},
2633     );
2634
2635     foreach my $field (qw( authorization_source_code returned_ACI                                          transaction_identifier validation_code
2636                            transaction_sequence_num local_transaction_date
2637                            local_transaction_time AVS_result_code          )) {
2638       $capture{$field} = $transaction->$field() if $transaction->can($field);
2639     }
2640
2641     $capture->content( %capture );
2642
2643     $capture->submit();
2644
2645     unless ( $capture->is_success ) {
2646       my $e = "Authorization successful but capture failed, custnum #".
2647               $self->custnum. ': '.  $capture->result_code.
2648               ": ". $capture->error_message;
2649       warn $e;
2650       return $e;
2651     }
2652
2653   }
2654
2655   ###
2656   # remove paycvv after initial transaction
2657   ###
2658
2659   #false laziness w/misc/process/payment.cgi - check both to make sure working
2660   # correctly
2661   if ( defined $self->dbdef_table->column('paycvv')
2662        && length($self->paycvv)
2663        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2664   ) {
2665     my $error = $self->remove_cvv;
2666     if ( $error ) {
2667       warn "WARNING: error removing cvv: $error\n";
2668     }
2669   }
2670
2671   ###
2672   # result handling
2673   ###
2674
2675   if ( $transaction->is_success() ) {
2676
2677     my %method2payby = (
2678       'CC'     => 'CARD',
2679       'ECHECK' => 'CHEK',
2680       'LEC'    => 'LECB',
2681     );
2682
2683     my $paybatch = '';
2684     if ( $payment_gateway ) { # agent override
2685       $paybatch = $payment_gateway->gatewaynum. '-';
2686     }
2687
2688     $paybatch .= "$processor:". $transaction->authorization;
2689
2690     $paybatch .= ':'. $transaction->order_number
2691       if $transaction->can('order_number')
2692       && length($transaction->order_number);
2693
2694     my $cust_pay = new FS::cust_pay ( {
2695        'custnum'  => $self->custnum,
2696        'invnum'   => $options{'invnum'},
2697        'paid'     => $amount,
2698        '_date'     => '',
2699        'payby'    => $method2payby{$method},
2700        'payinfo'  => $payinfo,
2701        'paybatch' => $paybatch,
2702     } );
2703     my $error = $cust_pay->insert;
2704     if ( $error ) {
2705       $cust_pay->invnum(''); #try again with no specific invnum
2706       my $error2 = $cust_pay->insert;
2707       if ( $error2 ) {
2708         # gah, even with transactions.
2709         my $e = 'WARNING: Card/ACH debited but database not updated - '.
2710                 "error inserting payment ($processor): $error2".
2711                 " (previously tried insert with invnum #$options{'invnum'}" .
2712                 ": $error )";
2713         warn $e;
2714         return $e;
2715       }
2716     }
2717     return ''; #no error
2718
2719   } else {
2720
2721     my $perror = "$processor error: ". $transaction->error_message;
2722
2723     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2724          && $conf->exists('emaildecline')
2725          && grep { $_ ne 'POST' } $self->invoicing_list
2726          && ! grep { $transaction->error_message =~ /$_/ }
2727                    $conf->config('emaildecline-exclude')
2728     ) {
2729       my @templ = $conf->config('declinetemplate');
2730       my $template = new Text::Template (
2731         TYPE   => 'ARRAY',
2732         SOURCE => [ map "$_\n", @templ ],
2733       ) or return "($perror) can't create template: $Text::Template::ERROR";
2734       $template->compile()
2735         or return "($perror) can't compile template: $Text::Template::ERROR";
2736
2737       my $templ_hash = { error => $transaction->error_message };
2738
2739       my $error = send_email(
2740         'from'    => $conf->config('invoice_from'),
2741         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2742         'subject' => 'Your payment could not be processed',
2743         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
2744       );
2745
2746       $perror .= " (also received error sending decline notification: $error)"
2747         if $error;
2748
2749     }
2750
2751     return $perror;
2752   }
2753
2754 }
2755
2756 =item default_payment_gateway
2757
2758 =cut
2759
2760 sub default_payment_gateway {
2761   my( $self, $method ) = @_;
2762
2763   die "Real-time processing not enabled\n"
2764     unless $conf->exists('business-onlinepayment');
2765
2766   #load up config
2767   my $bop_config = 'business-onlinepayment';
2768   $bop_config .= '-ach'
2769     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2770   my ( $processor, $login, $password, $action, @bop_options ) =
2771     $conf->config($bop_config);
2772   $action ||= 'normal authorization';
2773   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2774   die "No real-time processor is enabled - ".
2775       "did you set the business-onlinepayment configuration value?\n"
2776     unless $processor;
2777
2778   ( $processor, $login, $password, $action, @bop_options )
2779 }
2780
2781 =item remove_cvv
2782
2783 Removes the I<paycvv> field from the database directly.
2784
2785 If there is an error, returns the error, otherwise returns false.
2786
2787 =cut
2788
2789 sub remove_cvv {
2790   my $self = shift;
2791   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2792     or return dbh->errstr;
2793   $sth->execute($self->custnum)
2794     or return $sth->errstr;
2795   $self->paycvv('');
2796   '';
2797 }
2798
2799 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2800
2801 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2802 via a Business::OnlinePayment realtime gateway.  See
2803 L<http://420.am/business-onlinepayment> for supported gateways.
2804
2805 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2806
2807 Available options are: I<amount>, I<reason>, I<paynum>
2808
2809 Most gateways require a reference to an original payment transaction to refund,
2810 so you probably need to specify a I<paynum>.
2811
2812 I<amount> defaults to the original amount of the payment if not specified.
2813
2814 I<reason> specifies a reason for the refund.
2815
2816 Implementation note: If I<amount> is unspecified or equal to the amount of the
2817 orignal payment, first an attempt is made to "void" the transaction via
2818 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2819 the normal attempt is made to "refund" ("credit") the transaction via the
2820 gateway is attempted.
2821
2822 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2823 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2824 #if set, will override the value from the customer record.
2825
2826 #If an I<invnum> is specified, this payment (if successful) is applied to the
2827 #specified invoice.  If you don't specify an I<invnum> you might want to
2828 #call the B<apply_payments> method.
2829
2830 =cut
2831
2832 #some false laziness w/realtime_bop, not enough to make it worth merging
2833 #but some useful small subs should be pulled out
2834 sub realtime_refund_bop {
2835   my( $self, $method, %options ) = @_;
2836   if ( $DEBUG ) {
2837     warn "$me realtime_refund_bop: $method refund\n";
2838     warn "  $_ => $options{$_}\n" foreach keys %options;
2839   }
2840
2841   eval "use Business::OnlinePayment";
2842   die $@ if $@;
2843
2844   ###
2845   # look up the original payment and optionally a gateway for that payment
2846   ###
2847
2848   my $cust_pay = '';
2849   my $amount = $options{'amount'};
2850
2851   my( $processor, $login, $password, @bop_options ) ;
2852   my( $auth, $order_number ) = ( '', '', '' );
2853
2854   if ( $options{'paynum'} ) {
2855
2856     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
2857     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2858       or return "Unknown paynum $options{'paynum'}";
2859     $amount ||= $cust_pay->paid;
2860
2861     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/
2862       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2863                 $cust_pay->paybatch;
2864     my $gatewaynum = '';
2865     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
2866
2867     if ( $gatewaynum ) { #gateway for the payment to be refunded
2868
2869       my $payment_gateway =
2870         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
2871       die "payment gateway $gatewaynum not found"
2872         unless $payment_gateway;
2873
2874       $processor   = $payment_gateway->gateway_module;
2875       $login       = $payment_gateway->gateway_username;
2876       $password    = $payment_gateway->gateway_password;
2877       @bop_options = $payment_gateway->options;
2878
2879     } else { #try the default gateway
2880
2881       my( $conf_processor, $unused_action );
2882       ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
2883         $self->default_payment_gateway($method);
2884
2885       return "processor of payment $options{'paynum'} $processor does not".
2886              " match default processor $conf_processor"
2887         unless $processor eq $conf_processor;
2888
2889     }
2890
2891
2892   } else { # didn't specify a paynum, so look for agent gateway overrides
2893            # like a normal transaction
2894
2895     my $cardtype;
2896     if ( $method eq 'CC' ) {
2897       $cardtype = cardtype($self->payinfo);
2898     } elsif ( $method eq 'ECHECK' ) {
2899       $cardtype = 'ACH';
2900     } else {
2901       $cardtype = $method;
2902     }
2903     my $override =
2904            qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2905                                                cardtype => $cardtype,
2906                                                taxclass => '',              } )
2907         || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2908                                                cardtype => '',
2909                                                taxclass => '',              } );
2910
2911     if ( $override ) { #use a payment gateway override
2912
2913       my $payment_gateway = $override->payment_gateway;
2914
2915       $processor   = $payment_gateway->gateway_module;
2916       $login       = $payment_gateway->gateway_username;
2917       $password    = $payment_gateway->gateway_password;
2918       #$action      = $payment_gateway->gateway_action;
2919       @bop_options = $payment_gateway->options;
2920
2921     } else { #use the standard settings from the config
2922
2923       my $unused_action;
2924       ( $processor, $login, $password, $unused_action, @bop_options ) =
2925         $self->default_payment_gateway($method);
2926
2927     }
2928
2929   }
2930   return "neither amount nor paynum specified" unless $amount;
2931
2932   my %content = (
2933     'type'           => $method,
2934     'login'          => $login,
2935     'password'       => $password,
2936     'order_number'   => $order_number,
2937     'amount'         => $amount,
2938     'referer'        => 'http://cleanwhisker.420.am/',
2939   );
2940   $content{authorization} = $auth
2941     if length($auth); #echeck/ACH transactions have an order # but no auth
2942                       #(at least with authorize.net)
2943
2944   #first try void if applicable
2945   if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2946     warn "  attempting void\n" if $DEBUG > 1;
2947     my $void = new Business::OnlinePayment( $processor, @bop_options );
2948     $void->content( 'action' => 'void', %content );
2949     $void->submit();
2950     if ( $void->is_success ) {
2951       my $error = $cust_pay->void($options{'reason'});
2952       if ( $error ) {
2953         # gah, even with transactions.
2954         my $e = 'WARNING: Card/ACH voided but database not updated - '.
2955                 "error voiding payment: $error";
2956         warn $e;
2957         return $e;
2958       }
2959       warn "  void successful\n" if $DEBUG > 1;
2960       return '';
2961     }
2962   }
2963
2964   warn "  void unsuccessful, trying refund\n"
2965     if $DEBUG > 1;
2966
2967   #massage data
2968   my $address = $self->address1;
2969   $address .= ", ". $self->address2 if $self->address2;
2970
2971   my($payname, $payfirst, $paylast);
2972   if ( $self->payname && $method ne 'ECHECK' ) {
2973     $payname = $self->payname;
2974     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2975       or return "Illegal payname $payname";
2976     ($payfirst, $paylast) = ($1, $2);
2977   } else {
2978     $payfirst = $self->getfield('first');
2979     $paylast = $self->getfield('last');
2980     $payname =  "$payfirst $paylast";
2981   }
2982
2983   my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
2984   if ( $conf->exists('emailinvoiceauto')
2985        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
2986     push @invoicing_list, $self->all_emails;
2987   }
2988
2989   my $email = ($conf->exists('business-onlinepayment-email-override'))
2990               ? $conf->config('business-onlinepayment-email-override')
2991               : $invoicing_list[0];
2992
2993   my $payip = exists($options{'payip'})
2994                 ? $options{'payip'}
2995                 : $self->payip;
2996   $content{customer_ip} = $payip
2997     if length($payip);
2998
2999   my $payinfo = '';
3000   if ( $method eq 'CC' ) {
3001
3002     if ( $cust_pay ) {
3003       $content{card_number} = $payinfo = $cust_pay->payinfo;
3004       #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3005       #$content{expiration} = "$2/$1";
3006     } else {
3007       $content{card_number} = $payinfo = $self->payinfo;
3008       $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3009       $content{expiration} = "$2/$1";
3010     }
3011
3012   } elsif ( $method eq 'ECHECK' ) {
3013     ( $content{account_number}, $content{routing_code} ) =
3014       split('@', $payinfo = $self->payinfo);
3015     $content{bank_name} = $self->payname;
3016     $content{account_type} = 'CHECKING';
3017     $content{account_name} = $payname;
3018     $content{customer_org} = $self->company ? 'B' : 'I';
3019     $content{customer_ssn} = $self->ss;
3020   } elsif ( $method eq 'LEC' ) {
3021     $content{phone} = $payinfo = $self->payinfo;
3022   }
3023
3024   #then try refund
3025   my $refund = new Business::OnlinePayment( $processor, @bop_options );
3026   my %sub_content = $refund->content(
3027     'action'         => 'credit',
3028     'customer_id'    => $self->custnum,
3029     'last_name'      => $paylast,
3030     'first_name'     => $payfirst,
3031     'name'           => $payname,
3032     'address'        => $address,
3033     'city'           => $self->city,
3034     'state'          => $self->state,
3035     'zip'            => $self->zip,
3036     'country'        => $self->country,
3037     'email'          => $email,
3038     'phone'          => $self->daytime || $self->night,
3039     %content, #after
3040   );
3041   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
3042     if $DEBUG > 1;
3043   $refund->submit();
3044
3045   return "$processor error: ". $refund->error_message
3046     unless $refund->is_success();
3047
3048   my %method2payby = (
3049     'CC'     => 'CARD',
3050     'ECHECK' => 'CHEK',
3051     'LEC'    => 'LECB',
3052   );
3053
3054   my $paybatch = "$processor:". $refund->authorization;
3055   $paybatch .= ':'. $refund->order_number
3056     if $refund->can('order_number') && $refund->order_number;
3057
3058   while ( $cust_pay && $cust_pay->unappled < $amount ) {
3059     my @cust_bill_pay = $cust_pay->cust_bill_pay;
3060     last unless @cust_bill_pay;
3061     my $cust_bill_pay = pop @cust_bill_pay;
3062     my $error = $cust_bill_pay->delete;
3063     last if $error;
3064   }
3065
3066   my $cust_refund = new FS::cust_refund ( {
3067     'custnum'  => $self->custnum,
3068     'paynum'   => $options{'paynum'},
3069     'refund'   => $amount,
3070     '_date'    => '',
3071     'payby'    => $method2payby{$method},
3072     'payinfo'  => $payinfo,
3073     'paybatch' => $paybatch,
3074     'reason'   => $options{'reason'} || 'card or ACH refund',
3075   } );
3076   my $error = $cust_refund->insert;
3077   if ( $error ) {
3078     $cust_refund->paynum(''); #try again with no specific paynum
3079     my $error2 = $cust_refund->insert;
3080     if ( $error2 ) {
3081       # gah, even with transactions.
3082       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
3083               "error inserting refund ($processor): $error2".
3084               " (previously tried insert with paynum #$options{'paynum'}" .
3085               ": $error )";
3086       warn $e;
3087       return $e;
3088     }
3089   }
3090
3091   ''; #no error
3092
3093 }
3094
3095 =item total_owed
3096
3097 Returns the total owed for this customer on all invoices
3098 (see L<FS::cust_bill/owed>).
3099
3100 =cut
3101
3102 sub total_owed {
3103   my $self = shift;
3104   $self->total_owed_date(2145859200); #12/31/2037
3105 }
3106
3107 =item total_owed_date TIME
3108
3109 Returns the total owed for this customer on all invoices with date earlier than
3110 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
3111 see L<Time::Local> and L<Date::Parse> for conversion functions.
3112
3113 =cut
3114
3115 sub total_owed_date {
3116   my $self = shift;
3117   my $time = shift;
3118   my $total_bill = 0;
3119   foreach my $cust_bill (
3120     grep { $_->_date <= $time }
3121       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3122   ) {
3123     $total_bill += $cust_bill->owed;
3124   }
3125   sprintf( "%.2f", $total_bill );
3126 }
3127
3128 =item apply_credits OPTION => VALUE ...
3129
3130 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
3131 to outstanding invoice balances in chronological order (or reverse
3132 chronological order if the I<order> option is set to B<newest>) and returns the
3133 value of any remaining unapplied credits available for refund (see
3134 L<FS::cust_refund>).
3135
3136 =cut
3137
3138 sub apply_credits {
3139   my $self = shift;
3140   my %opt = @_;
3141
3142   return 0 unless $self->total_credited;
3143
3144   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
3145       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
3146
3147   my @invoices = $self->open_cust_bill;
3148   @invoices = sort { $b->_date <=> $a->_date } @invoices
3149     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
3150
3151   my $credit;
3152   foreach my $cust_bill ( @invoices ) {
3153     my $amount;
3154
3155     if ( !defined($credit) || $credit->credited == 0) {
3156       $credit = pop @credits or last;
3157     }
3158
3159     if ($cust_bill->owed >= $credit->credited) {
3160       $amount=$credit->credited;
3161     }else{
3162       $amount=$cust_bill->owed;
3163     }
3164
3165     my $cust_credit_bill = new FS::cust_credit_bill ( {
3166       'crednum' => $credit->crednum,
3167       'invnum'  => $cust_bill->invnum,
3168       'amount'  => $amount,
3169     } );
3170     my $error = $cust_credit_bill->insert;
3171     die $error if $error;
3172
3173     redo if ($cust_bill->owed > 0);
3174
3175   }
3176
3177   return $self->total_credited;
3178 }
3179
3180 =item apply_payments
3181
3182 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
3183 to outstanding invoice balances in chronological order.
3184
3185  #and returns the value of any remaining unapplied payments.
3186
3187 =cut
3188
3189 sub apply_payments {
3190   my $self = shift;
3191
3192   #return 0 unless
3193
3194   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
3195       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
3196
3197   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
3198       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
3199
3200   my $payment;
3201
3202   foreach my $cust_bill ( @invoices ) {
3203     my $amount;
3204
3205     if ( !defined($payment) || $payment->unapplied == 0 ) {
3206       $payment = pop @payments or last;
3207     }
3208
3209     if ( $cust_bill->owed >= $payment->unapplied ) {
3210       $amount = $payment->unapplied;
3211     } else {
3212       $amount = $cust_bill->owed;
3213     }
3214
3215     my $cust_bill_pay = new FS::cust_bill_pay ( {
3216       'paynum' => $payment->paynum,
3217       'invnum' => $cust_bill->invnum,
3218       'amount' => $amount,
3219     } );
3220     my $error = $cust_bill_pay->insert;
3221     die $error if $error;
3222
3223     redo if ( $cust_bill->owed > 0);
3224
3225   }
3226
3227   return $self->total_unapplied_payments;
3228 }
3229
3230 =item total_credited
3231
3232 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3233 customer.  See L<FS::cust_credit/credited>.
3234
3235 =cut
3236
3237 sub total_credited {
3238   my $self = shift;
3239   my $total_credit = 0;
3240   foreach my $cust_credit ( qsearch('cust_credit', {
3241     'custnum' => $self->custnum,
3242   } ) ) {
3243     $total_credit += $cust_credit->credited;
3244   }
3245   sprintf( "%.2f", $total_credit );
3246 }
3247
3248 =item total_unapplied_payments
3249
3250 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3251 See L<FS::cust_pay/unapplied>.
3252
3253 =cut
3254
3255 sub total_unapplied_payments {
3256   my $self = shift;
3257   my $total_unapplied = 0;
3258   foreach my $cust_pay ( qsearch('cust_pay', {
3259     'custnum' => $self->custnum,
3260   } ) ) {
3261     $total_unapplied += $cust_pay->unapplied;
3262   }
3263   sprintf( "%.2f", $total_unapplied );
3264 }
3265
3266 =item balance
3267
3268 Returns the balance for this customer (total_owed minus total_credited
3269 minus total_unapplied_payments).
3270
3271 =cut
3272
3273 sub balance {
3274   my $self = shift;
3275   sprintf( "%.2f",
3276     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
3277   );
3278 }
3279
3280 =item balance_date TIME
3281
3282 Returns the balance for this customer, only considering invoices with date
3283 earlier than TIME (total_owed_date minus total_credited minus
3284 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
3285 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
3286 functions.
3287
3288 =cut
3289
3290 sub balance_date {
3291   my $self = shift;
3292   my $time = shift;
3293   sprintf( "%.2f",
3294     $self->total_owed_date($time)
3295       - $self->total_credited
3296       - $self->total_unapplied_payments
3297   );
3298 }
3299
3300 =item in_transit_payments
3301
3302 Returns the total of requests for payments for this customer pending in
3303 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
3304
3305 =cut
3306
3307 sub in_transit_payments {
3308   my $self = shift;
3309   my $in_transit_payments = 0;
3310   foreach my $pay_batch ( qsearch('pay_batch', {
3311     'status' => 'I',
3312   } ) ) {
3313     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
3314       'batchnum' => $pay_batch->batchnum,
3315       'custnum' => $self->custnum,
3316     } ) ) {
3317       $in_transit_payments += $cust_pay_batch->amount;
3318     }
3319   }
3320   sprintf( "%.2f", $in_transit_payments );
3321 }
3322
3323 =item paydate_monthyear
3324
3325 Returns a two-element list consisting of the month and year of this customer's
3326 paydate (credit card expiration date for CARD customers)
3327
3328 =cut
3329
3330 sub paydate_monthyear {
3331   my $self = shift;
3332   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3333     ( $2, $1 );
3334   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3335     ( $1, $3 );
3336   } else {
3337     ('', '');
3338   }
3339 }
3340
3341 =item payinfo_masked
3342
3343 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.
3344
3345 Credit Cards - Mask all but the last four characters.
3346 Checks - Mask all but last 2 of account number and bank routing number.
3347 Others - Do nothing, return the unmasked string.
3348
3349 =cut
3350
3351 sub payinfo_masked {
3352   my $self = shift;
3353   return $self->paymask;
3354 }
3355
3356 =item invoicing_list [ ARRAYREF ]
3357
3358 If an arguement is given, sets these email addresses as invoice recipients
3359 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
3360 (except as warnings), so use check_invoicing_list first.
3361
3362 Returns a list of email addresses (with svcnum entries expanded).
3363
3364 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
3365 check it without disturbing anything by passing nothing.
3366
3367 This interface may change in the future.
3368
3369 =cut
3370
3371 sub invoicing_list {
3372   my( $self, $arrayref ) = @_;
3373
3374   if ( $arrayref ) {
3375     my @cust_main_invoice;
3376     if ( $self->custnum ) {
3377       @cust_main_invoice =
3378         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3379     } else {
3380       @cust_main_invoice = ();
3381     }
3382     foreach my $cust_main_invoice ( @cust_main_invoice ) {
3383       #warn $cust_main_invoice->destnum;
3384       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3385         #warn $cust_main_invoice->destnum;
3386         my $error = $cust_main_invoice->delete;
3387         warn $error if $error;
3388       }
3389     }
3390     if ( $self->custnum ) {
3391       @cust_main_invoice =
3392         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3393     } else {
3394       @cust_main_invoice = ();
3395     }
3396     my %seen = map { $_->address => 1 } @cust_main_invoice;
3397     foreach my $address ( @{$arrayref} ) {
3398       next if exists $seen{$address} && $seen{$address};
3399       $seen{$address} = 1;
3400       my $cust_main_invoice = new FS::cust_main_invoice ( {
3401         'custnum' => $self->custnum,
3402         'dest'    => $address,
3403       } );
3404       my $error = $cust_main_invoice->insert;
3405       warn $error if $error;
3406     }
3407   }
3408
3409   if ( $self->custnum ) {
3410     map { $_->address }
3411       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3412   } else {
3413     ();
3414   }
3415
3416 }
3417
3418 =item check_invoicing_list ARRAYREF
3419
3420 Checks these arguements as valid input for the invoicing_list method.  If there
3421 is an error, returns the error, otherwise returns false.
3422
3423 =cut
3424
3425 sub check_invoicing_list {
3426   my( $self, $arrayref ) = @_;
3427   foreach my $address ( @{$arrayref} ) {
3428
3429     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3430       return 'Can\'t add FAX invoice destination with a blank FAX number.';
3431     }
3432
3433     my $cust_main_invoice = new FS::cust_main_invoice ( {
3434       'custnum' => $self->custnum,
3435       'dest'    => $address,
3436     } );
3437     my $error = $self->custnum
3438                 ? $cust_main_invoice->check
3439                 : $cust_main_invoice->checkdest
3440     ;
3441     return $error if $error;
3442   }
3443   '';
3444 }
3445
3446 =item set_default_invoicing_list
3447
3448 Sets the invoicing list to all accounts associated with this customer,
3449 overwriting any previous invoicing list.
3450
3451 =cut
3452
3453 sub set_default_invoicing_list {
3454   my $self = shift;
3455   $self->invoicing_list($self->all_emails);
3456 }
3457
3458 =item all_emails
3459
3460 Returns the email addresses of all accounts provisioned for this customer.
3461
3462 =cut
3463
3464 sub all_emails {
3465   my $self = shift;
3466   my %list;
3467   foreach my $cust_pkg ( $self->all_pkgs ) {
3468     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3469     my @svc_acct =
3470       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3471         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3472           @cust_svc;
3473     $list{$_}=1 foreach map { $_->email } @svc_acct;
3474   }
3475   keys %list;
3476 }
3477
3478 =item invoicing_list_addpost
3479
3480 Adds postal invoicing to this customer.  If this customer is already configured
3481 to receive postal invoices, does nothing.
3482
3483 =cut
3484
3485 sub invoicing_list_addpost {
3486   my $self = shift;
3487   return if grep { $_ eq 'POST' } $self->invoicing_list;
3488   my @invoicing_list = $self->invoicing_list;
3489   push @invoicing_list, 'POST';
3490   $self->invoicing_list(\@invoicing_list);
3491 }
3492
3493 =item invoicing_list_emailonly
3494
3495 Returns the list of email invoice recipients (invoicing_list without non-email
3496 destinations such as POST and FAX).
3497
3498 =cut
3499
3500 sub invoicing_list_emailonly {
3501   my $self = shift;
3502   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3503 }
3504
3505 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3506
3507 Returns an array of customers referred by this customer (referral_custnum set
3508 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3509 customers referred by customers referred by this customer and so on, inclusive.
3510 The default behavior is DEPTH 1 (no recursion).
3511
3512 =cut
3513
3514 sub referral_cust_main {
3515   my $self = shift;
3516   my $depth = @_ ? shift : 1;
3517   my $exclude = @_ ? shift : {};
3518
3519   my @cust_main =
3520     map { $exclude->{$_->custnum}++; $_; }
3521       grep { ! $exclude->{ $_->custnum } }
3522         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3523
3524   if ( $depth > 1 ) {
3525     push @cust_main,
3526       map { $_->referral_cust_main($depth-1, $exclude) }
3527         @cust_main;
3528   }
3529
3530   @cust_main;
3531 }
3532
3533 =item referral_cust_main_ncancelled
3534
3535 Same as referral_cust_main, except only returns customers with uncancelled
3536 packages.
3537
3538 =cut
3539
3540 sub referral_cust_main_ncancelled {
3541   my $self = shift;
3542   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3543 }
3544
3545 =item referral_cust_pkg [ DEPTH ]
3546
3547 Like referral_cust_main, except returns a flat list of all unsuspended (and
3548 uncancelled) packages for each customer.  The number of items in this list may
3549 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3550
3551 =cut
3552
3553 sub referral_cust_pkg {
3554   my $self = shift;
3555   my $depth = @_ ? shift : 1;
3556
3557   map { $_->unsuspended_pkgs }
3558     grep { $_->unsuspended_pkgs }
3559       $self->referral_cust_main($depth);
3560 }
3561
3562 =item referring_cust_main
3563
3564 Returns the single cust_main record for the customer who referred this customer
3565 (referral_custnum), or false.
3566
3567 =cut
3568
3569 sub referring_cust_main {
3570   my $self = shift;
3571   return '' unless $self->referral_custnum;
3572   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3573 }
3574
3575 =item credit AMOUNT, REASON
3576
3577 Applies a credit to this customer.  If there is an error, returns the error,
3578 otherwise returns false.
3579
3580 =cut
3581
3582 sub credit {
3583   my( $self, $amount, $reason ) = @_;
3584   my $cust_credit = new FS::cust_credit {
3585     'custnum' => $self->custnum,
3586     'amount'  => $amount,
3587     'reason'  => $reason,
3588   };
3589   $cust_credit->insert;
3590 }
3591
3592 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3593
3594 Creates a one-time charge for this customer.  If there is an error, returns
3595 the error, otherwise returns false.
3596
3597 =cut
3598
3599 sub charge {
3600   my ( $self, $amount ) = ( shift, shift );
3601   my $pkg      = @_ ? shift : 'One-time charge';
3602   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
3603   my $taxclass = @_ ? shift : '';
3604
3605   local $SIG{HUP} = 'IGNORE';
3606   local $SIG{INT} = 'IGNORE';
3607   local $SIG{QUIT} = 'IGNORE';
3608   local $SIG{TERM} = 'IGNORE';
3609   local $SIG{TSTP} = 'IGNORE';
3610   local $SIG{PIPE} = 'IGNORE';
3611
3612   my $oldAutoCommit = $FS::UID::AutoCommit;
3613   local $FS::UID::AutoCommit = 0;
3614   my $dbh = dbh;
3615
3616   my $part_pkg = new FS::part_pkg ( {
3617     'pkg'      => $pkg,
3618     'comment'  => $comment,
3619     #'setup'    => $amount,
3620     #'recur'    => '0',
3621     'plan'     => 'flat',
3622     'plandata' => "setup_fee=$amount",
3623     'freq'     => 0,
3624     'disabled' => 'Y',
3625     'taxclass' => $taxclass,
3626   } );
3627
3628   my $error = $part_pkg->insert;
3629   if ( $error ) {
3630     $dbh->rollback if $oldAutoCommit;
3631     return $error;
3632   }
3633
3634   my $pkgpart = $part_pkg->pkgpart;
3635   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3636   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3637     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3638     $error = $type_pkgs->insert;
3639     if ( $error ) {
3640       $dbh->rollback if $oldAutoCommit;
3641       return $error;
3642     }
3643   }
3644
3645   my $cust_pkg = new FS::cust_pkg ( {
3646     'custnum' => $self->custnum,
3647     'pkgpart' => $pkgpart,
3648   } );
3649
3650   $error = $cust_pkg->insert;
3651   if ( $error ) {
3652     $dbh->rollback if $oldAutoCommit;
3653     return $error;
3654   }
3655
3656   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3657   '';
3658
3659 }
3660
3661 =item cust_bill
3662
3663 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3664
3665 =cut
3666
3667 sub cust_bill {
3668   my $self = shift;
3669   sort { $a->_date <=> $b->_date }
3670     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3671 }
3672
3673 =item open_cust_bill
3674
3675 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3676 customer.
3677
3678 =cut
3679
3680 sub open_cust_bill {
3681   my $self = shift;
3682   grep { $_->owed > 0 } $self->cust_bill;
3683 }
3684
3685 =item cust_credit
3686
3687 Returns all the credits (see L<FS::cust_credit>) for this customer.
3688
3689 =cut
3690
3691 sub cust_credit {
3692   my $self = shift;
3693   sort { $a->_date <=> $b->_date }
3694     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3695 }
3696
3697 =item cust_pay
3698
3699 Returns all the payments (see L<FS::cust_pay>) for this customer.
3700
3701 =cut
3702
3703 sub cust_pay {
3704   my $self = shift;
3705   sort { $a->_date <=> $b->_date }
3706     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3707 }
3708
3709 =item cust_pay_void
3710
3711 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3712
3713 =cut
3714
3715 sub cust_pay_void {
3716   my $self = shift;
3717   sort { $a->_date <=> $b->_date }
3718     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3719 }
3720
3721
3722 =item cust_refund
3723
3724 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3725
3726 =cut
3727
3728 sub cust_refund {
3729   my $self = shift;
3730   sort { $a->_date <=> $b->_date }
3731     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3732 }
3733
3734 =item select_for_update
3735
3736 Selects this record with the SQL "FOR UPDATE" command.  This can be useful as
3737 a mutex.
3738
3739 =cut
3740
3741 sub select_for_update {
3742   my $self = shift;
3743   qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
3744 }
3745
3746 =item name
3747
3748 Returns a name string for this customer, either "Company (Last, First)" or
3749 "Last, First".
3750
3751 =cut
3752
3753 sub name {
3754   my $self = shift;
3755   my $name = $self->contact;
3756   $name = $self->company. " ($name)" if $self->company;
3757   $name;
3758 }
3759
3760 =item ship_name
3761
3762 Returns a name string for this (service/shipping) contact, either
3763 "Company (Last, First)" or "Last, First".
3764
3765 =cut
3766
3767 sub ship_name {
3768   my $self = shift;
3769   if ( $self->get('ship_last') ) {
3770     my $name = $self->ship_contact;
3771     $name = $self->ship_company. " ($name)" if $self->ship_company;
3772     $name;
3773   } else {
3774     $self->name;
3775   }
3776 }
3777
3778 =item contact
3779
3780 Returns this customer's full (billing) contact name only, "Last, First"
3781
3782 =cut
3783
3784 sub contact {
3785   my $self = shift;
3786   $self->get('last'). ', '. $self->first;
3787 }
3788
3789 =item ship_contact
3790
3791 Returns this customer's full (shipping) contact name only, "Last, First"
3792
3793 =cut
3794
3795 sub ship_contact {
3796   my $self = shift;
3797   $self->get('ship_last')
3798     ? $self->get('ship_last'). ', '. $self->ship_first
3799     : $self->contact;
3800 }
3801
3802 =item country_full
3803
3804 Returns this customer's full country name
3805
3806 =cut
3807
3808 sub country_full {
3809   my $self = shift;
3810   code2country($self->country);
3811 }
3812
3813 =item status
3814
3815 Returns a status string for this customer, currently:
3816
3817 =over 4
3818
3819 =item prospect - No packages have ever been ordered
3820
3821 =item active - One or more recurring packages is active
3822
3823 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
3824
3825 =item suspended - All non-cancelled recurring packages are suspended
3826
3827 =item cancelled - All recurring packages are cancelled
3828
3829 =back
3830
3831 =cut
3832
3833 sub status {
3834   my $self = shift;
3835   for my $status (qw( prospect active inactive suspended cancelled )) {
3836     my $method = $status.'_sql';
3837     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3838     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3839     $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
3840     return $status if $sth->fetchrow_arrayref->[0];
3841   }
3842 }
3843
3844 =item statuscolor
3845
3846 Returns a hex triplet color string for this customer's status.
3847
3848 =cut
3849
3850 use vars qw(%statuscolor);
3851 %statuscolor = (
3852   'prospect'  => '7e0079', #'000000', #black?  naw, purple
3853   'active'    => '00CC00', #green
3854   'inactive'  => '0000CC', #blue
3855   'suspended' => 'FF9900', #yellow
3856   'cancelled' => 'FF0000', #red
3857 );
3858
3859 sub statuscolor {
3860   my $self = shift;
3861   $statuscolor{$self->status};
3862 }
3863
3864 =back
3865
3866 =head1 CLASS METHODS
3867
3868 =over 4
3869
3870 =item prospect_sql
3871
3872 Returns an SQL expression identifying prospective cust_main records (customers
3873 with no packages ever ordered)
3874
3875 =cut
3876
3877 use vars qw($select_count_pkgs);
3878 $select_count_pkgs =
3879   "SELECT COUNT(*) FROM cust_pkg
3880     WHERE cust_pkg.custnum = cust_main.custnum";
3881
3882 sub select_count_pkgs_sql {
3883   $select_count_pkgs;
3884 }
3885
3886 sub prospect_sql { "
3887   0 = ( $select_count_pkgs )
3888 "; }
3889
3890 =item active_sql
3891
3892 Returns an SQL expression identifying active cust_main records (customers with
3893 no active recurring packages, but otherwise unsuspended/uncancelled).
3894
3895 =cut
3896
3897 sub active_sql { "
3898   0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
3899       )
3900 "; }
3901
3902 =item inactive_sql
3903
3904 Returns an SQL expression identifying inactive cust_main records (customers with
3905 active recurring packages).
3906
3907 =cut
3908
3909 sub inactive_sql { "
3910   0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
3911   AND
3912   0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
3913 "; }
3914
3915 =item susp_sql
3916 =item suspended_sql
3917
3918 Returns an SQL expression identifying suspended cust_main records.
3919
3920 =cut
3921
3922
3923 sub suspended_sql { susp_sql(@_); }
3924 sub susp_sql { "
3925     0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
3926     AND
3927     0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
3928 "; }
3929
3930 =item cancel_sql
3931 =item cancelled_sql
3932
3933 Returns an SQL expression identifying cancelled cust_main records.
3934
3935 =cut
3936
3937 sub cancelled_sql { cancel_sql(@_); }
3938 sub cancel_sql {
3939
3940   my $recurring_sql = FS::cust_pkg->recurring_sql;
3941   #my $recurring_sql = "
3942   #  '0' != ( select freq from part_pkg
3943   #             where cust_pkg.pkgpart = part_pkg.pkgpart )
3944   #";
3945
3946   "
3947     0 < ( $select_count_pkgs )
3948     AND 0 = ( $select_count_pkgs AND $recurring_sql
3949                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3950             )
3951   ";
3952 }
3953
3954 =item uncancel_sql
3955 =item uncancelled_sql
3956
3957 Returns an SQL expression identifying un-cancelled cust_main records.
3958
3959 =cut
3960
3961 sub uncancelled_sql { uncancel_sql(@_); }
3962 sub uncancel_sql { "
3963   ( 0 < ( $select_count_pkgs
3964                    AND ( cust_pkg.cancel IS NULL
3965                          OR cust_pkg.cancel = 0
3966                        )
3967         )
3968     OR 0 = ( $select_count_pkgs )
3969   )
3970 "; }
3971
3972 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3973
3974 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3975 records.  Currently, I<first>, I<last> and/or I<company> may be specified (the
3976 appropriate ship_ field is also searched).
3977
3978 Additional options are the same as FS::Record::qsearch
3979
3980 =cut
3981
3982 sub fuzzy_search {
3983   my( $self, $fuzzy, $hash, @opt) = @_;
3984   #$self
3985   $hash ||= {};
3986   my @cust_main = ();
3987
3988   check_and_rebuild_fuzzyfiles();
3989   foreach my $field ( keys %$fuzzy ) {
3990
3991     my $all = $self->all_X($field);
3992     next unless scalar(@$all);
3993
3994     my %match = ();
3995     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
3996
3997     my @fcust = ();
3998     foreach ( keys %match ) {
3999       push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
4000       push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
4001     }
4002     my %fsaw = ();
4003     push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
4004   }
4005
4006   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
4007   my %saw = ();
4008   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
4009
4010   @cust_main;
4011
4012 }
4013
4014 =back
4015
4016 =head1 SUBROUTINES
4017
4018 =over 4
4019
4020 =item smart_search OPTION => VALUE ...
4021
4022 Accepts the following options: I<search>, the string to search for.  The string
4023 will be searched for as a customer number, phone number, name or company name,
4024 as an exact, or, in some cases, a substring or fuzzy match (see the source code
4025 for the exact heuristics used).
4026
4027 Any additional options are treated as an additional qualifier on the search
4028 (i.e. I<agentnum>).
4029
4030 Returns a (possibly empty) array of FS::cust_main objects.
4031
4032 =cut
4033
4034 sub smart_search {
4035   my %options = @_;
4036
4037   #here is the agent virtualization
4038   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
4039
4040   my @cust_main = ();
4041
4042   my $search = delete $options{'search'};
4043   ( my $alphanum_search = $search ) =~ s/\W//g;
4044
4045   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
4046
4047     #false laziness w/Record::ut_phone
4048     my $phonen = "$1-$2-$3";
4049     $phonen .= " x$4" if $4;
4050
4051     push @cust_main, qsearch( {
4052       'table'   => 'cust_main',
4053       'hashref' => { %options },
4054       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
4055                      ' ( '.
4056                          join(' OR ', map "$_ = '$phonen'",
4057                                           qw( daytime night fax
4058                                               ship_daytime ship_night ship_fax )
4059                              ).
4060                      ' ) '.
4061                      " AND $agentnums_sql", #agent virtualization
4062     } );
4063
4064     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
4065       #try looking for matches with extensions unless one was specified
4066
4067       push @cust_main, qsearch( {
4068         'table'   => 'cust_main',
4069         'hashref' => { %options },
4070         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
4071                        ' ( '.
4072                            join(' OR ', map "$_ LIKE '$phonen\%'",
4073                                             qw( daytime night
4074                                                 ship_daytime ship_night )
4075                                ).
4076                        ' ) '.
4077                        " AND $agentnums_sql", #agent virtualization
4078       } );
4079
4080     }
4081
4082   } elsif ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
4083
4084     push @cust_main, qsearch( {
4085       'table'     => 'cust_main',
4086       'hashref'   => { 'custnum' => $1, %options },
4087       'extra_sql' => " AND $agentnums_sql", #agent virtualization
4088     } );
4089
4090   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
4091
4092     my($company, $last, $first) = ( $1, $2, $3 );
4093
4094     # "Company (Last, First)"
4095     #this is probably something a browser remembered,
4096     #so just do an exact search
4097
4098     foreach my $prefix ( '', 'ship_' ) {
4099       push @cust_main, qsearch( {
4100         'table'     => 'cust_main',
4101         'hashref'   => { $prefix.'first'   => $first,
4102                          $prefix.'last'    => $last,
4103                          $prefix.'company' => $company,
4104                          %options,
4105                        },
4106         'extra_sql' => " AND $agentnums_sql",
4107       } );
4108     }
4109
4110   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
4111                                               # try (ship_){last,company}
4112
4113     my $value = lc($1);
4114
4115     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
4116     # # full strings the browser remembers won't work
4117     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
4118
4119     use Lingua::EN::NameParse;
4120     my $NameParse = new Lingua::EN::NameParse(
4121              auto_clean     => 1,
4122              allow_reversed => 1,
4123     );
4124
4125     my($last, $first) = ( '', '' );
4126     #maybe disable this too and just rely on NameParse?
4127     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
4128
4129       ($last, $first) = ( $1, $2 );
4130
4131     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
4132     } elsif ( ! $NameParse->parse($value) ) {
4133
4134       my %name = $NameParse->components;
4135       $first = $name{'given_name_1'};
4136       $last  = $name{'surname_1'};
4137
4138     }
4139
4140     if ( $first && $last ) {
4141
4142       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
4143
4144       #exact
4145       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
4146       $sql .= "
4147         (     ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
4148            OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
4149         )";
4150
4151       push @cust_main, qsearch( {
4152         'table'     => 'cust_main',
4153         'hashref'   => \%options,
4154         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
4155       } );
4156
4157       # or it just be something that was typed in... (try that in a sec)
4158
4159     }
4160
4161     my $q_value = dbh->quote($value);
4162
4163     #exact
4164     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
4165     $sql .= " (    LOWER(last)         = $q_value
4166                 OR LOWER(company)      = $q_value
4167                 OR LOWER(ship_last)    = $q_value
4168                 OR LOWER(ship_company) = $q_value
4169               )";
4170
4171     push @cust_main, qsearch( {
4172       'table'     => 'cust_main',
4173       'hashref'   => \%options,
4174       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
4175     } );
4176
4177     #always do substring & fuzzy,
4178     #getting complains searches are not returning enough
4179     #unless ( @cust_main ) {  #no exact match, trying substring/fuzzy
4180
4181       #still some false laziness w/ search/cust_main.cgi
4182
4183       #substring
4184
4185       my @hashrefs = (
4186         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
4187         { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
4188       );
4189
4190       if ( $first && $last ) {
4191
4192         push @hashrefs,
4193           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
4194             'last'         => { op=>'ILIKE', value=>"%$last%" },
4195           },
4196           { 'ship_first'   => { op=>'ILIKE', value=>"%$first%" },
4197             'ship_last'    => { op=>'ILIKE', value=>"%$last%" },
4198           },
4199         ;
4200
4201       } else {
4202
4203         push @hashrefs,
4204           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
4205           { 'ship_last'    => { op=>'ILIKE', value=>"%$value%" }, },
4206         ;
4207       }
4208
4209       foreach my $hashref ( @hashrefs ) {
4210
4211         push @cust_main, qsearch( {
4212           'table'     => 'cust_main',
4213           'hashref'   => { %$hashref,
4214                            %options,
4215                          },
4216           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
4217         } );
4218
4219       }
4220
4221       #fuzzy
4222       my @fuzopts = (
4223         \%options,                #hashref
4224         '',                       #select
4225         " AND $agentnums_sql",    #extra_sql  #agent virtualization
4226       );
4227
4228       if ( $first && $last ) {
4229         push @cust_main, FS::cust_main->fuzzy_search(
4230           { 'last'   => $last,    #fuzzy hashref
4231             'first'  => $first }, #
4232           @fuzopts
4233         );
4234       }
4235       foreach my $field ( 'last', 'company' ) {
4236         push @cust_main,
4237           FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
4238       }
4239
4240     #}
4241
4242     #eliminate duplicates
4243     my %saw = ();
4244     @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
4245
4246   }
4247
4248   @cust_main;
4249
4250 }
4251
4252 =item check_and_rebuild_fuzzyfiles
4253
4254 =cut
4255
4256 use vars qw(@fuzzyfields);
4257 @fuzzyfields = ( 'last', 'first', 'company' );
4258
4259 sub check_and_rebuild_fuzzyfiles {
4260   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4261   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
4262 }
4263
4264 =item rebuild_fuzzyfiles
4265
4266 =cut
4267
4268 sub rebuild_fuzzyfiles {
4269
4270   use Fcntl qw(:flock);
4271
4272   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4273   mkdir $dir, 0700 unless -d $dir;
4274
4275   foreach my $fuzzy ( @fuzzyfields ) {
4276
4277     open(LOCK,">>$dir/cust_main.$fuzzy")
4278       or die "can't open $dir/cust_main.$fuzzy: $!";
4279     flock(LOCK,LOCK_EX)
4280       or die "can't lock $dir/cust_main.$fuzzy: $!";
4281
4282     open (CACHE,">$dir/cust_main.$fuzzy.tmp")
4283       or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
4284
4285     foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
4286       my $sth = dbh->prepare("SELECT $field FROM cust_main".
4287                              " WHERE $field != '' AND $field IS NOT NULL");
4288       $sth->execute or die $sth->errstr;
4289
4290       while ( my $row = $sth->fetchrow_arrayref ) {
4291         print CACHE $row->[0]. "\n";
4292       }
4293
4294     }
4295
4296     close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
4297
4298     rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
4299     close LOCK;
4300   }
4301
4302 }
4303
4304 =item all_X
4305
4306 =cut
4307
4308 sub all_X {
4309   my( $self, $field ) = @_;
4310   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4311   open(CACHE,"<$dir/cust_main.$field")
4312     or die "can't open $dir/cust_main.$field: $!";
4313   my @array = map { chomp; $_; } <CACHE>;
4314   close CACHE;
4315   \@array;
4316 }
4317
4318 =item append_fuzzyfiles LASTNAME COMPANY
4319
4320 =cut
4321
4322 sub append_fuzzyfiles {
4323   #my( $first, $last, $company ) = @_;
4324
4325   &check_and_rebuild_fuzzyfiles;
4326
4327   use Fcntl qw(:flock);
4328
4329   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4330
4331   foreach my $field (qw( first last company )) {
4332     my $value = shift;
4333
4334     if ( $value ) {
4335
4336       open(CACHE,">>$dir/cust_main.$field")
4337         or die "can't open $dir/cust_main.$field: $!";
4338       flock(CACHE,LOCK_EX)
4339         or die "can't lock $dir/cust_main.$field: $!";
4340
4341       print CACHE "$value\n";
4342
4343       flock(CACHE,LOCK_UN)
4344         or die "can't unlock $dir/cust_main.$field: $!";
4345       close CACHE;
4346     }
4347
4348   }
4349
4350   1;
4351 }
4352
4353 =item batch_import
4354
4355 =cut
4356
4357 sub batch_import {
4358   my $param = shift;
4359   #warn join('-',keys %$param);
4360   my $fh = $param->{filehandle};
4361   my $agentnum = $param->{agentnum};
4362
4363   my $refnum = $param->{refnum};
4364   my $pkgpart = $param->{pkgpart};
4365
4366   #my @fields = @{$param->{fields}};
4367   my $format = $param->{'format'};
4368   my @fields;
4369   my $payby;
4370   if ( $format eq 'simple' ) {
4371     @fields = qw( cust_pkg.setup dayphone first last
4372                   address1 address2 city state zip comments );
4373     $payby = 'BILL';
4374   } elsif ( $format eq 'extended' ) {
4375     @fields = qw( agent_custid refnum
4376                   last first address1 address2 city state zip country
4377                   daytime night
4378                   ship_last ship_first ship_address1 ship_address2
4379                   ship_city ship_state ship_zip ship_country
4380                   payinfo paycvv paydate
4381                   invoicing_list
4382                   cust_pkg.pkgpart
4383                   svc_acct.username svc_acct._password
4384                 );
4385     $payby = 'BILL';
4386   } else {
4387     die "unknown format $format";
4388   }
4389
4390   eval "use Text::CSV_XS;";
4391   die $@ if $@;
4392
4393   my $csv = new Text::CSV_XS;
4394   #warn $csv;
4395   #warn $fh;
4396
4397   my $imported = 0;
4398   #my $columns;
4399
4400   local $SIG{HUP} = 'IGNORE';
4401   local $SIG{INT} = 'IGNORE';
4402   local $SIG{QUIT} = 'IGNORE';
4403   local $SIG{TERM} = 'IGNORE';
4404   local $SIG{TSTP} = 'IGNORE';
4405   local $SIG{PIPE} = 'IGNORE';
4406
4407   my $oldAutoCommit = $FS::UID::AutoCommit;
4408   local $FS::UID::AutoCommit = 0;
4409   my $dbh = dbh;
4410
4411   #while ( $columns = $csv->getline($fh) ) {
4412   my $line;
4413   while ( defined($line=<$fh>) ) {
4414
4415     $csv->parse($line) or do {
4416       $dbh->rollback if $oldAutoCommit;
4417       return "can't parse: ". $csv->error_input();
4418     };
4419
4420     my @columns = $csv->fields();
4421     #warn join('-',@columns);
4422
4423     my %cust_main = (
4424       agentnum => $agentnum,
4425       refnum   => $refnum,
4426       country  => $conf->config('countrydefault') || 'US',
4427       payby    => $payby, #default
4428       paydate  => '12/2037', #default
4429     );
4430     my $billtime = time;
4431     my %cust_pkg = ( pkgpart => $pkgpart );
4432     my %svc_acct = ();
4433     foreach my $field ( @fields ) {
4434
4435       if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|expire|cancel)$/ ) {
4436
4437         #$cust_pkg{$1} = str2time( shift @$columns );
4438         if ( $1 eq 'pkgpart' ) {
4439           $cust_pkg{$1} = shift @columns;
4440         } elsif ( $1 eq 'setup' ) {
4441           $billtime = str2time(shift @columns);
4442         } else {
4443           $cust_pkg{$1} = str2time( shift @columns );
4444         }
4445
4446       } elsif ( $field =~ /^svc_acct\.(username|_password)$/ ) {
4447
4448         $svc_acct{$1} = shift @columns;
4449
4450       } else {
4451
4452         #refnum interception
4453         if ( $field eq 'refnum' && $columns[0] !~ /^\s*(\d+)\s*$/ ) {
4454
4455           my $referral = $columns[0];
4456           my %hash = ( 'referral' => $referral,
4457                        'agentnum' => $agentnum,
4458                        'disabled' => '',
4459                      );
4460
4461           my $part_referral = qsearchs('part_referral', \%hash )
4462                               || new FS::part_referral \%hash;
4463
4464           unless ( $part_referral->refnum ) {
4465             my $error = $part_referral->insert;
4466             if ( $error ) {
4467               $dbh->rollback if $oldAutoCommit;
4468               return "can't auto-insert advertising source: $referral: $error";
4469             }
4470           }
4471
4472           $columns[0] = $part_referral->refnum;
4473         }
4474
4475         #$cust_main{$field} = shift @$columns;
4476         $cust_main{$field} = shift @columns;
4477       }
4478     }
4479
4480     $cust_main{'payby'} = 'CARD' if length($cust_main{'payinfo'});
4481
4482     my $invoicing_list = $cust_main{'invoicing_list'}
4483                            ? [ delete $cust_main{'invoicing_list'} ]
4484                            : [];
4485
4486     my $cust_main = new FS::cust_main ( \%cust_main );
4487
4488     use Tie::RefHash;
4489     tie my %hash, 'Tie::RefHash'; #this part is important
4490
4491     if ( $cust_pkg{'pkgpart'} ) {
4492       my $cust_pkg = new FS::cust_pkg ( \%cust_pkg );
4493
4494       my @svc_acct = ();
4495       if ( $svc_acct{'username'} ) {
4496         my $part_pkg = $cust_pkg->part_pkg;
4497         unless ( $part_pkg ) {
4498           $dbh->rollback if $oldAutoCommit;
4499           return "unknown pkgnum ". $cust_pkg{'pkgpart'};
4500         }
4501         $svc_acct{svcpart} = $part_pkg->svcpart( 'svc_acct' );
4502         push @svc_acct, new FS::svc_acct ( \%svc_acct )
4503       }
4504
4505       $hash{$cust_pkg} = \@svc_acct;
4506     }
4507
4508     my $error = $cust_main->insert( \%hash, $invoicing_list );
4509
4510     if ( $error ) {
4511       $dbh->rollback if $oldAutoCommit;
4512       return "can't insert customer for $line: $error";
4513     }
4514
4515     if ( $format eq 'simple' ) {
4516
4517       #false laziness w/bill.cgi
4518       $error = $cust_main->bill( 'time' => $billtime );
4519       if ( $error ) {
4520         $dbh->rollback if $oldAutoCommit;
4521         return "can't bill customer for $line: $error";
4522       }
4523
4524       $cust_main->apply_payments;
4525       $cust_main->apply_credits;
4526
4527       $error = $cust_main->collect();
4528       if ( $error ) {
4529         $dbh->rollback if $oldAutoCommit;
4530         return "can't collect customer for $line: $error";
4531       }
4532
4533     }
4534
4535     $imported++;
4536   }
4537
4538   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4539
4540   return "Empty file!" unless $imported;
4541
4542   ''; #no error
4543
4544 }
4545
4546 =item batch_charge
4547
4548 =cut
4549
4550 sub batch_charge {
4551   my $param = shift;
4552   #warn join('-',keys %$param);
4553   my $fh = $param->{filehandle};
4554   my @fields = @{$param->{fields}};
4555
4556   eval "use Text::CSV_XS;";
4557   die $@ if $@;
4558
4559   my $csv = new Text::CSV_XS;
4560   #warn $csv;
4561   #warn $fh;
4562
4563   my $imported = 0;
4564   #my $columns;
4565
4566   local $SIG{HUP} = 'IGNORE';
4567   local $SIG{INT} = 'IGNORE';
4568   local $SIG{QUIT} = 'IGNORE';
4569   local $SIG{TERM} = 'IGNORE';
4570   local $SIG{TSTP} = 'IGNORE';
4571   local $SIG{PIPE} = 'IGNORE';
4572
4573   my $oldAutoCommit = $FS::UID::AutoCommit;
4574   local $FS::UID::AutoCommit = 0;
4575   my $dbh = dbh;
4576
4577   #while ( $columns = $csv->getline($fh) ) {
4578   my $line;
4579   while ( defined($line=<$fh>) ) {
4580
4581     $csv->parse($line) or do {
4582       $dbh->rollback if $oldAutoCommit;
4583       return "can't parse: ". $csv->error_input();
4584     };
4585
4586     my @columns = $csv->fields();
4587     #warn join('-',@columns);
4588
4589     my %row = ();
4590     foreach my $field ( @fields ) {
4591       $row{$field} = shift @columns;
4592     }
4593
4594     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
4595     unless ( $cust_main ) {
4596       $dbh->rollback if $oldAutoCommit;
4597       return "unknown custnum $row{'custnum'}";
4598     }
4599
4600     if ( $row{'amount'} > 0 ) {
4601       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4602       if ( $error ) {
4603         $dbh->rollback if $oldAutoCommit;
4604         return $error;
4605       }
4606       $imported++;
4607     } elsif ( $row{'amount'} < 0 ) {
4608       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4609                                       $row{'pkg'}                         );
4610       if ( $error ) {
4611         $dbh->rollback if $oldAutoCommit;
4612         return $error;
4613       }
4614       $imported++;
4615     } else {
4616       #hmm?
4617     }
4618
4619   }
4620
4621   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4622
4623   return "Empty file!" unless $imported;
4624
4625   ''; #no error
4626
4627 }
4628
4629 =back
4630
4631 =head1 BUGS
4632
4633 The delete method.
4634
4635 The delete method should possibly take an FS::cust_main object reference
4636 instead of a scalar customer number.
4637
4638 Bill and collect options should probably be passed as references instead of a
4639 list.
4640
4641 There should probably be a configuration file with a list of allowed credit
4642 card types.
4643
4644 No multiple currency support (probably a larger project than just this module).
4645
4646 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4647
4648 Birthdates rely on negative epoch values.
4649
4650 =head1 SEE ALSO
4651
4652 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4653 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4654 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
4655
4656 =cut
4657
4658 1;
4659