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