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