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