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