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