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