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