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   my $sth = dbh->prepare(
1645     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql"
1646   ) or die dbh->errstr;
1647   $sth->execute($self->custnum) or die $sth->errstr;
1648   $sth->fetchrow_arrayref->[0];
1649 }
1650
1651 =item unsuspend
1652
1653 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1654 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
1655 on success or a list of errors.
1656
1657 =cut
1658
1659 sub unsuspend {
1660   my $self = shift;
1661   grep { $_->unsuspend } $self->suspended_pkgs;
1662 }
1663
1664 =item suspend
1665
1666 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1667
1668 Returns a list: an empty list on success or a list of errors.
1669
1670 =cut
1671
1672 sub suspend {
1673   my $self = shift;
1674   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
1675 }
1676
1677 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1678
1679 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1680 PKGPARTs (see L<FS::part_pkg>).
1681
1682 Returns a list: an empty list on success or a list of errors.
1683
1684 =cut
1685
1686 sub suspend_if_pkgpart {
1687   my $self = shift;
1688   my (@pkgparts, %opt);
1689   if (ref($_[0]) eq 'HASH'){
1690     @pkgparts = @{$_[0]{pkgparts}};
1691     %opt      = %{$_[0]};
1692   }else{
1693     @pkgparts = @_;
1694   }
1695   grep { $_->suspend(%opt) }
1696     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1697       $self->unsuspended_pkgs;
1698 }
1699
1700 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1701
1702 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1703 listed PKGPARTs (see L<FS::part_pkg>).
1704
1705 Returns a list: an empty list on success or a list of errors.
1706
1707 =cut
1708
1709 sub suspend_unless_pkgpart {
1710   my $self = shift;
1711   my (@pkgparts, %opt);
1712   if (ref($_[0]) eq 'HASH'){
1713     @pkgparts = @{$_[0]{pkgparts}};
1714     %opt      = %{$_[0]};
1715   }else{
1716     @pkgparts = @_;
1717   }
1718   grep { $_->suspend(%opt) }
1719     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1720       $self->unsuspended_pkgs;
1721 }
1722
1723 =item cancel [ OPTION => VALUE ... ]
1724
1725 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1726
1727 Available options are: I<quiet>, I<reasonnum>, and I<ban>
1728
1729 I<quiet> can be set true to supress email cancellation notices.
1730
1731 # I<reasonnum> can be set to a cancellation reason (see L<FS::cancel_reason>)
1732
1733 I<ban> can be set true to ban this customer's credit card or ACH information,
1734 if present.
1735
1736 Always returns a list: an empty list on success or a list of errors.
1737
1738 =cut
1739
1740 sub cancel {
1741   my $self = shift;
1742   my %opt = @_;
1743
1744   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1745
1746     #should try decryption (we might have the private key)
1747     # and if not maybe queue a job for the server that does?
1748     return ( "Can't (yet) ban encrypted credit cards" )
1749       if $self->is_encrypted($self->payinfo);
1750
1751     my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1752     my $error = $ban->insert;
1753     return ( $error ) if $error;
1754
1755   }
1756
1757   grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1758 }
1759
1760 sub _banned_pay_hashref {
1761   my $self = shift;
1762
1763   my %payby2ban = (
1764     'CARD' => 'CARD',
1765     'DCRD' => 'CARD',
1766     'CHEK' => 'CHEK',
1767     'DCHK' => 'CHEK'
1768   );
1769
1770   {
1771     'payby'   => $payby2ban{$self->payby},
1772     'payinfo' => md5_base64($self->payinfo),
1773     #don't ever *search* on reason! #'reason'  =>
1774   };
1775 }
1776
1777 =item notes
1778
1779 Returns all notes (see L<FS::cust_main_note>) for this customer.
1780
1781 =cut
1782
1783 sub notes {
1784   my $self = shift;
1785   #order by?
1786   qsearch( 'cust_main_note',
1787            { 'custnum' => $self->custnum },
1788            '',
1789            'ORDER BY _DATE DESC'
1790          );
1791 }
1792
1793 =item agent
1794
1795 Returns the agent (see L<FS::agent>) for this customer.
1796
1797 =cut
1798
1799 sub agent {
1800   my $self = shift;
1801   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1802 }
1803
1804 =item bill OPTIONS
1805
1806 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
1807 conjunction with the collect method.
1808
1809 Options are passed as name-value pairs.
1810
1811 Currently available options are:
1812
1813 resetup - if set true, re-charges setup fees.
1814
1815 time - bills the customer as if it were that time.  Specified as a UNIX
1816 timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and
1817 L<Date::Parse> for conversion functions.  For example:
1818
1819  use Date::Parse;
1820  ...
1821  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1822
1823
1824 If there is an error, returns the error, otherwise returns false.
1825
1826 =cut
1827
1828 sub bill {
1829   my( $self, %options ) = @_;
1830   return '' if $self->payby eq 'COMP';
1831   warn "$me bill customer ". $self->custnum. "\n"
1832     if $DEBUG;
1833
1834   my $time = $options{'time'} || time;
1835
1836   my $error;
1837
1838   #put below somehow?
1839   local $SIG{HUP} = 'IGNORE';
1840   local $SIG{INT} = 'IGNORE';
1841   local $SIG{QUIT} = 'IGNORE';
1842   local $SIG{TERM} = 'IGNORE';
1843   local $SIG{TSTP} = 'IGNORE';
1844   local $SIG{PIPE} = 'IGNORE';
1845
1846   my $oldAutoCommit = $FS::UID::AutoCommit;
1847   local $FS::UID::AutoCommit = 0;
1848   my $dbh = dbh;
1849
1850   $self->select_for_update; #mutex
1851
1852   #create a new invoice
1853   #(we'll remove it later if it doesn't actually need to be generated [contains
1854   # no line items] and we're inside a transaciton so nothing else will see it)
1855   my $cust_bill = new FS::cust_bill ( {
1856     'custnum' => $self->custnum,
1857     '_date'   => $time,
1858     #'charged' => $charged,
1859     'charged' => 0,
1860   } );
1861   $error = $cust_bill->insert;
1862   if ( $error ) {
1863     $dbh->rollback if $oldAutoCommit;
1864     return "can't create invoice for customer #". $self->custnum. ": $error";
1865   }
1866   my $invnum = $cust_bill->invnum;
1867
1868   ###
1869   # find the packages which are due for billing, find out how much they are
1870   # & generate invoice database.
1871   ###
1872
1873   my( $total_setup, $total_recur ) = ( 0, 0 );
1874   my %tax;
1875   my @precommit_hooks = ();
1876
1877   foreach my $cust_pkg (
1878     qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1879   ) {
1880
1881     #NO!! next if $cust_pkg->cancel;
1882     next if $cust_pkg->getfield('cancel');
1883
1884     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
1885
1886     #? to avoid use of uninitialized value errors... ?
1887     $cust_pkg->setfield('bill', '')
1888       unless defined($cust_pkg->bill);
1889
1890     my $part_pkg = $cust_pkg->part_pkg;
1891
1892     my %hash = $cust_pkg->hash;
1893     my $old_cust_pkg = new FS::cust_pkg \%hash;
1894
1895     my @details = ();
1896
1897     ###
1898     # bill setup
1899     ###
1900
1901     my $setup = 0;
1902     if ( !$cust_pkg->setup || $options{'resetup'} ) {
1903
1904       warn "    bill setup\n" if $DEBUG > 1;
1905
1906       $setup = eval { $cust_pkg->calc_setup( $time ) };
1907       if ( $@ ) {
1908         $dbh->rollback if $oldAutoCommit;
1909         return "$@ running calc_setup for $cust_pkg\n";
1910       }
1911
1912       $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1913     }
1914
1915     ###
1916     # bill recurring fee
1917     ###
1918
1919     my $recur = 0;
1920     my $sdate;
1921     if ( $part_pkg->getfield('freq') ne '0' &&
1922          ! $cust_pkg->getfield('susp') &&
1923          ( $cust_pkg->getfield('bill') || 0 ) <= $time
1924     ) {
1925
1926       warn "    bill recur\n" if $DEBUG > 1;
1927
1928       # XXX shared with $recur_prog
1929       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1930
1931       #over two params!  lets at least switch to a hashref for the rest...
1932       my %param = ( 'precommit_hooks' => \@precommit_hooks, );
1933
1934       $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
1935       if ( $@ ) {
1936         $dbh->rollback if $oldAutoCommit;
1937         return "$@ running calc_recur for $cust_pkg\n";
1938       }
1939
1940       #change this bit to use Date::Manip? CAREFUL with timezones (see
1941       # mailing list archive)
1942       my ($sec,$min,$hour,$mday,$mon,$year) =
1943         (localtime($sdate) )[0,1,2,3,4,5];
1944
1945       #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1946       # only for figuring next bill date, nothing else, so, reset $sdate again
1947       # here
1948       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1949       $cust_pkg->last_bill($sdate)
1950         if $cust_pkg->dbdef_table->column('last_bill');
1951
1952       if ( $part_pkg->freq =~ /^\d+$/ ) {
1953         $mon += $part_pkg->freq;
1954         until ( $mon < 12 ) { $mon -= 12; $year++; }
1955       } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1956         my $weeks = $1;
1957         $mday += $weeks * 7;
1958       } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1959         my $days = $1;
1960         $mday += $days;
1961       } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
1962         my $hours = $1;
1963         $hour += $hours;
1964       } else {
1965         $dbh->rollback if $oldAutoCommit;
1966         return "unparsable frequency: ". $part_pkg->freq;
1967       }
1968       $cust_pkg->setfield('bill',
1969         timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1970     }
1971
1972     warn "\$setup is undefined" unless defined($setup);
1973     warn "\$recur is undefined" unless defined($recur);
1974     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1975
1976     ###
1977     # If $cust_pkg has been modified, update it and create cust_bill_pkg records
1978     ###
1979
1980     if ( $cust_pkg->modified ) {
1981
1982       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
1983         if $DEBUG >1;
1984
1985       $error=$cust_pkg->replace($old_cust_pkg);
1986       if ( $error ) { #just in case
1987         $dbh->rollback if $oldAutoCommit;
1988         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1989       }
1990
1991       $setup = sprintf( "%.2f", $setup );
1992       $recur = sprintf( "%.2f", $recur );
1993       if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1994         $dbh->rollback if $oldAutoCommit;
1995         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1996       }
1997       if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1998         $dbh->rollback if $oldAutoCommit;
1999         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
2000       }
2001
2002       if ( $setup != 0 || $recur != 0 ) {
2003
2004         warn "    charges (setup=$setup, recur=$recur); adding line items\n"
2005           if $DEBUG > 1;
2006         my $cust_bill_pkg = new FS::cust_bill_pkg ({
2007           'invnum'  => $invnum,
2008           'pkgnum'  => $cust_pkg->pkgnum,
2009           'setup'   => $setup,
2010           'recur'   => $recur,
2011           'sdate'   => $sdate,
2012           'edate'   => $cust_pkg->bill,
2013           'details' => \@details,
2014         });
2015         $error = $cust_bill_pkg->insert;
2016         if ( $error ) {
2017           $dbh->rollback if $oldAutoCommit;
2018           return "can't create invoice line item for invoice #$invnum: $error";
2019         }
2020         $total_setup += $setup;
2021         $total_recur += $recur;
2022
2023         ###
2024         # handle taxes
2025         ###
2026
2027         unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
2028
2029           my $prefix =
2030             ( $conf->exists('tax-ship_address') && length($self->ship_last) )
2031             ? 'ship_'
2032             : '';
2033           my %taxhash = map { $_ => $self->get("$prefix$_") }
2034                             qw( state county country );
2035
2036           $taxhash{'taxclass'} = $part_pkg->taxclass;
2037
2038           my @taxes = qsearch( 'cust_main_county', \%taxhash );
2039
2040           unless ( @taxes ) {
2041             $taxhash{'taxclass'} = '';
2042             @taxes =  qsearch( 'cust_main_county', \%taxhash );
2043           }
2044
2045           #one more try at a whole-country tax rate
2046           unless ( @taxes ) {
2047             $taxhash{$_} = '' foreach qw( state county );
2048             @taxes =  qsearch( 'cust_main_county', \%taxhash );
2049           }
2050
2051           # maybe eliminate this entirely, along with all the 0% records
2052           unless ( @taxes ) {
2053             $dbh->rollback if $oldAutoCommit;
2054             return
2055               "fatal: can't find tax rate for state/county/country/taxclass ".
2056               join('/', ( map $self->get("$prefix$_"),
2057                               qw(state county country)
2058                         ),
2059                         $part_pkg->taxclass ). "\n";
2060           }
2061
2062           foreach my $tax ( @taxes ) {
2063
2064             my $taxable_charged = 0;
2065             $taxable_charged += $setup
2066               unless $part_pkg->setuptax =~ /^Y$/i
2067                   || $tax->setuptax =~ /^Y$/i;
2068             $taxable_charged += $recur
2069               unless $part_pkg->recurtax =~ /^Y$/i
2070                   || $tax->recurtax =~ /^Y$/i;
2071             next unless $taxable_charged;
2072
2073             if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
2074               #my ($mon,$year) = (localtime($sdate) )[4,5];
2075               my ($mon,$year) = (localtime( $sdate || $cust_bill->_date ) )[4,5];
2076               $mon++;
2077               my $freq = $part_pkg->freq || 1;
2078               if ( $freq !~ /(\d+)$/ ) {
2079                 $dbh->rollback if $oldAutoCommit;
2080                 return "daily/weekly package definitions not (yet?)".
2081                        " compatible with monthly tax exemptions";
2082               }
2083               my $taxable_per_month =
2084                 sprintf("%.2f", $taxable_charged / $freq );
2085
2086               #call the whole thing off if this customer has any old
2087               #exemption records...
2088               my @cust_tax_exempt =
2089                 qsearch( 'cust_tax_exempt' => { custnum=> $self->custnum } );
2090               if ( @cust_tax_exempt ) {
2091                 $dbh->rollback if $oldAutoCommit;
2092                 return
2093                   'this customer still has old-style tax exemption records; '.
2094                   'run bin/fs-migrate-cust_tax_exempt?';
2095               }
2096
2097               foreach my $which_month ( 1 .. $freq ) {
2098
2099                 #maintain the new exemption table now
2100                 my $sql = "
2101                   SELECT SUM(amount)
2102                     FROM cust_tax_exempt_pkg
2103                       LEFT JOIN cust_bill_pkg USING ( billpkgnum )
2104                       LEFT JOIN cust_bill     USING ( invnum     )
2105                     WHERE custnum = ?
2106                       AND taxnum  = ?
2107                       AND year    = ?
2108                       AND month   = ?
2109                 ";
2110                 my $sth = dbh->prepare($sql) or do {
2111                   $dbh->rollback if $oldAutoCommit;
2112                   return "fatal: can't lookup exising exemption: ". dbh->errstr;
2113                 };
2114                 $sth->execute(
2115                   $self->custnum,
2116                   $tax->taxnum,
2117                   1900+$year,
2118                   $mon,
2119                 ) or do {
2120                   $dbh->rollback if $oldAutoCommit;
2121                   return "fatal: can't lookup exising exemption: ". dbh->errstr;
2122                 };
2123                 my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0;
2124
2125                 my $remaining_exemption =
2126                   $tax->exempt_amount - $existing_exemption;
2127                 if ( $remaining_exemption > 0 ) {
2128                   my $addl = $remaining_exemption > $taxable_per_month
2129                     ? $taxable_per_month
2130                     : $remaining_exemption;
2131                   $taxable_charged -= $addl;
2132
2133                   my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( {
2134                     'billpkgnum' => $cust_bill_pkg->billpkgnum,
2135                     'taxnum'     => $tax->taxnum,
2136                     'year'       => 1900+$year,
2137                     'month'      => $mon,
2138                     'amount'     => sprintf("%.2f", $addl ),
2139                   } );
2140                   $error = $cust_tax_exempt_pkg->insert;
2141                   if ( $error ) {
2142                     $dbh->rollback if $oldAutoCommit;
2143                     return "fatal: can't insert cust_tax_exempt_pkg: $error";
2144                   }
2145                 } # if $remaining_exemption > 0
2146
2147                 #++
2148                 $mon++;
2149                 #until ( $mon < 12 ) { $mon -= 12; $year++; }
2150                 until ( $mon < 13 ) { $mon -= 12; $year++; }
2151
2152               } #foreach $which_month
2153
2154             } #if $tax->exempt_amount
2155
2156             $taxable_charged = sprintf( "%.2f", $taxable_charged);
2157
2158             #$tax += $taxable_charged * $cust_main_county->tax / 100
2159             $tax{ $tax->taxname || 'Tax' } +=
2160               $taxable_charged * $tax->tax / 100
2161
2162           } #foreach my $tax ( @taxes )
2163
2164         } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
2165
2166       } #if $setup != 0 || $recur != 0
2167
2168     } #if $cust_pkg->modified
2169
2170   } #foreach my $cust_pkg
2171
2172   unless ( $cust_bill->cust_bill_pkg ) {
2173     $cust_bill->delete; #don't create an invoice w/o line items
2174     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2175     return '';
2176   }
2177
2178   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
2179
2180   foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
2181     my $tax = sprintf("%.2f", $tax{$taxname} );
2182     $charged = sprintf( "%.2f", $charged+$tax );
2183
2184     my $cust_bill_pkg = new FS::cust_bill_pkg ({
2185       'invnum'   => $invnum,
2186       'pkgnum'   => 0,
2187       'setup'    => $tax,
2188       'recur'    => 0,
2189       'sdate'    => '',
2190       'edate'    => '',
2191       'itemdesc' => $taxname,
2192     });
2193     $error = $cust_bill_pkg->insert;
2194     if ( $error ) {
2195       $dbh->rollback if $oldAutoCommit;
2196       return "can't create invoice line item for invoice #$invnum: $error";
2197     }
2198     $total_setup += $tax;
2199
2200   }
2201
2202   $cust_bill->charged( sprintf( "%.2f", $total_setup + $total_recur ) );
2203   $error = $cust_bill->replace;
2204   if ( $error ) {
2205     $dbh->rollback if $oldAutoCommit;
2206     return "can't update charged for invoice #$invnum: $error";
2207   }
2208
2209   foreach my $hook ( @precommit_hooks ) {
2210     eval {
2211       &{$hook}; #($self) ?
2212     };
2213     if ( $@ ) {
2214       $dbh->rollback if $oldAutoCommit;
2215       return "$@ running precommit hook $hook\n";
2216     }
2217   }
2218
2219   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2220   ''; #no error
2221 }
2222
2223 =item collect OPTIONS
2224
2225 (Attempt to) collect money for this customer's outstanding invoices (see
2226 L<FS::cust_bill>).  Usually used after the bill method.
2227
2228 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
2229 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
2230 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
2231
2232 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
2233 and the invoice events web interface.
2234
2235 If there is an error, returns the error, otherwise returns false.
2236
2237 Options are passed as name-value pairs.
2238
2239 Currently available options are:
2240
2241 invoice_time - Use this time when deciding when to print invoices and
2242 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>
2243 for conversion functions.
2244
2245 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
2246 events.
2247
2248 quiet - set true to surpress email card/ACH decline notices.
2249
2250 freq - "1d" for the traditional, daily events (the default), or "1m" for the
2251 new monthly events
2252
2253 payby - allows for one time override of normal customer billing method
2254
2255 =cut
2256
2257 sub collect {
2258   my( $self, %options ) = @_;
2259   my $invoice_time = $options{'invoice_time'} || time;
2260
2261   #put below somehow?
2262   local $SIG{HUP} = 'IGNORE';
2263   local $SIG{INT} = 'IGNORE';
2264   local $SIG{QUIT} = 'IGNORE';
2265   local $SIG{TERM} = 'IGNORE';
2266   local $SIG{TSTP} = 'IGNORE';
2267   local $SIG{PIPE} = 'IGNORE';
2268
2269   my $oldAutoCommit = $FS::UID::AutoCommit;
2270   local $FS::UID::AutoCommit = 0;
2271   my $dbh = dbh;
2272
2273   $self->select_for_update; #mutex
2274
2275   my $balance = $self->balance;
2276   warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2277     if $DEBUG;
2278   unless ( $balance > 0 ) { #redundant?????
2279     $dbh->rollback if $oldAutoCommit; #hmm
2280     return '';
2281   }
2282
2283   if ( exists($options{'retry_card'}) ) {
2284     carp 'retry_card option passed to collect is deprecated; use retry';
2285     $options{'retry'} ||= $options{'retry_card'};
2286   }
2287   if ( exists($options{'retry'}) && $options{'retry'} ) {
2288     my $error = $self->retry_realtime;
2289     if ( $error ) {
2290       $dbh->rollback if $oldAutoCommit;
2291       return $error;
2292     }
2293   }
2294
2295   my $extra_sql = '';
2296   if ( defined $options{'freq'} && $options{'freq'} eq '1m' ) {
2297     $extra_sql = " AND freq = '1m' ";
2298   } else {
2299     $extra_sql = " AND ( freq = '1d' OR freq IS NULL OR freq = '' ) ";
2300   }
2301
2302   foreach my $cust_bill ( $self->open_cust_bill ) {
2303
2304     # don't try to charge for the same invoice if it's already in a batch
2305     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
2306
2307     last if $self->balance <= 0;
2308
2309     warn "  invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n"
2310       if $DEBUG > 1;
2311
2312     foreach my $part_bill_event ( due_events ( $cust_bill,
2313                                                exists($options{'payby'})
2314                                                  ? $options{'payby'}
2315                                                  : $self->payby,
2316                                                $invoice_time,
2317                                                $extra_sql ) ) {
2318
2319       last if $cust_bill->owed <= 0  # don't run subsequent events if owed<=0
2320            || $self->balance   <= 0; # or if balance<=0
2321
2322       {
2323         local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2324         warn "  do_event " .  $cust_bill . " ". (%options) .  "\n"
2325           if $DEBUG > 1;
2326
2327         if (my $error = $part_bill_event->do_event($cust_bill, %options)) {
2328           # gah, even with transactions.
2329           $dbh->commit if $oldAutoCommit; #well.
2330           return $error;
2331         }
2332       }
2333
2334     }
2335
2336   }
2337
2338   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2339   '';
2340
2341 }
2342
2343 =item retry_realtime
2344
2345 Schedules realtime / batch  credit card / electronic check / LEC billing
2346 events for for retry.  Useful if card information has changed or manual
2347 retry is desired.  The 'collect' method must be called to actually retry
2348 the transaction.
2349
2350 Implementation details: For each of this customer's open invoices, changes
2351 the status of the first "done" (with statustext error) realtime processing
2352 event to "failed".
2353
2354 =cut
2355
2356 sub retry_realtime {
2357   my $self = shift;
2358
2359   local $SIG{HUP} = 'IGNORE';
2360   local $SIG{INT} = 'IGNORE';
2361   local $SIG{QUIT} = 'IGNORE';
2362   local $SIG{TERM} = 'IGNORE';
2363   local $SIG{TSTP} = 'IGNORE';
2364   local $SIG{PIPE} = 'IGNORE';
2365
2366   my $oldAutoCommit = $FS::UID::AutoCommit;
2367   local $FS::UID::AutoCommit = 0;
2368   my $dbh = dbh;
2369
2370   foreach my $cust_bill (
2371     grep { $_->cust_bill_event }
2372       $self->open_cust_bill
2373   ) {
2374     my @cust_bill_event =
2375       sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
2376         grep {
2377                #$_->part_bill_event->plan eq 'realtime-card'
2378                $_->part_bill_event->eventcode =~
2379                    /\$cust_bill\->(batch|realtime)_(card|ach|lec)/
2380                  && $_->status eq 'done'
2381                  && $_->statustext
2382              }
2383           $cust_bill->cust_bill_event;
2384     next unless @cust_bill_event;
2385     my $error = $cust_bill_event[0]->retry;
2386     if ( $error ) {
2387       $dbh->rollback if $oldAutoCommit;
2388       return "error scheduling invoice event for retry: $error";
2389     }
2390
2391   }
2392
2393   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2394   '';
2395
2396 }
2397
2398 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
2399
2400 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
2401 via a Business::OnlinePayment realtime gateway.  See
2402 L<http://420.am/business-onlinepayment> for supported gateways.
2403
2404 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2405
2406 Available options are: I<description>, I<invnum>, I<quiet>
2407
2408 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2409 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2410 if set, will override the value from the customer record.
2411
2412 I<description> is a free-text field passed to the gateway.  It defaults to
2413 "Internet services".
2414
2415 If an I<invnum> is specified, this payment (if successful) is applied to the
2416 specified invoice.  If you don't specify an I<invnum> you might want to
2417 call the B<apply_payments> method.
2418
2419 I<quiet> can be set true to surpress email decline notices.
2420
2421 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
2422
2423 =cut
2424
2425 sub realtime_bop {
2426   my( $self, $method, $amount, %options ) = @_;
2427   if ( $DEBUG ) {
2428     warn "$me realtime_bop: $method $amount\n";
2429     warn "  $_ => $options{$_}\n" foreach keys %options;
2430   }
2431
2432   $options{'description'} ||= 'Internet services';
2433
2434   eval "use Business::OnlinePayment";
2435   die $@ if $@;
2436
2437   my $payinfo = exists($options{'payinfo'})
2438                   ? $options{'payinfo'}
2439                   : $self->payinfo;
2440
2441   ###
2442   # select a gateway
2443   ###
2444
2445   my $taxclass = '';
2446   if ( $options{'invnum'} ) {
2447     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
2448     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
2449     my @taxclasses =
2450       map  { $_->part_pkg->taxclass }
2451       grep { $_ }
2452       map  { $_->cust_pkg }
2453       $cust_bill->cust_bill_pkg;
2454     unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
2455                                                            #different taxclasses
2456       $taxclass = $taxclasses[0];
2457     }
2458   }
2459
2460   #look for an agent gateway override first
2461   my $cardtype;
2462   if ( $method eq 'CC' ) {
2463     $cardtype = cardtype($payinfo);
2464   } elsif ( $method eq 'ECHECK' ) {
2465     $cardtype = 'ACH';
2466   } else {
2467     $cardtype = $method;
2468   }
2469
2470   my $override =
2471        qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2472                                            cardtype => $cardtype,
2473                                            taxclass => $taxclass,       } )
2474     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2475                                            cardtype => '',
2476                                            taxclass => $taxclass,       } )
2477     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2478                                            cardtype => $cardtype,
2479                                            taxclass => '',              } )
2480     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2481                                            cardtype => '',
2482                                            taxclass => '',              } );
2483
2484   my $payment_gateway = '';
2485   my( $processor, $login, $password, $action, @bop_options );
2486   if ( $override ) { #use a payment gateway override
2487
2488     $payment_gateway = $override->payment_gateway;
2489
2490     $processor   = $payment_gateway->gateway_module;
2491     $login       = $payment_gateway->gateway_username;
2492     $password    = $payment_gateway->gateway_password;
2493     $action      = $payment_gateway->gateway_action;
2494     @bop_options = $payment_gateway->options;
2495
2496   } else { #use the standard settings from the config
2497
2498     ( $processor, $login, $password, $action, @bop_options ) =
2499       $self->default_payment_gateway($method);
2500
2501   }
2502
2503   ###
2504   # massage data
2505   ###
2506
2507   my $address = exists($options{'address1'})
2508                     ? $options{'address1'}
2509                     : $self->address1;
2510   my $address2 = exists($options{'address2'})
2511                     ? $options{'address2'}
2512                     : $self->address2;
2513   $address .= ", ". $address2 if length($address2);
2514
2515   my $o_payname = exists($options{'payname'})
2516                     ? $options{'payname'}
2517                     : $self->payname;
2518   my($payname, $payfirst, $paylast);
2519   if ( $o_payname && $method ne 'ECHECK' ) {
2520     ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2521       or return "Illegal payname $payname";
2522     ($payfirst, $paylast) = ($1, $2);
2523   } else {
2524     $payfirst = $self->getfield('first');
2525     $paylast = $self->getfield('last');
2526     $payname =  "$payfirst $paylast";
2527   }
2528
2529   my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
2530   if ( $conf->exists('emailinvoiceauto')
2531        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
2532     push @invoicing_list, $self->all_emails;
2533   }
2534
2535   my $email = ($conf->exists('business-onlinepayment-email-override'))
2536               ? $conf->config('business-onlinepayment-email-override')
2537               : $invoicing_list[0];
2538
2539   my %content = ();
2540
2541   my $payip = exists($options{'payip'})
2542                 ? $options{'payip'}
2543                 : $self->payip;
2544   $content{customer_ip} = $payip
2545     if length($payip);
2546
2547   $content{invoice_number} = $options{'invnum'}
2548     if exists($options{'invnum'}) && length($options{'invnum'});
2549
2550   if ( $method eq 'CC' ) {
2551
2552     $content{card_number} = $payinfo;
2553     my $paydate = exists($options{'paydate'})
2554                     ? $options{'paydate'}
2555                     : $self->paydate;
2556     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2557     $content{expiration} = "$2/$1";
2558
2559     my $paycvv = exists($options{'paycvv'})
2560                    ? $options{'paycvv'}
2561                    : $self->paycvv;
2562     $content{cvv2} = $self->paycvv
2563       if length($paycvv);
2564
2565     my $paystart_month = exists($options{'paystart_month'})
2566                            ? $options{'paystart_month'}
2567                            : $self->paystart_month;
2568
2569     my $paystart_year  = exists($options{'paystart_year'})
2570                            ? $options{'paystart_year'}
2571                            : $self->paystart_year;
2572
2573     $content{card_start} = "$paystart_month/$paystart_year"
2574       if $paystart_month && $paystart_year;
2575
2576     my $payissue       = exists($options{'payissue'})
2577                            ? $options{'payissue'}
2578                            : $self->payissue;
2579     $content{issue_number} = $payissue if $payissue;
2580
2581     $content{recurring_billing} = 'YES'
2582       if qsearch('cust_pay', { 'custnum' => $self->custnum,
2583                                'payby'   => 'CARD',
2584                                'payinfo' => $payinfo,
2585                              } )
2586       || qsearch('cust_pay', { 'custnum' => $self->custnum,
2587                                'payby'   => 'CARD',
2588                                'paymask' => $self->mask_payinfo('CARD', $payinfo),
2589                              } );
2590
2591
2592   } elsif ( $method eq 'ECHECK' ) {
2593     ( $content{account_number}, $content{routing_code} ) =
2594       split('@', $payinfo);
2595     $content{bank_name} = $o_payname;
2596     $content{account_type} = 'CHECKING';
2597     $content{account_name} = $payname;
2598     $content{customer_org} = $self->company ? 'B' : 'I';
2599     $content{customer_ssn} = exists($options{'ss'})
2600                                ? $options{'ss'}
2601                                : $self->ss;
2602   } elsif ( $method eq 'LEC' ) {
2603     $content{phone} = $payinfo;
2604   }
2605
2606   ###
2607   # run transaction(s)
2608   ###
2609
2610   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
2611
2612   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
2613   $transaction->content(
2614     'type'           => $method,
2615     'login'          => $login,
2616     'password'       => $password,
2617     'action'         => $action1,
2618     'description'    => $options{'description'},
2619     'amount'         => $amount,
2620     #'invoice_number' => $options{'invnum'},
2621     'customer_id'    => $self->custnum,
2622     'last_name'      => $paylast,
2623     'first_name'     => $payfirst,
2624     'name'           => $payname,
2625     'address'        => $address,
2626     'city'           => ( exists($options{'city'})
2627                             ? $options{'city'}
2628                             : $self->city          ),
2629     'state'          => ( exists($options{'state'})
2630                             ? $options{'state'}
2631                             : $self->state          ),
2632     'zip'            => ( exists($options{'zip'})
2633                             ? $options{'zip'}
2634                             : $self->zip          ),
2635     'country'        => ( exists($options{'country'})
2636                             ? $options{'country'}
2637                             : $self->country          ),
2638     'referer'        => 'http://cleanwhisker.420.am/',
2639     'email'          => $email,
2640     'phone'          => $self->daytime || $self->night,
2641     %content, #after
2642   );
2643   $transaction->submit();
2644
2645   if ( $transaction->is_success() && $action2 ) {
2646     my $auth = $transaction->authorization;
2647     my $ordernum = $transaction->can('order_number')
2648                    ? $transaction->order_number
2649                    : '';
2650
2651     my $capture =
2652       new Business::OnlinePayment( $processor, @bop_options );
2653
2654     my %capture = (
2655       %content,
2656       type           => $method,
2657       action         => $action2,
2658       login          => $login,
2659       password       => $password,
2660       order_number   => $ordernum,
2661       amount         => $amount,
2662       authorization  => $auth,
2663       description    => $options{'description'},
2664     );
2665
2666     foreach my $field (qw( authorization_source_code returned_ACI
2667                            transaction_identifier validation_code
2668                            transaction_sequence_num local_transaction_date
2669                            local_transaction_time AVS_result_code          )) {
2670       $capture{$field} = $transaction->$field() if $transaction->can($field);
2671     }
2672
2673     $capture->content( %capture );
2674
2675     $capture->submit();
2676
2677     unless ( $capture->is_success ) {
2678       my $e = "Authorization successful but capture failed, custnum #".
2679               $self->custnum. ': '.  $capture->result_code.
2680               ": ". $capture->error_message;
2681       warn $e;
2682       return $e;
2683     }
2684
2685   }
2686
2687   ###
2688   # remove paycvv after initial transaction
2689   ###
2690
2691   #false laziness w/misc/process/payment.cgi - check both to make sure working
2692   # correctly
2693   if ( defined $self->dbdef_table->column('paycvv')
2694        && length($self->paycvv)
2695        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2696   ) {
2697     my $error = $self->remove_cvv;
2698     if ( $error ) {
2699       warn "WARNING: error removing cvv: $error\n";
2700     }
2701   }
2702
2703   ###
2704   # result handling
2705   ###
2706
2707   if ( $transaction->is_success() ) {
2708
2709     my %method2payby = (
2710       'CC'     => 'CARD',
2711       'ECHECK' => 'CHEK',
2712       'LEC'    => 'LECB',
2713     );
2714
2715     my $paybatch = '';
2716     if ( $payment_gateway ) { # agent override
2717       $paybatch = $payment_gateway->gatewaynum. '-';
2718     }
2719
2720     $paybatch .= "$processor:". $transaction->authorization;
2721
2722     $paybatch .= ':'. $transaction->order_number
2723       if $transaction->can('order_number')
2724       && length($transaction->order_number);
2725
2726     my $cust_pay = new FS::cust_pay ( {
2727        'custnum'  => $self->custnum,
2728        'invnum'   => $options{'invnum'},
2729        'paid'     => $amount,
2730        '_date'     => '',
2731        'payby'    => $method2payby{$method},
2732        'payinfo'  => $payinfo,
2733        'paybatch' => $paybatch,
2734     } );
2735     my $error = $cust_pay->insert;
2736     if ( $error ) {
2737       $cust_pay->invnum(''); #try again with no specific invnum
2738       my $error2 = $cust_pay->insert;
2739       if ( $error2 ) {
2740         # gah, even with transactions.
2741         my $e = 'WARNING: Card/ACH debited but database not updated - '.
2742                 "error inserting payment ($processor): $error2".
2743                 " (previously tried insert with invnum #$options{'invnum'}" .
2744                 ": $error )";
2745         warn $e;
2746         return $e;
2747       }
2748     }
2749     return ''; #no error
2750
2751   } else {
2752
2753     my $perror = "$processor error: ". $transaction->error_message;
2754
2755     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2756          && $conf->exists('emaildecline')
2757          && grep { $_ ne 'POST' } $self->invoicing_list
2758          && ! grep { $transaction->error_message =~ /$_/ }
2759                    $conf->config('emaildecline-exclude')
2760     ) {
2761       my @templ = $conf->config('declinetemplate');
2762       my $template = new Text::Template (
2763         TYPE   => 'ARRAY',
2764         SOURCE => [ map "$_\n", @templ ],
2765       ) or return "($perror) can't create template: $Text::Template::ERROR";
2766       $template->compile()
2767         or return "($perror) can't compile template: $Text::Template::ERROR";
2768
2769       my $templ_hash = { error => $transaction->error_message };
2770
2771       my $error = send_email(
2772         'from'    => $conf->config('invoice_from'),
2773         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2774         'subject' => 'Your payment could not be processed',
2775         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
2776       );
2777
2778       $perror .= " (also received error sending decline notification: $error)"
2779         if $error;
2780
2781     }
2782
2783     return $perror;
2784   }
2785
2786 }
2787
2788 =item default_payment_gateway
2789
2790 =cut
2791
2792 sub default_payment_gateway {
2793   my( $self, $method ) = @_;
2794
2795   die "Real-time processing not enabled\n"
2796     unless $conf->exists('business-onlinepayment');
2797
2798   #load up config
2799   my $bop_config = 'business-onlinepayment';
2800   $bop_config .= '-ach'
2801     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2802   my ( $processor, $login, $password, $action, @bop_options ) =
2803     $conf->config($bop_config);
2804   $action ||= 'normal authorization';
2805   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2806   die "No real-time processor is enabled - ".
2807       "did you set the business-onlinepayment configuration value?\n"
2808     unless $processor;
2809
2810   ( $processor, $login, $password, $action, @bop_options )
2811 }
2812
2813 =item remove_cvv
2814
2815 Removes the I<paycvv> field from the database directly.
2816
2817 If there is an error, returns the error, otherwise returns false.
2818
2819 =cut
2820
2821 sub remove_cvv {
2822   my $self = shift;
2823   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2824     or return dbh->errstr;
2825   $sth->execute($self->custnum)
2826     or return $sth->errstr;
2827   $self->paycvv('');
2828   '';
2829 }
2830
2831 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2832
2833 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2834 via a Business::OnlinePayment realtime gateway.  See
2835 L<http://420.am/business-onlinepayment> for supported gateways.
2836
2837 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2838
2839 Available options are: I<amount>, I<reason>, I<paynum>
2840
2841 Most gateways require a reference to an original payment transaction to refund,
2842 so you probably need to specify a I<paynum>.
2843
2844 I<amount> defaults to the original amount of the payment if not specified.
2845
2846 I<reason> specifies a reason for the refund.
2847
2848 Implementation note: If I<amount> is unspecified or equal to the amount of the
2849 orignal payment, first an attempt is made to "void" the transaction via
2850 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2851 the normal attempt is made to "refund" ("credit") the transaction via the
2852 gateway is attempted.
2853
2854 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2855 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2856 #if set, will override the value from the customer record.
2857
2858 #If an I<invnum> is specified, this payment (if successful) is applied to the
2859 #specified invoice.  If you don't specify an I<invnum> you might want to
2860 #call the B<apply_payments> method.
2861
2862 =cut
2863
2864 #some false laziness w/realtime_bop, not enough to make it worth merging
2865 #but some useful small subs should be pulled out
2866 sub realtime_refund_bop {
2867   my( $self, $method, %options ) = @_;
2868   if ( $DEBUG ) {
2869     warn "$me realtime_refund_bop: $method refund\n";
2870     warn "  $_ => $options{$_}\n" foreach keys %options;
2871   }
2872
2873   eval "use Business::OnlinePayment";
2874   die $@ if $@;
2875
2876   ###
2877   # look up the original payment and optionally a gateway for that payment
2878   ###
2879
2880   my $cust_pay = '';
2881   my $amount = $options{'amount'};
2882
2883   my( $processor, $login, $password, @bop_options ) ;
2884   my( $auth, $order_number ) = ( '', '', '' );
2885
2886   if ( $options{'paynum'} ) {
2887
2888     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
2889     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2890       or return "Unknown paynum $options{'paynum'}";
2891     $amount ||= $cust_pay->paid;
2892
2893     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/
2894       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2895                 $cust_pay->paybatch;
2896     my $gatewaynum = '';
2897     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
2898
2899     if ( $gatewaynum ) { #gateway for the payment to be refunded
2900
2901       my $payment_gateway =
2902         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
2903       die "payment gateway $gatewaynum not found"
2904         unless $payment_gateway;
2905
2906       $processor   = $payment_gateway->gateway_module;
2907       $login       = $payment_gateway->gateway_username;
2908       $password    = $payment_gateway->gateway_password;
2909       @bop_options = $payment_gateway->options;
2910
2911     } else { #try the default gateway
2912
2913       my( $conf_processor, $unused_action );
2914       ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
2915         $self->default_payment_gateway($method);
2916
2917       return "processor of payment $options{'paynum'} $processor does not".
2918              " match default processor $conf_processor"
2919         unless $processor eq $conf_processor;
2920
2921     }
2922
2923
2924   } else { # didn't specify a paynum, so look for agent gateway overrides
2925            # like a normal transaction
2926
2927     my $cardtype;
2928     if ( $method eq 'CC' ) {
2929       $cardtype = cardtype($self->payinfo);
2930     } elsif ( $method eq 'ECHECK' ) {
2931       $cardtype = 'ACH';
2932     } else {
2933       $cardtype = $method;
2934     }
2935     my $override =
2936            qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2937                                                cardtype => $cardtype,
2938                                                taxclass => '',              } )
2939         || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2940                                                cardtype => '',
2941                                                taxclass => '',              } );
2942
2943     if ( $override ) { #use a payment gateway override
2944
2945       my $payment_gateway = $override->payment_gateway;
2946
2947       $processor   = $payment_gateway->gateway_module;
2948       $login       = $payment_gateway->gateway_username;
2949       $password    = $payment_gateway->gateway_password;
2950       #$action      = $payment_gateway->gateway_action;
2951       @bop_options = $payment_gateway->options;
2952
2953     } else { #use the standard settings from the config
2954
2955       my $unused_action;
2956       ( $processor, $login, $password, $unused_action, @bop_options ) =
2957         $self->default_payment_gateway($method);
2958
2959     }
2960
2961   }
2962   return "neither amount nor paynum specified" unless $amount;
2963
2964   my %content = (
2965     'type'           => $method,
2966     'login'          => $login,
2967     'password'       => $password,
2968     'order_number'   => $order_number,
2969     'amount'         => $amount,
2970     'referer'        => 'http://cleanwhisker.420.am/',
2971   );
2972   $content{authorization} = $auth
2973     if length($auth); #echeck/ACH transactions have an order # but no auth
2974                       #(at least with authorize.net)
2975
2976   #first try void if applicable
2977   if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2978     warn "  attempting void\n" if $DEBUG > 1;
2979     my $void = new Business::OnlinePayment( $processor, @bop_options );
2980     $void->content( 'action' => 'void', %content );
2981     $void->submit();
2982     if ( $void->is_success ) {
2983       my $error = $cust_pay->void($options{'reason'});
2984       if ( $error ) {
2985         # gah, even with transactions.
2986         my $e = 'WARNING: Card/ACH voided but database not updated - '.
2987                 "error voiding payment: $error";
2988         warn $e;
2989         return $e;
2990       }
2991       warn "  void successful\n" if $DEBUG > 1;
2992       return '';
2993     }
2994   }
2995
2996   warn "  void unsuccessful, trying refund\n"
2997     if $DEBUG > 1;
2998
2999   #massage data
3000   my $address = $self->address1;
3001   $address .= ", ". $self->address2 if $self->address2;
3002
3003   my($payname, $payfirst, $paylast);
3004   if ( $self->payname && $method ne 'ECHECK' ) {
3005     $payname = $self->payname;
3006     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3007       or return "Illegal payname $payname";
3008     ($payfirst, $paylast) = ($1, $2);
3009   } else {
3010     $payfirst = $self->getfield('first');
3011     $paylast = $self->getfield('last');
3012     $payname =  "$payfirst $paylast";
3013   }
3014
3015   my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
3016   if ( $conf->exists('emailinvoiceauto')
3017        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3018     push @invoicing_list, $self->all_emails;
3019   }
3020
3021   my $email = ($conf->exists('business-onlinepayment-email-override'))
3022               ? $conf->config('business-onlinepayment-email-override')
3023               : $invoicing_list[0];
3024
3025   my $payip = exists($options{'payip'})
3026                 ? $options{'payip'}
3027                 : $self->payip;
3028   $content{customer_ip} = $payip
3029     if length($payip);
3030
3031   my $payinfo = '';
3032   if ( $method eq 'CC' ) {
3033
3034     if ( $cust_pay ) {
3035       $content{card_number} = $payinfo = $cust_pay->payinfo;
3036       #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3037       #$content{expiration} = "$2/$1";
3038     } else {
3039       $content{card_number} = $payinfo = $self->payinfo;
3040       $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3041       $content{expiration} = "$2/$1";
3042     }
3043
3044   } elsif ( $method eq 'ECHECK' ) {
3045     ( $content{account_number}, $content{routing_code} ) =
3046       split('@', $payinfo = $self->payinfo);
3047     $content{bank_name} = $self->payname;
3048     $content{account_type} = 'CHECKING';
3049     $content{account_name} = $payname;
3050     $content{customer_org} = $self->company ? 'B' : 'I';
3051     $content{customer_ssn} = $self->ss;
3052   } elsif ( $method eq 'LEC' ) {
3053     $content{phone} = $payinfo = $self->payinfo;
3054   }
3055
3056   #then try refund
3057   my $refund = new Business::OnlinePayment( $processor, @bop_options );
3058   my %sub_content = $refund->content(
3059     'action'         => 'credit',
3060     'customer_id'    => $self->custnum,
3061     'last_name'      => $paylast,
3062     'first_name'     => $payfirst,
3063     'name'           => $payname,
3064     'address'        => $address,
3065     'city'           => $self->city,
3066     'state'          => $self->state,
3067     'zip'            => $self->zip,
3068     'country'        => $self->country,
3069     'email'          => $email,
3070     'phone'          => $self->daytime || $self->night,
3071     %content, #after
3072   );
3073   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
3074     if $DEBUG > 1;
3075   $refund->submit();
3076
3077   return "$processor error: ". $refund->error_message
3078     unless $refund->is_success();
3079
3080   my %method2payby = (
3081     'CC'     => 'CARD',
3082     'ECHECK' => 'CHEK',
3083     'LEC'    => 'LECB',
3084   );
3085
3086   my $paybatch = "$processor:". $refund->authorization;
3087   $paybatch .= ':'. $refund->order_number
3088     if $refund->can('order_number') && $refund->order_number;
3089
3090   while ( $cust_pay && $cust_pay->unappled < $amount ) {
3091     my @cust_bill_pay = $cust_pay->cust_bill_pay;
3092     last unless @cust_bill_pay;
3093     my $cust_bill_pay = pop @cust_bill_pay;
3094     my $error = $cust_bill_pay->delete;
3095     last if $error;
3096   }
3097
3098   my $cust_refund = new FS::cust_refund ( {
3099     'custnum'  => $self->custnum,
3100     'paynum'   => $options{'paynum'},
3101     'refund'   => $amount,
3102     '_date'    => '',
3103     'payby'    => $method2payby{$method},
3104     'payinfo'  => $payinfo,
3105     'paybatch' => $paybatch,
3106     'reason'   => $options{'reason'} || 'card or ACH refund',
3107   } );
3108   my $error = $cust_refund->insert;
3109   if ( $error ) {
3110     $cust_refund->paynum(''); #try again with no specific paynum
3111     my $error2 = $cust_refund->insert;
3112     if ( $error2 ) {
3113       # gah, even with transactions.
3114       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
3115               "error inserting refund ($processor): $error2".
3116               " (previously tried insert with paynum #$options{'paynum'}" .
3117               ": $error )";
3118       warn $e;
3119       return $e;
3120     }
3121   }
3122
3123   ''; #no error
3124
3125 }
3126
3127 =item total_owed
3128
3129 Returns the total owed for this customer on all invoices
3130 (see L<FS::cust_bill/owed>).
3131
3132 =cut
3133
3134 sub total_owed {
3135   my $self = shift;
3136   $self->total_owed_date(2145859200); #12/31/2037
3137 }
3138
3139 =item total_owed_date TIME
3140
3141 Returns the total owed for this customer on all invoices with date earlier than
3142 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
3143 see L<Time::Local> and L<Date::Parse> for conversion functions.
3144
3145 =cut
3146
3147 sub total_owed_date {
3148   my $self = shift;
3149   my $time = shift;
3150   my $total_bill = 0;
3151   foreach my $cust_bill (
3152     grep { $_->_date <= $time }
3153       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3154   ) {
3155     $total_bill += $cust_bill->owed;
3156   }
3157   sprintf( "%.2f", $total_bill );
3158 }
3159
3160 =item apply_credits OPTION => VALUE ...
3161
3162 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
3163 to outstanding invoice balances in chronological order (or reverse
3164 chronological order if the I<order> option is set to B<newest>) and returns the
3165 value of any remaining unapplied credits available for refund (see
3166 L<FS::cust_refund>).
3167
3168 =cut
3169
3170 sub apply_credits {
3171   my $self = shift;
3172   my %opt = @_;
3173
3174   return 0 unless $self->total_credited;
3175
3176   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
3177       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
3178
3179   my @invoices = $self->open_cust_bill;
3180   @invoices = sort { $b->_date <=> $a->_date } @invoices
3181     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
3182
3183   my $credit;
3184   foreach my $cust_bill ( @invoices ) {
3185     my $amount;
3186
3187     if ( !defined($credit) || $credit->credited == 0) {
3188       $credit = pop @credits or last;
3189     }
3190
3191     if ($cust_bill->owed >= $credit->credited) {
3192       $amount=$credit->credited;
3193     }else{
3194       $amount=$cust_bill->owed;
3195     }
3196
3197     my $cust_credit_bill = new FS::cust_credit_bill ( {
3198       'crednum' => $credit->crednum,
3199       'invnum'  => $cust_bill->invnum,
3200       'amount'  => $amount,
3201     } );
3202     my $error = $cust_credit_bill->insert;
3203     die $error if $error;
3204
3205     redo if ($cust_bill->owed > 0);
3206
3207   }
3208
3209   return $self->total_credited;
3210 }
3211
3212 =item apply_payments
3213
3214 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
3215 to outstanding invoice balances in chronological order.
3216
3217  #and returns the value of any remaining unapplied payments.
3218
3219 =cut
3220
3221 sub apply_payments {
3222   my $self = shift;
3223
3224   #return 0 unless
3225
3226   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
3227       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
3228
3229   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
3230       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
3231
3232   my $payment;
3233
3234   foreach my $cust_bill ( @invoices ) {
3235     my $amount;
3236
3237     if ( !defined($payment) || $payment->unapplied == 0 ) {
3238       $payment = pop @payments or last;
3239     }
3240
3241     if ( $cust_bill->owed >= $payment->unapplied ) {
3242       $amount = $payment->unapplied;
3243     } else {
3244       $amount = $cust_bill->owed;
3245     }
3246
3247     my $cust_bill_pay = new FS::cust_bill_pay ( {
3248       'paynum' => $payment->paynum,
3249       'invnum' => $cust_bill->invnum,
3250       'amount' => $amount,
3251     } );
3252     my $error = $cust_bill_pay->insert;
3253     die $error if $error;
3254
3255     redo if ( $cust_bill->owed > 0);
3256
3257   }
3258
3259   return $self->total_unapplied_payments;
3260 }
3261
3262 =item total_credited
3263
3264 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3265 customer.  See L<FS::cust_credit/credited>.
3266
3267 =cut
3268
3269 sub total_credited {
3270   my $self = shift;
3271   my $total_credit = 0;
3272   foreach my $cust_credit ( qsearch('cust_credit', {
3273     'custnum' => $self->custnum,
3274   } ) ) {
3275     $total_credit += $cust_credit->credited;
3276   }
3277   sprintf( "%.2f", $total_credit );
3278 }
3279
3280 =item total_unapplied_payments
3281
3282 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3283 See L<FS::cust_pay/unapplied>.
3284
3285 =cut
3286
3287 sub total_unapplied_payments {
3288   my $self = shift;
3289   my $total_unapplied = 0;
3290   foreach my $cust_pay ( qsearch('cust_pay', {
3291     'custnum' => $self->custnum,
3292   } ) ) {
3293     $total_unapplied += $cust_pay->unapplied;
3294   }
3295   sprintf( "%.2f", $total_unapplied );
3296 }
3297
3298 =item balance
3299
3300 Returns the balance for this customer (total_owed minus total_credited
3301 minus total_unapplied_payments).
3302
3303 =cut
3304
3305 sub balance {
3306   my $self = shift;
3307   sprintf( "%.2f",
3308     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
3309   );
3310 }
3311
3312 =item balance_date TIME
3313
3314 Returns the balance for this customer, only considering invoices with date
3315 earlier than TIME (total_owed_date minus total_credited minus
3316 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
3317 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
3318 functions.
3319
3320 =cut
3321
3322 sub balance_date {
3323   my $self = shift;
3324   my $time = shift;
3325   sprintf( "%.2f",
3326     $self->total_owed_date($time)
3327       - $self->total_credited
3328       - $self->total_unapplied_payments
3329   );
3330 }
3331
3332 =item in_transit_payments
3333
3334 Returns the total of requests for payments for this customer pending in
3335 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
3336
3337 =cut
3338
3339 sub in_transit_payments {
3340   my $self = shift;
3341   my $in_transit_payments = 0;
3342   foreach my $pay_batch ( qsearch('pay_batch', {
3343     'status' => 'I',
3344   } ) ) {
3345     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
3346       'batchnum' => $pay_batch->batchnum,
3347       'custnum' => $self->custnum,
3348     } ) ) {
3349       $in_transit_payments += $cust_pay_batch->amount;
3350     }
3351   }
3352   sprintf( "%.2f", $in_transit_payments );
3353 }
3354
3355 =item paydate_monthyear
3356
3357 Returns a two-element list consisting of the month and year of this customer's
3358 paydate (credit card expiration date for CARD customers)
3359
3360 =cut
3361
3362 sub paydate_monthyear {
3363   my $self = shift;
3364   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3365     ( $2, $1 );
3366   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3367     ( $1, $3 );
3368   } else {
3369     ('', '');
3370   }
3371 }
3372
3373 =item invoicing_list [ ARRAYREF ]
3374
3375 If an arguement is given, sets these email addresses as invoice recipients
3376 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
3377 (except as warnings), so use check_invoicing_list first.
3378
3379 Returns a list of email addresses (with svcnum entries expanded).
3380
3381 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
3382 check it without disturbing anything by passing nothing.
3383
3384 This interface may change in the future.
3385
3386 =cut
3387
3388 sub invoicing_list {
3389   my( $self, $arrayref ) = @_;
3390
3391   if ( $arrayref ) {
3392     my @cust_main_invoice;
3393     if ( $self->custnum ) {
3394       @cust_main_invoice =
3395         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3396     } else {
3397       @cust_main_invoice = ();
3398     }
3399     foreach my $cust_main_invoice ( @cust_main_invoice ) {
3400       #warn $cust_main_invoice->destnum;
3401       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3402         #warn $cust_main_invoice->destnum;
3403         my $error = $cust_main_invoice->delete;
3404         warn $error if $error;
3405       }
3406     }
3407     if ( $self->custnum ) {
3408       @cust_main_invoice =
3409         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3410     } else {
3411       @cust_main_invoice = ();
3412     }
3413     my %seen = map { $_->address => 1 } @cust_main_invoice;
3414     foreach my $address ( @{$arrayref} ) {
3415       next if exists $seen{$address} && $seen{$address};
3416       $seen{$address} = 1;
3417       my $cust_main_invoice = new FS::cust_main_invoice ( {
3418         'custnum' => $self->custnum,
3419         'dest'    => $address,
3420       } );
3421       my $error = $cust_main_invoice->insert;
3422       warn $error if $error;
3423     }
3424   }
3425
3426   if ( $self->custnum ) {
3427     map { $_->address }
3428       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3429   } else {
3430     ();
3431   }
3432
3433 }
3434
3435 =item check_invoicing_list ARRAYREF
3436
3437 Checks these arguements as valid input for the invoicing_list method.  If there
3438 is an error, returns the error, otherwise returns false.
3439
3440 =cut
3441
3442 sub check_invoicing_list {
3443   my( $self, $arrayref ) = @_;
3444   foreach my $address ( @{$arrayref} ) {
3445
3446     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3447       return 'Can\'t add FAX invoice destination with a blank FAX number.';
3448     }
3449
3450     my $cust_main_invoice = new FS::cust_main_invoice ( {
3451       'custnum' => $self->custnum,
3452       'dest'    => $address,
3453     } );
3454     my $error = $self->custnum
3455                 ? $cust_main_invoice->check
3456                 : $cust_main_invoice->checkdest
3457     ;
3458     return $error if $error;
3459   }
3460   '';
3461 }
3462
3463 =item set_default_invoicing_list
3464
3465 Sets the invoicing list to all accounts associated with this customer,
3466 overwriting any previous invoicing list.
3467
3468 =cut
3469
3470 sub set_default_invoicing_list {
3471   my $self = shift;
3472   $self->invoicing_list($self->all_emails);
3473 }
3474
3475 =item all_emails
3476
3477 Returns the email addresses of all accounts provisioned for this customer.
3478
3479 =cut
3480
3481 sub all_emails {
3482   my $self = shift;
3483   my %list;
3484   foreach my $cust_pkg ( $self->all_pkgs ) {
3485     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3486     my @svc_acct =
3487       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3488         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3489           @cust_svc;
3490     $list{$_}=1 foreach map { $_->email } @svc_acct;
3491   }
3492   keys %list;
3493 }
3494
3495 =item invoicing_list_addpost
3496
3497 Adds postal invoicing to this customer.  If this customer is already configured
3498 to receive postal invoices, does nothing.
3499
3500 =cut
3501
3502 sub invoicing_list_addpost {
3503   my $self = shift;
3504   return if grep { $_ eq 'POST' } $self->invoicing_list;
3505   my @invoicing_list = $self->invoicing_list;
3506   push @invoicing_list, 'POST';
3507   $self->invoicing_list(\@invoicing_list);
3508 }
3509
3510 =item invoicing_list_emailonly
3511
3512 Returns the list of email invoice recipients (invoicing_list without non-email
3513 destinations such as POST and FAX).
3514
3515 =cut
3516
3517 sub invoicing_list_emailonly {
3518   my $self = shift;
3519   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3520 }
3521
3522 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3523
3524 Returns an array of customers referred by this customer (referral_custnum set
3525 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3526 customers referred by customers referred by this customer and so on, inclusive.
3527 The default behavior is DEPTH 1 (no recursion).
3528
3529 =cut
3530
3531 sub referral_cust_main {
3532   my $self = shift;
3533   my $depth = @_ ? shift : 1;
3534   my $exclude = @_ ? shift : {};
3535
3536   my @cust_main =
3537     map { $exclude->{$_->custnum}++; $_; }
3538       grep { ! $exclude->{ $_->custnum } }
3539         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3540
3541   if ( $depth > 1 ) {
3542     push @cust_main,
3543       map { $_->referral_cust_main($depth-1, $exclude) }
3544         @cust_main;
3545   }
3546
3547   @cust_main;
3548 }
3549
3550 =item referral_cust_main_ncancelled
3551
3552 Same as referral_cust_main, except only returns customers with uncancelled
3553 packages.
3554
3555 =cut
3556
3557 sub referral_cust_main_ncancelled {
3558   my $self = shift;
3559   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3560 }
3561
3562 =item referral_cust_pkg [ DEPTH ]
3563
3564 Like referral_cust_main, except returns a flat list of all unsuspended (and
3565 uncancelled) packages for each customer.  The number of items in this list may
3566 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3567
3568 =cut
3569
3570 sub referral_cust_pkg {
3571   my $self = shift;
3572   my $depth = @_ ? shift : 1;
3573
3574   map { $_->unsuspended_pkgs }
3575     grep { $_->unsuspended_pkgs }
3576       $self->referral_cust_main($depth);
3577 }
3578
3579 =item referring_cust_main
3580
3581 Returns the single cust_main record for the customer who referred this customer
3582 (referral_custnum), or false.
3583
3584 =cut
3585
3586 sub referring_cust_main {
3587   my $self = shift;
3588   return '' unless $self->referral_custnum;
3589   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3590 }
3591
3592 =item credit AMOUNT, REASON
3593
3594 Applies a credit to this customer.  If there is an error, returns the error,
3595 otherwise returns false.
3596
3597 =cut
3598
3599 sub credit {
3600   my( $self, $amount, $reason ) = @_;
3601   my $cust_credit = new FS::cust_credit {
3602     'custnum' => $self->custnum,
3603     'amount'  => $amount,
3604     'reason'  => $reason,
3605   };
3606   $cust_credit->insert;
3607 }
3608
3609 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3610
3611 Creates a one-time charge for this customer.  If there is an error, returns
3612 the error, otherwise returns false.
3613
3614 =cut
3615
3616 sub charge {
3617   my ( $self, $amount ) = ( shift, shift );
3618   my $pkg      = @_ ? shift : 'One-time charge';
3619   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
3620   my $taxclass = @_ ? shift : '';
3621
3622   local $SIG{HUP} = 'IGNORE';
3623   local $SIG{INT} = 'IGNORE';
3624   local $SIG{QUIT} = 'IGNORE';
3625   local $SIG{TERM} = 'IGNORE';
3626   local $SIG{TSTP} = 'IGNORE';
3627   local $SIG{PIPE} = 'IGNORE';
3628
3629   my $oldAutoCommit = $FS::UID::AutoCommit;
3630   local $FS::UID::AutoCommit = 0;
3631   my $dbh = dbh;
3632
3633   my $part_pkg = new FS::part_pkg ( {
3634     'pkg'      => $pkg,
3635     'comment'  => $comment,
3636     #'setup'    => $amount,
3637     #'recur'    => '0',
3638     'plan'     => 'flat',
3639     'plandata' => "setup_fee=$amount",
3640     'freq'     => 0,
3641     'disabled' => 'Y',
3642     'taxclass' => $taxclass,
3643   } );
3644
3645   my $error = $part_pkg->insert;
3646   if ( $error ) {
3647     $dbh->rollback if $oldAutoCommit;
3648     return $error;
3649   }
3650
3651   my $pkgpart = $part_pkg->pkgpart;
3652   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3653   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3654     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3655     $error = $type_pkgs->insert;
3656     if ( $error ) {
3657       $dbh->rollback if $oldAutoCommit;
3658       return $error;
3659     }
3660   }
3661
3662   my $cust_pkg = new FS::cust_pkg ( {
3663     'custnum' => $self->custnum,
3664     'pkgpart' => $pkgpart,
3665   } );
3666
3667   $error = $cust_pkg->insert;
3668   if ( $error ) {
3669     $dbh->rollback if $oldAutoCommit;
3670     return $error;
3671   }
3672
3673   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3674   '';
3675
3676 }
3677
3678 =item cust_bill
3679
3680 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3681
3682 =cut
3683
3684 sub cust_bill {
3685   my $self = shift;
3686   sort { $a->_date <=> $b->_date }
3687     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3688 }
3689
3690 =item open_cust_bill
3691
3692 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3693 customer.
3694
3695 =cut
3696
3697 sub open_cust_bill {
3698   my $self = shift;
3699   grep { $_->owed > 0 } $self->cust_bill;
3700 }
3701
3702 =item cust_credit
3703
3704 Returns all the credits (see L<FS::cust_credit>) for this customer.
3705
3706 =cut
3707
3708 sub cust_credit {
3709   my $self = shift;
3710   sort { $a->_date <=> $b->_date }
3711     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3712 }
3713
3714 =item cust_pay
3715
3716 Returns all the payments (see L<FS::cust_pay>) for this customer.
3717
3718 =cut
3719
3720 sub cust_pay {
3721   my $self = shift;
3722   sort { $a->_date <=> $b->_date }
3723     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3724 }
3725
3726 =item cust_pay_void
3727
3728 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3729
3730 =cut
3731
3732 sub cust_pay_void {
3733   my $self = shift;
3734   sort { $a->_date <=> $b->_date }
3735     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3736 }
3737
3738
3739 =item cust_refund
3740
3741 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3742
3743 =cut
3744
3745 sub cust_refund {
3746   my $self = shift;
3747   sort { $a->_date <=> $b->_date }
3748     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3749 }
3750
3751 =item select_for_update
3752
3753 Selects this record with the SQL "FOR UPDATE" command.  This can be useful as
3754 a mutex.
3755
3756 =cut
3757
3758 sub select_for_update {
3759   my $self = shift;
3760   qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
3761 }
3762
3763 =item name
3764
3765 Returns a name string for this customer, either "Company (Last, First)" or
3766 "Last, First".
3767
3768 =cut
3769
3770 sub name {
3771   my $self = shift;
3772   my $name = $self->contact;
3773   $name = $self->company. " ($name)" if $self->company;
3774   $name;
3775 }
3776
3777 =item ship_name
3778
3779 Returns a name string for this (service/shipping) contact, either
3780 "Company (Last, First)" or "Last, First".
3781
3782 =cut
3783
3784 sub ship_name {
3785   my $self = shift;
3786   if ( $self->get('ship_last') ) {
3787     my $name = $self->ship_contact;
3788     $name = $self->ship_company. " ($name)" if $self->ship_company;
3789     $name;
3790   } else {
3791     $self->name;
3792   }
3793 }
3794
3795 =item contact
3796
3797 Returns this customer's full (billing) contact name only, "Last, First"
3798
3799 =cut
3800
3801 sub contact {
3802   my $self = shift;
3803   $self->get('last'). ', '. $self->first;
3804 }
3805
3806 =item ship_contact
3807
3808 Returns this customer's full (shipping) contact name only, "Last, First"
3809
3810 =cut
3811
3812 sub ship_contact {
3813   my $self = shift;
3814   $self->get('ship_last')
3815     ? $self->get('ship_last'). ', '. $self->ship_first
3816     : $self->contact;
3817 }
3818
3819 =item country_full
3820
3821 Returns this customer's full country name
3822
3823 =cut
3824
3825 sub country_full {
3826   my $self = shift;
3827   code2country($self->country);
3828 }
3829
3830 =item status
3831
3832 Returns a status string for this customer, currently:
3833
3834 =over 4
3835
3836 =item prospect - No packages have ever been ordered
3837
3838 =item active - One or more recurring packages is active
3839
3840 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
3841
3842 =item suspended - All non-cancelled recurring packages are suspended
3843
3844 =item cancelled - All recurring packages are cancelled
3845
3846 =back
3847
3848 =cut
3849
3850 sub status {
3851   my $self = shift;
3852   for my $status (qw( prospect active inactive suspended cancelled )) {
3853     my $method = $status.'_sql';
3854     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3855     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3856     $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
3857     return $status if $sth->fetchrow_arrayref->[0];
3858   }
3859 }
3860
3861 =item statuscolor
3862
3863 Returns a hex triplet color string for this customer's status.
3864
3865 =cut
3866
3867 use vars qw(%statuscolor);
3868 %statuscolor = (
3869   'prospect'  => '7e0079', #'000000', #black?  naw, purple
3870   'active'    => '00CC00', #green
3871   'inactive'  => '0000CC', #blue
3872   'suspended' => 'FF9900', #yellow
3873   'cancelled' => 'FF0000', #red
3874 );
3875
3876 sub statuscolor {
3877   my $self = shift;
3878   $statuscolor{$self->status};
3879 }
3880
3881 =back
3882
3883 =head1 CLASS METHODS
3884
3885 =over 4
3886
3887 =item prospect_sql
3888
3889 Returns an SQL expression identifying prospective cust_main records (customers
3890 with no packages ever ordered)
3891
3892 =cut
3893
3894 use vars qw($select_count_pkgs);
3895 $select_count_pkgs =
3896   "SELECT COUNT(*) FROM cust_pkg
3897     WHERE cust_pkg.custnum = cust_main.custnum";
3898
3899 sub select_count_pkgs_sql {
3900   $select_count_pkgs;
3901 }
3902
3903 sub prospect_sql { "
3904   0 = ( $select_count_pkgs )
3905 "; }
3906
3907 =item active_sql
3908
3909 Returns an SQL expression identifying active cust_main records (customers with
3910 no active recurring packages, but otherwise unsuspended/uncancelled).
3911
3912 =cut
3913
3914 sub active_sql { "
3915   0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
3916       )
3917 "; }
3918
3919 =item inactive_sql
3920
3921 Returns an SQL expression identifying inactive cust_main records (customers with
3922 active recurring packages).
3923
3924 =cut
3925
3926 sub inactive_sql { "
3927   0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
3928   AND
3929   0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
3930 "; }
3931
3932 =item susp_sql
3933 =item suspended_sql
3934
3935 Returns an SQL expression identifying suspended cust_main records.
3936
3937 =cut
3938
3939
3940 sub suspended_sql { susp_sql(@_); }
3941 sub susp_sql { "
3942     0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
3943     AND
3944     0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
3945 "; }
3946
3947 =item cancel_sql
3948 =item cancelled_sql
3949
3950 Returns an SQL expression identifying cancelled cust_main records.
3951
3952 =cut
3953
3954 sub cancelled_sql { cancel_sql(@_); }
3955 sub cancel_sql {
3956
3957   my $recurring_sql = FS::cust_pkg->recurring_sql;
3958   #my $recurring_sql = "
3959   #  '0' != ( select freq from part_pkg
3960   #             where cust_pkg.pkgpart = part_pkg.pkgpart )
3961   #";
3962
3963   "
3964     0 < ( $select_count_pkgs )
3965     AND 0 = ( $select_count_pkgs AND $recurring_sql
3966                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3967             )
3968   ";
3969 }
3970
3971 =item uncancel_sql
3972 =item uncancelled_sql
3973
3974 Returns an SQL expression identifying un-cancelled cust_main records.
3975
3976 =cut
3977
3978 sub uncancelled_sql { uncancel_sql(@_); }
3979 sub uncancel_sql { "
3980   ( 0 < ( $select_count_pkgs
3981                    AND ( cust_pkg.cancel IS NULL
3982                          OR cust_pkg.cancel = 0
3983                        )
3984         )
3985     OR 0 = ( $select_count_pkgs )
3986   )
3987 "; }
3988
3989 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3990
3991 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3992 records.  Currently, I<first>, I<last> and/or I<company> may be specified (the
3993 appropriate ship_ field is also searched).
3994
3995 Additional options are the same as FS::Record::qsearch
3996
3997 =cut
3998
3999 sub fuzzy_search {
4000   my( $self, $fuzzy, $hash, @opt) = @_;
4001   #$self
4002   $hash ||= {};
4003   my @cust_main = ();
4004
4005   check_and_rebuild_fuzzyfiles();
4006   foreach my $field ( keys %$fuzzy ) {
4007
4008     my $all = $self->all_X($field);
4009     next unless scalar(@$all);
4010
4011     my %match = ();
4012     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
4013
4014     my @fcust = ();
4015     foreach ( keys %match ) {
4016       push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
4017       push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
4018     }
4019     my %fsaw = ();
4020     push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
4021   }
4022
4023   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
4024   my %saw = ();
4025   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
4026
4027   @cust_main;
4028
4029 }
4030
4031 =back
4032
4033 =head1 SUBROUTINES
4034
4035 =over 4
4036
4037 =item smart_search OPTION => VALUE ...
4038
4039 Accepts the following options: I<search>, the string to search for.  The string
4040 will be searched for as a customer number, phone number, name or company name,
4041 as an exact, or, in some cases, a substring or fuzzy match (see the source code
4042 for the exact heuristics used).
4043
4044 Any additional options are treated as an additional qualifier on the search
4045 (i.e. I<agentnum>).
4046
4047 Returns a (possibly empty) array of FS::cust_main objects.
4048
4049 =cut
4050
4051 sub smart_search {
4052   my %options = @_;
4053
4054   #here is the agent virtualization
4055   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
4056
4057   my @cust_main = ();
4058
4059   my $search = delete $options{'search'};
4060   ( my $alphanum_search = $search ) =~ s/\W//g;
4061
4062   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
4063
4064     #false laziness w/Record::ut_phone
4065     my $phonen = "$1-$2-$3";
4066     $phonen .= " x$4" if $4;
4067
4068     push @cust_main, qsearch( {
4069       'table'   => 'cust_main',
4070       'hashref' => { %options },
4071       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
4072                      ' ( '.
4073                          join(' OR ', map "$_ = '$phonen'",
4074                                           qw( daytime night fax
4075                                               ship_daytime ship_night ship_fax )
4076                              ).
4077                      ' ) '.
4078                      " AND $agentnums_sql", #agent virtualization
4079     } );
4080
4081     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
4082       #try looking for matches with extensions unless one was specified
4083
4084       push @cust_main, qsearch( {
4085         'table'   => 'cust_main',
4086         'hashref' => { %options },
4087         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
4088                        ' ( '.
4089                            join(' OR ', map "$_ LIKE '$phonen\%'",
4090                                             qw( daytime night
4091                                                 ship_daytime ship_night )
4092                                ).
4093                        ' ) '.
4094                        " AND $agentnums_sql", #agent virtualization
4095       } );
4096
4097     }
4098
4099   } elsif ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
4100
4101     push @cust_main, qsearch( {
4102       'table'     => 'cust_main',
4103       'hashref'   => { 'custnum' => $1, %options },
4104       'extra_sql' => " AND $agentnums_sql", #agent virtualization
4105     } );
4106
4107   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
4108
4109     my($company, $last, $first) = ( $1, $2, $3 );
4110
4111     # "Company (Last, First)"
4112     #this is probably something a browser remembered,
4113     #so just do an exact search
4114
4115     foreach my $prefix ( '', 'ship_' ) {
4116       push @cust_main, qsearch( {
4117         'table'     => 'cust_main',
4118         'hashref'   => { $prefix.'first'   => $first,
4119                          $prefix.'last'    => $last,
4120                          $prefix.'company' => $company,
4121                          %options,
4122                        },
4123         'extra_sql' => " AND $agentnums_sql",
4124       } );
4125     }
4126
4127   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
4128                                               # try (ship_){last,company}
4129
4130     my $value = lc($1);
4131
4132     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
4133     # # full strings the browser remembers won't work
4134     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
4135
4136     use Lingua::EN::NameParse;
4137     my $NameParse = new Lingua::EN::NameParse(
4138              auto_clean     => 1,
4139              allow_reversed => 1,
4140     );
4141
4142     my($last, $first) = ( '', '' );
4143     #maybe disable this too and just rely on NameParse?
4144     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
4145
4146       ($last, $first) = ( $1, $2 );
4147
4148     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
4149     } elsif ( ! $NameParse->parse($value) ) {
4150
4151       my %name = $NameParse->components;
4152       $first = $name{'given_name_1'};
4153       $last  = $name{'surname_1'};
4154
4155     }
4156
4157     if ( $first && $last ) {
4158
4159       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
4160
4161       #exact
4162       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
4163       $sql .= "
4164         (     ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
4165            OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
4166         )";
4167
4168       push @cust_main, qsearch( {
4169         'table'     => 'cust_main',
4170         'hashref'   => \%options,
4171         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
4172       } );
4173
4174       # or it just be something that was typed in... (try that in a sec)
4175
4176     }
4177
4178     my $q_value = dbh->quote($value);
4179
4180     #exact
4181     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
4182     $sql .= " (    LOWER(last)         = $q_value
4183                 OR LOWER(company)      = $q_value
4184                 OR LOWER(ship_last)    = $q_value
4185                 OR LOWER(ship_company) = $q_value
4186               )";
4187
4188     push @cust_main, qsearch( {
4189       'table'     => 'cust_main',
4190       'hashref'   => \%options,
4191       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
4192     } );
4193
4194     #always do substring & fuzzy,
4195     #getting complains searches are not returning enough
4196     #unless ( @cust_main ) {  #no exact match, trying substring/fuzzy
4197
4198       #still some false laziness w/ search/cust_main.cgi
4199
4200       #substring
4201
4202       my @hashrefs = (
4203         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
4204         { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
4205       );
4206
4207       if ( $first && $last ) {
4208
4209         push @hashrefs,
4210           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
4211             'last'         => { op=>'ILIKE', value=>"%$last%" },
4212           },
4213           { 'ship_first'   => { op=>'ILIKE', value=>"%$first%" },
4214             'ship_last'    => { op=>'ILIKE', value=>"%$last%" },
4215           },
4216         ;
4217
4218       } else {
4219
4220         push @hashrefs,
4221           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
4222           { 'ship_last'    => { op=>'ILIKE', value=>"%$value%" }, },
4223         ;
4224       }
4225
4226       foreach my $hashref ( @hashrefs ) {
4227
4228         push @cust_main, qsearch( {
4229           'table'     => 'cust_main',
4230           'hashref'   => { %$hashref,
4231                            %options,
4232                          },
4233           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
4234         } );
4235
4236       }
4237
4238       #fuzzy
4239       my @fuzopts = (
4240         \%options,                #hashref
4241         '',                       #select
4242         " AND $agentnums_sql",    #extra_sql  #agent virtualization
4243       );
4244
4245       if ( $first && $last ) {
4246         push @cust_main, FS::cust_main->fuzzy_search(
4247           { 'last'   => $last,    #fuzzy hashref
4248             'first'  => $first }, #
4249           @fuzopts
4250         );
4251       }
4252       foreach my $field ( 'last', 'company' ) {
4253         push @cust_main,
4254           FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
4255       }
4256
4257     #}
4258
4259     #eliminate duplicates
4260     my %saw = ();
4261     @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
4262
4263   }
4264
4265   @cust_main;
4266
4267 }
4268
4269 =item check_and_rebuild_fuzzyfiles
4270
4271 =cut
4272
4273 use vars qw(@fuzzyfields);
4274 @fuzzyfields = ( 'last', 'first', 'company' );
4275
4276 sub check_and_rebuild_fuzzyfiles {
4277   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4278   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
4279 }
4280
4281 =item rebuild_fuzzyfiles
4282
4283 =cut
4284
4285 sub rebuild_fuzzyfiles {
4286
4287   use Fcntl qw(:flock);
4288
4289   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4290   mkdir $dir, 0700 unless -d $dir;
4291
4292   foreach my $fuzzy ( @fuzzyfields ) {
4293
4294     open(LOCK,">>$dir/cust_main.$fuzzy")
4295       or die "can't open $dir/cust_main.$fuzzy: $!";
4296     flock(LOCK,LOCK_EX)
4297       or die "can't lock $dir/cust_main.$fuzzy: $!";
4298
4299     open (CACHE,">$dir/cust_main.$fuzzy.tmp")
4300       or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
4301
4302     foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
4303       my $sth = dbh->prepare("SELECT $field FROM cust_main".
4304                              " WHERE $field != '' AND $field IS NOT NULL");
4305       $sth->execute or die $sth->errstr;
4306
4307       while ( my $row = $sth->fetchrow_arrayref ) {
4308         print CACHE $row->[0]. "\n";
4309       }
4310
4311     }
4312
4313     close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
4314
4315     rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
4316     close LOCK;
4317   }
4318
4319 }
4320
4321 =item all_X
4322
4323 =cut
4324
4325 sub all_X {
4326   my( $self, $field ) = @_;
4327   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4328   open(CACHE,"<$dir/cust_main.$field")
4329     or die "can't open $dir/cust_main.$field: $!";
4330   my @array = map { chomp; $_; } <CACHE>;
4331   close CACHE;
4332   \@array;
4333 }
4334
4335 =item append_fuzzyfiles LASTNAME COMPANY
4336
4337 =cut
4338
4339 sub append_fuzzyfiles {
4340   #my( $first, $last, $company ) = @_;
4341
4342   &check_and_rebuild_fuzzyfiles;
4343
4344   use Fcntl qw(:flock);
4345
4346   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4347
4348   foreach my $field (qw( first last company )) {
4349     my $value = shift;
4350
4351     if ( $value ) {
4352
4353       open(CACHE,">>$dir/cust_main.$field")
4354         or die "can't open $dir/cust_main.$field: $!";
4355       flock(CACHE,LOCK_EX)
4356         or die "can't lock $dir/cust_main.$field: $!";
4357
4358       print CACHE "$value\n";
4359
4360       flock(CACHE,LOCK_UN)
4361         or die "can't unlock $dir/cust_main.$field: $!";
4362       close CACHE;
4363     }
4364
4365   }
4366
4367   1;
4368 }
4369
4370 =item batch_import
4371
4372 =cut
4373
4374 sub batch_import {
4375   my $param = shift;
4376   #warn join('-',keys %$param);
4377   my $fh = $param->{filehandle};
4378   my $agentnum = $param->{agentnum};
4379
4380   my $refnum = $param->{refnum};
4381   my $pkgpart = $param->{pkgpart};
4382
4383   #my @fields = @{$param->{fields}};
4384   my $format = $param->{'format'};
4385   my @fields;
4386   my $payby;
4387   if ( $format eq 'simple' ) {
4388     @fields = qw( cust_pkg.setup dayphone first last
4389                   address1 address2 city state zip comments );
4390     $payby = 'BILL';
4391   } elsif ( $format eq 'extended' ) {
4392     @fields = qw( agent_custid refnum
4393                   last first address1 address2 city state zip country
4394                   daytime night
4395                   ship_last ship_first ship_address1 ship_address2
4396                   ship_city ship_state ship_zip ship_country
4397                   payinfo paycvv paydate
4398                   invoicing_list
4399                   cust_pkg.pkgpart
4400                   svc_acct.username svc_acct._password
4401                 );
4402     $payby = 'BILL';
4403   } else {
4404     die "unknown format $format";
4405   }
4406
4407   eval "use Text::CSV_XS;";
4408   die $@ if $@;
4409
4410   my $csv = new Text::CSV_XS;
4411   #warn $csv;
4412   #warn $fh;
4413
4414   my $imported = 0;
4415   #my $columns;
4416
4417   local $SIG{HUP} = 'IGNORE';
4418   local $SIG{INT} = 'IGNORE';
4419   local $SIG{QUIT} = 'IGNORE';
4420   local $SIG{TERM} = 'IGNORE';
4421   local $SIG{TSTP} = 'IGNORE';
4422   local $SIG{PIPE} = 'IGNORE';
4423
4424   my $oldAutoCommit = $FS::UID::AutoCommit;
4425   local $FS::UID::AutoCommit = 0;
4426   my $dbh = dbh;
4427
4428   #while ( $columns = $csv->getline($fh) ) {
4429   my $line;
4430   while ( defined($line=<$fh>) ) {
4431
4432     $csv->parse($line) or do {
4433       $dbh->rollback if $oldAutoCommit;
4434       return "can't parse: ". $csv->error_input();
4435     };
4436
4437     my @columns = $csv->fields();
4438     #warn join('-',@columns);
4439
4440     my %cust_main = (
4441       agentnum => $agentnum,
4442       refnum   => $refnum,
4443       country  => $conf->config('countrydefault') || 'US',
4444       payby    => $payby, #default
4445       paydate  => '12/2037', #default
4446     );
4447     my $billtime = time;
4448     my %cust_pkg = ( pkgpart => $pkgpart );
4449     my %svc_acct = ();
4450     foreach my $field ( @fields ) {
4451
4452       if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|expire|cancel)$/ ) {
4453
4454         #$cust_pkg{$1} = str2time( shift @$columns );
4455         if ( $1 eq 'pkgpart' ) {
4456           $cust_pkg{$1} = shift @columns;
4457         } elsif ( $1 eq 'setup' ) {
4458           $billtime = str2time(shift @columns);
4459         } else {
4460           $cust_pkg{$1} = str2time( shift @columns );
4461         }
4462
4463       } elsif ( $field =~ /^svc_acct\.(username|_password)$/ ) {
4464
4465         $svc_acct{$1} = shift @columns;
4466
4467       } else {
4468
4469         #refnum interception
4470         if ( $field eq 'refnum' && $columns[0] !~ /^\s*(\d+)\s*$/ ) {
4471
4472           my $referral = $columns[0];
4473           my %hash = ( 'referral' => $referral,
4474                        'agentnum' => $agentnum,
4475                        'disabled' => '',
4476                      );
4477
4478           my $part_referral = qsearchs('part_referral', \%hash )
4479                               || new FS::part_referral \%hash;
4480
4481           unless ( $part_referral->refnum ) {
4482             my $error = $part_referral->insert;
4483             if ( $error ) {
4484               $dbh->rollback if $oldAutoCommit;
4485               return "can't auto-insert advertising source: $referral: $error";
4486             }
4487           }
4488
4489           $columns[0] = $part_referral->refnum;
4490         }
4491
4492         #$cust_main{$field} = shift @$columns;
4493         $cust_main{$field} = shift @columns;
4494       }
4495     }
4496
4497     $cust_main{'payby'} = 'CARD' if length($cust_main{'payinfo'});
4498
4499     my $invoicing_list = $cust_main{'invoicing_list'}
4500                            ? [ delete $cust_main{'invoicing_list'} ]
4501                            : [];
4502
4503     my $cust_main = new FS::cust_main ( \%cust_main );
4504
4505     use Tie::RefHash;
4506     tie my %hash, 'Tie::RefHash'; #this part is important
4507
4508     if ( $cust_pkg{'pkgpart'} ) {
4509       my $cust_pkg = new FS::cust_pkg ( \%cust_pkg );
4510
4511       my @svc_acct = ();
4512       if ( $svc_acct{'username'} ) {
4513         my $part_pkg = $cust_pkg->part_pkg;
4514         unless ( $part_pkg ) {
4515           $dbh->rollback if $oldAutoCommit;
4516           return "unknown pkgnum ". $cust_pkg{'pkgpart'};
4517         }
4518         $svc_acct{svcpart} = $part_pkg->svcpart( 'svc_acct' );
4519         push @svc_acct, new FS::svc_acct ( \%svc_acct )
4520       }
4521
4522       $hash{$cust_pkg} = \@svc_acct;
4523     }
4524
4525     my $error = $cust_main->insert( \%hash, $invoicing_list );
4526
4527     if ( $error ) {
4528       $dbh->rollback if $oldAutoCommit;
4529       return "can't insert customer for $line: $error";
4530     }
4531
4532     if ( $format eq 'simple' ) {
4533
4534       #false laziness w/bill.cgi
4535       $error = $cust_main->bill( 'time' => $billtime );
4536       if ( $error ) {
4537         $dbh->rollback if $oldAutoCommit;
4538         return "can't bill customer for $line: $error";
4539       }
4540
4541       $cust_main->apply_payments;
4542       $cust_main->apply_credits;
4543
4544       $error = $cust_main->collect();
4545       if ( $error ) {
4546         $dbh->rollback if $oldAutoCommit;
4547         return "can't collect customer for $line: $error";
4548       }
4549
4550     }
4551
4552     $imported++;
4553   }
4554
4555   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4556
4557   return "Empty file!" unless $imported;
4558
4559   ''; #no error
4560
4561 }
4562
4563 =item batch_charge
4564
4565 =cut
4566
4567 sub batch_charge {
4568   my $param = shift;
4569   #warn join('-',keys %$param);
4570   my $fh = $param->{filehandle};
4571   my @fields = @{$param->{fields}};
4572
4573   eval "use Text::CSV_XS;";
4574   die $@ if $@;
4575
4576   my $csv = new Text::CSV_XS;
4577   #warn $csv;
4578   #warn $fh;
4579
4580   my $imported = 0;
4581   #my $columns;
4582
4583   local $SIG{HUP} = 'IGNORE';
4584   local $SIG{INT} = 'IGNORE';
4585   local $SIG{QUIT} = 'IGNORE';
4586   local $SIG{TERM} = 'IGNORE';
4587   local $SIG{TSTP} = 'IGNORE';
4588   local $SIG{PIPE} = 'IGNORE';
4589
4590   my $oldAutoCommit = $FS::UID::AutoCommit;
4591   local $FS::UID::AutoCommit = 0;
4592   my $dbh = dbh;
4593
4594   #while ( $columns = $csv->getline($fh) ) {
4595   my $line;
4596   while ( defined($line=<$fh>) ) {
4597
4598     $csv->parse($line) or do {
4599       $dbh->rollback if $oldAutoCommit;
4600       return "can't parse: ". $csv->error_input();
4601     };
4602
4603     my @columns = $csv->fields();
4604     #warn join('-',@columns);
4605
4606     my %row = ();
4607     foreach my $field ( @fields ) {
4608       $row{$field} = shift @columns;
4609     }
4610
4611     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
4612     unless ( $cust_main ) {
4613       $dbh->rollback if $oldAutoCommit;
4614       return "unknown custnum $row{'custnum'}";
4615     }
4616
4617     if ( $row{'amount'} > 0 ) {
4618       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4619       if ( $error ) {
4620         $dbh->rollback if $oldAutoCommit;
4621         return $error;
4622       }
4623       $imported++;
4624     } elsif ( $row{'amount'} < 0 ) {
4625       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4626                                       $row{'pkg'}                         );
4627       if ( $error ) {
4628         $dbh->rollback if $oldAutoCommit;
4629         return $error;
4630       }
4631       $imported++;
4632     } else {
4633       #hmm?
4634     }
4635
4636   }
4637
4638   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4639
4640   return "Empty file!" unless $imported;
4641
4642   ''; #no error
4643
4644 }
4645
4646 =back
4647
4648 =head1 BUGS
4649
4650 The delete method.
4651
4652 The delete method should possibly take an FS::cust_main object reference
4653 instead of a scalar customer number.
4654
4655 Bill and collect options should probably be passed as references instead of a
4656 list.
4657
4658 There should probably be a configuration file with a list of allowed credit
4659 card types.
4660
4661 No multiple currency support (probably a larger project than just this module).
4662
4663 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4664
4665 Birthdates rely on negative epoch values.
4666
4667 =head1 SEE ALSO
4668
4669 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4670 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4671 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
4672
4673 =cut
4674
4675 1;
4676