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