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>
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 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
2456
2457 =cut
2458
2459 sub realtime_bop {
2460   my( $self, $method, $amount, %options ) = @_;
2461   if ( $DEBUG ) {
2462     warn "$me realtime_bop: $method $amount\n";
2463     warn "  $_ => $options{$_}\n" foreach keys %options;
2464   }
2465
2466   $options{'description'} ||= 'Internet services';
2467
2468   eval "use Business::OnlinePayment";
2469   die $@ if $@;
2470
2471   my $payinfo = exists($options{'payinfo'})
2472                   ? $options{'payinfo'}
2473                   : $self->payinfo;
2474
2475   ###
2476   # select a gateway
2477   ###
2478
2479   my $taxclass = '';
2480   if ( $options{'invnum'} ) {
2481     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
2482     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
2483     my @taxclasses =
2484       map  { $_->part_pkg->taxclass }
2485       grep { $_ }
2486       map  { $_->cust_pkg }
2487       $cust_bill->cust_bill_pkg;
2488     unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
2489                                                            #different taxclasses
2490       $taxclass = $taxclasses[0];
2491     }
2492   }
2493
2494   #look for an agent gateway override first
2495   my $cardtype;
2496   if ( $method eq 'CC' ) {
2497     $cardtype = cardtype($payinfo);
2498   } elsif ( $method eq 'ECHECK' ) {
2499     $cardtype = 'ACH';
2500   } else {
2501     $cardtype = $method;
2502   }
2503
2504   my $override =
2505        qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2506                                            cardtype => $cardtype,
2507                                            taxclass => $taxclass,       } )
2508     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2509                                            cardtype => '',
2510                                            taxclass => $taxclass,       } )
2511     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2512                                            cardtype => $cardtype,
2513                                            taxclass => '',              } )
2514     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2515                                            cardtype => '',
2516                                            taxclass => '',              } );
2517
2518   my $payment_gateway = '';
2519   my( $processor, $login, $password, $action, @bop_options );
2520   if ( $override ) { #use a payment gateway override
2521
2522     $payment_gateway = $override->payment_gateway;
2523
2524     $processor   = $payment_gateway->gateway_module;
2525     $login       = $payment_gateway->gateway_username;
2526     $password    = $payment_gateway->gateway_password;
2527     $action      = $payment_gateway->gateway_action;
2528     @bop_options = $payment_gateway->options;
2529
2530   } else { #use the standard settings from the config
2531
2532     ( $processor, $login, $password, $action, @bop_options ) =
2533       $self->default_payment_gateway($method);
2534
2535   }
2536
2537   ###
2538   # massage data
2539   ###
2540
2541   my $address = exists($options{'address1'})
2542                     ? $options{'address1'}
2543                     : $self->address1;
2544   my $address2 = exists($options{'address2'})
2545                     ? $options{'address2'}
2546                     : $self->address2;
2547   $address .= ", ". $address2 if length($address2);
2548
2549   my $o_payname = exists($options{'payname'})
2550                     ? $options{'payname'}
2551                     : $self->payname;
2552   my($payname, $payfirst, $paylast);
2553   if ( $o_payname && $method ne 'ECHECK' ) {
2554     ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2555       or return "Illegal payname $payname";
2556     ($payfirst, $paylast) = ($1, $2);
2557   } else {
2558     $payfirst = $self->getfield('first');
2559     $paylast = $self->getfield('last');
2560     $payname =  "$payfirst $paylast";
2561   }
2562
2563   my @invoicing_list = $self->invoicing_list_emailonly;
2564   if ( $conf->exists('emailinvoiceautoalways')
2565        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
2566        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
2567     push @invoicing_list, $self->all_emails;
2568   }
2569
2570   my $email = ($conf->exists('business-onlinepayment-email-override'))
2571               ? $conf->config('business-onlinepayment-email-override')
2572               : $invoicing_list[0];
2573
2574   my %content = ();
2575
2576   my $payip = exists($options{'payip'})
2577                 ? $options{'payip'}
2578                 : $self->payip;
2579   $content{customer_ip} = $payip
2580     if length($payip);
2581
2582   $content{invoice_number} = $options{'invnum'}
2583     if exists($options{'invnum'}) && length($options{'invnum'});
2584
2585   my $paydate = '';
2586   if ( $method eq 'CC' ) {
2587
2588     $content{card_number} = $payinfo;
2589     $paydate = exists($options{'paydate'})
2590                     ? $options{'paydate'}
2591                     : $self->paydate;
2592     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2593     $content{expiration} = "$2/$1";
2594
2595     my $paycvv = exists($options{'paycvv'})
2596                    ? $options{'paycvv'}
2597                    : $self->paycvv;
2598     $content{cvv2} = $self->paycvv
2599       if length($paycvv);
2600
2601     my $paystart_month = exists($options{'paystart_month'})
2602                            ? $options{'paystart_month'}
2603                            : $self->paystart_month;
2604
2605     my $paystart_year  = exists($options{'paystart_year'})
2606                            ? $options{'paystart_year'}
2607                            : $self->paystart_year;
2608
2609     $content{card_start} = "$paystart_month/$paystart_year"
2610       if $paystart_month && $paystart_year;
2611
2612     my $payissue       = exists($options{'payissue'})
2613                            ? $options{'payissue'}
2614                            : $self->payissue;
2615     $content{issue_number} = $payissue if $payissue;
2616
2617     $content{recurring_billing} = 'YES'
2618       if qsearch('cust_pay', { 'custnum' => $self->custnum,
2619                                'payby'   => 'CARD',
2620                                'payinfo' => $payinfo,
2621                              } )
2622       || qsearch('cust_pay', { 'custnum' => $self->custnum,
2623                                'payby'   => 'CARD',
2624                                'paymask' => $self->mask_payinfo('CARD', $payinfo),
2625                              } );
2626
2627
2628   } elsif ( $method eq 'ECHECK' ) {
2629     ( $content{account_number}, $content{routing_code} ) =
2630       split('@', $payinfo);
2631     $content{bank_name} = $o_payname;
2632     $content{bank_state} = exists($options{'paystate'})
2633                              ? $options{'paystate'}
2634                              : $self->getfield('paystate');
2635     $content{account_type} = exists($options{'paytype'})
2636                                ? uc($options{'paytype'}) || 'CHECKING'
2637                                : uc($self->getfield('paytype')) || 'CHECKING';
2638     $content{account_name} = $payname;
2639     $content{customer_org} = $self->company ? 'B' : 'I';
2640     $content{state_id}       = exists($options{'stateid'})
2641                                  ? $options{'stateid'}
2642                                  : $self->getfield('stateid');
2643     $content{state_id_state} = exists($options{'stateid_state'})
2644                                  ? $options{'stateid_state'}
2645                                  : $self->getfield('stateid_state');
2646     $content{customer_ssn} = exists($options{'ss'})
2647                                ? $options{'ss'}
2648                                : $self->ss;
2649   } elsif ( $method eq 'LEC' ) {
2650     $content{phone} = $payinfo;
2651   }
2652
2653   ###
2654   # run transaction(s)
2655   ###
2656
2657   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
2658
2659   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
2660   $transaction->content(
2661     'type'           => $method,
2662     'login'          => $login,
2663     'password'       => $password,
2664     'action'         => $action1,
2665     'description'    => $options{'description'},
2666     'amount'         => $amount,
2667     #'invoice_number' => $options{'invnum'},
2668     'customer_id'    => $self->custnum,
2669     'last_name'      => $paylast,
2670     'first_name'     => $payfirst,
2671     'name'           => $payname,
2672     'address'        => $address,
2673     'city'           => ( exists($options{'city'})
2674                             ? $options{'city'}
2675                             : $self->city          ),
2676     'state'          => ( exists($options{'state'})
2677                             ? $options{'state'}
2678                             : $self->state          ),
2679     'zip'            => ( exists($options{'zip'})
2680                             ? $options{'zip'}
2681                             : $self->zip          ),
2682     'country'        => ( exists($options{'country'})
2683                             ? $options{'country'}
2684                             : $self->country          ),
2685     'referer'        => 'http://cleanwhisker.420.am/',
2686     'email'          => $email,
2687     'phone'          => $self->daytime || $self->night,
2688     %content, #after
2689   );
2690   $transaction->submit();
2691
2692   if ( $transaction->is_success() && $action2 ) {
2693     my $auth = $transaction->authorization;
2694     my $ordernum = $transaction->can('order_number')
2695                    ? $transaction->order_number
2696                    : '';
2697
2698     my $capture =
2699       new Business::OnlinePayment( $processor, @bop_options );
2700
2701     my %capture = (
2702       %content,
2703       type           => $method,
2704       action         => $action2,
2705       login          => $login,
2706       password       => $password,
2707       order_number   => $ordernum,
2708       amount         => $amount,
2709       authorization  => $auth,
2710       description    => $options{'description'},
2711     );
2712
2713     foreach my $field (qw( authorization_source_code returned_ACI
2714                            transaction_identifier validation_code
2715                            transaction_sequence_num local_transaction_date
2716                            local_transaction_time AVS_result_code          )) {
2717       $capture{$field} = $transaction->$field() if $transaction->can($field);
2718     }
2719
2720     $capture->content( %capture );
2721
2722     $capture->submit();
2723
2724     unless ( $capture->is_success ) {
2725       my $e = "Authorization successful but capture failed, custnum #".
2726               $self->custnum. ': '.  $capture->result_code.
2727               ": ". $capture->error_message;
2728       warn $e;
2729       return $e;
2730     }
2731
2732   }
2733
2734   ###
2735   # remove paycvv after initial transaction
2736   ###
2737
2738   #false laziness w/misc/process/payment.cgi - check both to make sure working
2739   # correctly
2740   if ( defined $self->dbdef_table->column('paycvv')
2741        && length($self->paycvv)
2742        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2743   ) {
2744     my $error = $self->remove_cvv;
2745     if ( $error ) {
2746       warn "WARNING: error removing cvv: $error\n";
2747     }
2748   }
2749
2750   ###
2751   # result handling
2752   ###
2753
2754   if ( $transaction->is_success() ) {
2755
2756     my %method2payby = (
2757       'CC'     => 'CARD',
2758       'ECHECK' => 'CHEK',
2759       'LEC'    => 'LECB',
2760     );
2761
2762     my $paybatch = '';
2763     if ( $payment_gateway ) { # agent override
2764       $paybatch = $payment_gateway->gatewaynum. '-';
2765     }
2766
2767     $paybatch .= "$processor:". $transaction->authorization;
2768
2769     $paybatch .= ':'. $transaction->order_number
2770       if $transaction->can('order_number')
2771       && length($transaction->order_number);
2772
2773     my $cust_pay = new FS::cust_pay ( {
2774        'custnum'  => $self->custnum,
2775        'invnum'   => $options{'invnum'},
2776        'paid'     => $amount,
2777        '_date'     => '',
2778        'payby'    => $method2payby{$method},
2779        'payinfo'  => $payinfo,
2780        'paybatch' => $paybatch,
2781        'paydate'  => $paydate,
2782     } );
2783     $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
2784
2785     my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
2786
2787     if ( $error ) {
2788       $cust_pay->invnum(''); #try again with no specific invnum
2789       my $error2 = $cust_pay->insert( $options{'manual'} ?
2790                                       ( 'manual' => 1 ) : ()
2791                                     );
2792       if ( $error2 ) {
2793         # gah, even with transactions.
2794         my $e = 'WARNING: Card/ACH debited but database not updated - '.
2795                 "error inserting payment ($processor): $error2".
2796                 " (previously tried insert with invnum #$options{'invnum'}" .
2797                 ": $error )";
2798         warn $e;
2799         return $e;
2800       }
2801     }
2802     return ''; #no error
2803
2804   } else {
2805
2806     my $perror = "$processor error: ". $transaction->error_message;
2807
2808     unless ( $transaction->error_message ) {
2809
2810       my $t_response;
2811       #this should be normalized :/
2812       #
2813       # bad, ad-hoc B:OP:PayflowPro "transaction_response" BS
2814       if ( $transaction->can('param')
2815            && $transaction->param('transaction_response') ) {
2816         $t_response = $transaction->param('transaction_response')
2817
2818       # slightly better, ad-hoc B:OP:TransactionCentral without "param"
2819       } elsif ( $transaction->can('response_page') ) {
2820         $t_response = {
2821                         'page'    => ( $transaction->can('response_page')
2822                                          ? $transaction->response_page
2823                                          : ''
2824                                      ),
2825                         'code'    => ( $transaction->can('response_code')
2826                                          ? $transaction->response_code
2827                                          : ''
2828                                      ),
2829                         'headers' => ( $transaction->can('response_headers')
2830                                          ? $transaction->response_headers
2831                                          : ''
2832                                      ),
2833                       };
2834       } else {
2835         $t_response .=
2836           "No additional debugging information available for $processor";
2837       }
2838
2839       $perror .= "No error_message returned from $processor -- ".
2840                  ( ref($t_response) ? Dumper($t_response) : $t_response );
2841
2842     }
2843
2844     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2845          && $conf->exists('emaildecline')
2846          && grep { $_ ne 'POST' } $self->invoicing_list
2847          && ! grep { $transaction->error_message =~ /$_/ }
2848                    $conf->config('emaildecline-exclude')
2849     ) {
2850       my @templ = $conf->config('declinetemplate');
2851       my $template = new Text::Template (
2852         TYPE   => 'ARRAY',
2853         SOURCE => [ map "$_\n", @templ ],
2854       ) or return "($perror) can't create template: $Text::Template::ERROR";
2855       $template->compile()
2856         or return "($perror) can't compile template: $Text::Template::ERROR";
2857
2858       my $templ_hash = { error => $transaction->error_message };
2859
2860       my $error = send_email(
2861         'from'    => $conf->config('invoice_from'),
2862         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2863         'subject' => 'Your payment could not be processed',
2864         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
2865       );
2866
2867       $perror .= " (also received error sending decline notification: $error)"
2868         if $error;
2869
2870     }
2871
2872     return $perror;
2873   }
2874
2875 }
2876
2877 =item default_payment_gateway
2878
2879 =cut
2880
2881 sub default_payment_gateway {
2882   my( $self, $method ) = @_;
2883
2884   die "Real-time processing not enabled\n"
2885     unless $conf->exists('business-onlinepayment');
2886
2887   #load up config
2888   my $bop_config = 'business-onlinepayment';
2889   $bop_config .= '-ach'
2890     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2891   my ( $processor, $login, $password, $action, @bop_options ) =
2892     $conf->config($bop_config);
2893   $action ||= 'normal authorization';
2894   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2895   die "No real-time processor is enabled - ".
2896       "did you set the business-onlinepayment configuration value?\n"
2897     unless $processor;
2898
2899   ( $processor, $login, $password, $action, @bop_options )
2900 }
2901
2902 =item remove_cvv
2903
2904 Removes the I<paycvv> field from the database directly.
2905
2906 If there is an error, returns the error, otherwise returns false.
2907
2908 =cut
2909
2910 sub remove_cvv {
2911   my $self = shift;
2912   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2913     or return dbh->errstr;
2914   $sth->execute($self->custnum)
2915     or return $sth->errstr;
2916   $self->paycvv('');
2917   '';
2918 }
2919
2920 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2921
2922 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2923 via a Business::OnlinePayment realtime gateway.  See
2924 L<http://420.am/business-onlinepayment> for supported gateways.
2925
2926 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2927
2928 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
2929
2930 Most gateways require a reference to an original payment transaction to refund,
2931 so you probably need to specify a I<paynum>.
2932
2933 I<amount> defaults to the original amount of the payment if not specified.
2934
2935 I<reason> specifies a reason for the refund.
2936
2937 I<paydate> specifies the expiration date for a credit card overriding the
2938 value from the customer record or the payment record. Specified as yyyy-mm-dd
2939
2940 Implementation note: If I<amount> is unspecified or equal to the amount of the
2941 orignal payment, first an attempt is made to "void" the transaction via
2942 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2943 the normal attempt is made to "refund" ("credit") the transaction via the
2944 gateway is attempted.
2945
2946 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2947 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2948 #if set, will override the value from the customer record.
2949
2950 #If an I<invnum> is specified, this payment (if successful) is applied to the
2951 #specified invoice.  If you don't specify an I<invnum> you might want to
2952 #call the B<apply_payments> method.
2953
2954 =cut
2955
2956 #some false laziness w/realtime_bop, not enough to make it worth merging
2957 #but some useful small subs should be pulled out
2958 sub realtime_refund_bop {
2959   my( $self, $method, %options ) = @_;
2960   if ( $DEBUG ) {
2961     warn "$me realtime_refund_bop: $method refund\n";
2962     warn "  $_ => $options{$_}\n" foreach keys %options;
2963   }
2964
2965   eval "use Business::OnlinePayment";
2966   die $@ if $@;
2967
2968   ###
2969   # look up the original payment and optionally a gateway for that payment
2970   ###
2971
2972   my $cust_pay = '';
2973   my $amount = $options{'amount'};
2974
2975   my( $processor, $login, $password, @bop_options ) ;
2976   my( $auth, $order_number ) = ( '', '', '' );
2977
2978   if ( $options{'paynum'} ) {
2979
2980     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
2981     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2982       or return "Unknown paynum $options{'paynum'}";
2983     $amount ||= $cust_pay->paid;
2984
2985     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
2986       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2987                 $cust_pay->paybatch;
2988     my $gatewaynum = '';
2989     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
2990
2991     if ( $gatewaynum ) { #gateway for the payment to be refunded
2992
2993       my $payment_gateway =
2994         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
2995       die "payment gateway $gatewaynum not found"
2996         unless $payment_gateway;
2997
2998       $processor   = $payment_gateway->gateway_module;
2999       $login       = $payment_gateway->gateway_username;
3000       $password    = $payment_gateway->gateway_password;
3001       @bop_options = $payment_gateway->options;
3002
3003     } else { #try the default gateway
3004
3005       my( $conf_processor, $unused_action );
3006       ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
3007         $self->default_payment_gateway($method);
3008
3009       return "processor of payment $options{'paynum'} $processor does not".
3010              " match default processor $conf_processor"
3011         unless $processor eq $conf_processor;
3012
3013     }
3014
3015
3016   } else { # didn't specify a paynum, so look for agent gateway overrides
3017            # like a normal transaction
3018
3019     my $cardtype;
3020     if ( $method eq 'CC' ) {
3021       $cardtype = cardtype($self->payinfo);
3022     } elsif ( $method eq 'ECHECK' ) {
3023       $cardtype = 'ACH';
3024     } else {
3025       $cardtype = $method;
3026     }
3027     my $override =
3028            qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3029                                                cardtype => $cardtype,
3030                                                taxclass => '',              } )
3031         || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3032                                                cardtype => '',
3033                                                taxclass => '',              } );
3034
3035     if ( $override ) { #use a payment gateway override
3036
3037       my $payment_gateway = $override->payment_gateway;
3038
3039       $processor   = $payment_gateway->gateway_module;
3040       $login       = $payment_gateway->gateway_username;
3041       $password    = $payment_gateway->gateway_password;
3042       #$action      = $payment_gateway->gateway_action;
3043       @bop_options = $payment_gateway->options;
3044
3045     } else { #use the standard settings from the config
3046
3047       my $unused_action;
3048       ( $processor, $login, $password, $unused_action, @bop_options ) =
3049         $self->default_payment_gateway($method);
3050
3051     }
3052
3053   }
3054   return "neither amount nor paynum specified" unless $amount;
3055
3056   my %content = (
3057     'type'           => $method,
3058     'login'          => $login,
3059     'password'       => $password,
3060     'order_number'   => $order_number,
3061     'amount'         => $amount,
3062     'referer'        => 'http://cleanwhisker.420.am/',
3063   );
3064   $content{authorization} = $auth
3065     if length($auth); #echeck/ACH transactions have an order # but no auth
3066                       #(at least with authorize.net)
3067
3068   my $disable_void_after;
3069   if ($conf->exists('disable_void_after')
3070       && $conf->config('disable_void_after') =~ /^(\d+)$/) {
3071     $disable_void_after = $1;
3072   }
3073
3074   #first try void if applicable
3075   if ( $cust_pay && $cust_pay->paid == $amount
3076     && (
3077       ( not defined($disable_void_after) )
3078       || ( time < ($cust_pay->_date + $disable_void_after ) )
3079     )
3080   ) {
3081     warn "  attempting void\n" if $DEBUG > 1;
3082     my $void = new Business::OnlinePayment( $processor, @bop_options );
3083     $void->content( 'action' => 'void', %content );
3084     $void->submit();
3085     if ( $void->is_success ) {
3086       my $error = $cust_pay->void($options{'reason'});
3087       if ( $error ) {
3088         # gah, even with transactions.
3089         my $e = 'WARNING: Card/ACH voided but database not updated - '.
3090                 "error voiding payment: $error";
3091         warn $e;
3092         return $e;
3093       }
3094       warn "  void successful\n" if $DEBUG > 1;
3095       return '';
3096     }
3097   }
3098
3099   warn "  void unsuccessful, trying refund\n"
3100     if $DEBUG > 1;
3101
3102   #massage data
3103   my $address = $self->address1;
3104   $address .= ", ". $self->address2 if $self->address2;
3105
3106   my($payname, $payfirst, $paylast);
3107   if ( $self->payname && $method ne 'ECHECK' ) {
3108     $payname = $self->payname;
3109     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3110       or return "Illegal payname $payname";
3111     ($payfirst, $paylast) = ($1, $2);
3112   } else {
3113     $payfirst = $self->getfield('first');
3114     $paylast = $self->getfield('last');
3115     $payname =  "$payfirst $paylast";
3116   }
3117
3118   my @invoicing_list = $self->invoicing_list_emailonly;
3119   if ( $conf->exists('emailinvoiceautoalways')
3120        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3121        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3122     push @invoicing_list, $self->all_emails;
3123   }
3124
3125   my $email = ($conf->exists('business-onlinepayment-email-override'))
3126               ? $conf->config('business-onlinepayment-email-override')
3127               : $invoicing_list[0];
3128
3129   my $payip = exists($options{'payip'})
3130                 ? $options{'payip'}
3131                 : $self->payip;
3132   $content{customer_ip} = $payip
3133     if length($payip);
3134
3135   my $payinfo = '';
3136   if ( $method eq 'CC' ) {
3137
3138     if ( $cust_pay ) {
3139       $content{card_number} = $payinfo = $cust_pay->payinfo;
3140       (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
3141         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
3142         ($content{expiration} = "$2/$1");  # where available
3143     } else {
3144       $content{card_number} = $payinfo = $self->payinfo;
3145       (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
3146         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3147       $content{expiration} = "$2/$1";
3148     }
3149
3150   } elsif ( $method eq 'ECHECK' ) {
3151
3152     if ( $cust_pay ) {
3153       $payinfo = $cust_pay->payinfo;
3154     } else {
3155       $payinfo = $self->payinfo;
3156     }
3157     ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
3158     $content{bank_name} = $self->payname;
3159     $content{account_type} = 'CHECKING';
3160     $content{account_name} = $payname;
3161     $content{customer_org} = $self->company ? 'B' : 'I';
3162     $content{customer_ssn} = $self->ss;
3163   } elsif ( $method eq 'LEC' ) {
3164     $content{phone} = $payinfo = $self->payinfo;
3165   }
3166
3167   #then try refund
3168   my $refund = new Business::OnlinePayment( $processor, @bop_options );
3169   my %sub_content = $refund->content(
3170     'action'         => 'credit',
3171     'customer_id'    => $self->custnum,
3172     'last_name'      => $paylast,
3173     'first_name'     => $payfirst,
3174     'name'           => $payname,
3175     'address'        => $address,
3176     'city'           => $self->city,
3177     'state'          => $self->state,
3178     'zip'            => $self->zip,
3179     'country'        => $self->country,
3180     'email'          => $email,
3181     'phone'          => $self->daytime || $self->night,
3182     %content, #after
3183   );
3184   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
3185     if $DEBUG > 1;
3186   $refund->submit();
3187
3188   return "$processor error: ". $refund->error_message
3189     unless $refund->is_success();
3190
3191   my %method2payby = (
3192     'CC'     => 'CARD',
3193     'ECHECK' => 'CHEK',
3194     'LEC'    => 'LECB',
3195   );
3196
3197   my $paybatch = "$processor:". $refund->authorization;
3198   $paybatch .= ':'. $refund->order_number
3199     if $refund->can('order_number') && $refund->order_number;
3200
3201   while ( $cust_pay && $cust_pay->unapplied < $amount ) {
3202     my @cust_bill_pay = $cust_pay->cust_bill_pay;
3203     last unless @cust_bill_pay;
3204     my $cust_bill_pay = pop @cust_bill_pay;
3205     my $error = $cust_bill_pay->delete;
3206     last if $error;
3207   }
3208
3209   my $cust_refund = new FS::cust_refund ( {
3210     'custnum'  => $self->custnum,
3211     'paynum'   => $options{'paynum'},
3212     'refund'   => $amount,
3213     '_date'    => '',
3214     'payby'    => $method2payby{$method},
3215     'payinfo'  => $payinfo,
3216     'paybatch' => $paybatch,
3217     'reason'   => $options{'reason'} || 'card or ACH refund',
3218   } );
3219   my $error = $cust_refund->insert;
3220   if ( $error ) {
3221     $cust_refund->paynum(''); #try again with no specific paynum
3222     my $error2 = $cust_refund->insert;
3223     if ( $error2 ) {
3224       # gah, even with transactions.
3225       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
3226               "error inserting refund ($processor): $error2".
3227               " (previously tried insert with paynum #$options{'paynum'}" .
3228               ": $error )";
3229       warn $e;
3230       return $e;
3231     }
3232   }
3233
3234   ''; #no error
3235
3236 }
3237
3238 =item batch_card OPTION => VALUE...
3239
3240 Adds a payment for this invoice to the pending credit card batch (see
3241 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
3242 runs the payment using a realtime gateway.
3243
3244 =cut
3245
3246 sub batch_card {
3247   my ($self, %options) = @_;
3248
3249   my $amount;
3250   if (exists($options{amount})) {
3251     $amount = $options{amount};
3252   }else{
3253     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
3254   }
3255   return '' unless $amount > 0;
3256
3257   my $invnum = delete $options{invnum};
3258   my $payby = $options{invnum} || $self->payby;  #dubious
3259
3260   if ($options{'realtime'}) {
3261     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
3262                                 $amount,
3263                                 %options,
3264                               );
3265   }
3266
3267   my $oldAutoCommit = $FS::UID::AutoCommit;
3268   local $FS::UID::AutoCommit = 0;
3269   my $dbh = dbh;
3270
3271   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
3272     or return "Cannot lock pay_batch: " . $dbh->errstr;
3273
3274   my %pay_batch = (
3275     'status' => 'O',
3276     'payby'  => FS::payby->payby2payment($payby),
3277   );
3278
3279   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
3280
3281   unless ( $pay_batch ) {
3282     $pay_batch = new FS::pay_batch \%pay_batch;
3283     my $error = $pay_batch->insert;
3284     if ( $error ) {
3285       $dbh->rollback if $oldAutoCommit;
3286       die "error creating new batch: $error\n";
3287     }
3288   }
3289
3290   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
3291       'batchnum' => $pay_batch->batchnum,
3292       'custnum'  => $self->custnum,
3293   } );
3294
3295   foreach (qw( address1 address2 city state zip country payby payinfo paydate
3296                payname )) {
3297     $options{$_} = '' unless exists($options{$_});
3298   }
3299
3300   my $cust_pay_batch = new FS::cust_pay_batch ( {
3301     'batchnum' => $pay_batch->batchnum,
3302     'invnum'   => $invnum || 0,                    # is there a better value?
3303                                                    # this field should be
3304                                                    # removed...
3305                                                    # cust_bill_pay_batch now
3306     'custnum'  => $self->custnum,
3307     'last'     => $self->getfield('last'),
3308     'first'    => $self->getfield('first'),
3309     'address1' => $options{address1} || $self->address1,
3310     'address2' => $options{address2} || $self->address2,
3311     'city'     => $options{city}     || $self->city,
3312     'state'    => $options{state}    || $self->state,
3313     'zip'      => $options{zip}      || $self->zip,
3314     'country'  => $options{country}  || $self->country,
3315     'payby'    => $options{payby}    || $self->payby,
3316     'payinfo'  => $options{payinfo}  || $self->payinfo,
3317     'exp'      => $options{paydate}  || $self->paydate,
3318     'payname'  => $options{payname}  || $self->payname,
3319     'amount'   => $amount,                         # consolidating
3320   } );
3321
3322   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
3323     if $old_cust_pay_batch;
3324
3325   my $error;
3326   if ($old_cust_pay_batch) {
3327     $error = $cust_pay_batch->replace($old_cust_pay_batch)
3328   } else {
3329     $error = $cust_pay_batch->insert;
3330   }
3331
3332   if ( $error ) {
3333     $dbh->rollback if $oldAutoCommit;
3334     die $error;
3335   }
3336
3337   my $unapplied = $self->total_credited + $self->total_unapplied_payments + $self->in_transit_payments;
3338   foreach my $cust_bill ($self->open_cust_bill) {
3339     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
3340     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
3341       'invnum' => $cust_bill->invnum,
3342       'paybatchnum' => $cust_pay_batch->paybatchnum,
3343       'amount' => $cust_bill->owed,
3344       '_date' => time,
3345     };
3346     if ($unapplied >= $cust_bill_pay_batch->amount){
3347       $unapplied -= $cust_bill_pay_batch->amount;
3348       next;
3349     }else{
3350       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
3351                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
3352     }
3353     $error = $cust_bill_pay_batch->insert;
3354     if ( $error ) {
3355       $dbh->rollback if $oldAutoCommit;
3356       die $error;
3357     }
3358   }
3359
3360   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3361   '';
3362 }
3363
3364 =item total_owed
3365
3366 Returns the total owed for this customer on all invoices
3367 (see L<FS::cust_bill/owed>).
3368
3369 =cut
3370
3371 sub total_owed {
3372   my $self = shift;
3373   $self->total_owed_date(2145859200); #12/31/2037
3374 }
3375
3376 =item total_owed_date TIME
3377
3378 Returns the total owed for this customer on all invoices with date earlier than
3379 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
3380 see L<Time::Local> and L<Date::Parse> for conversion functions.
3381
3382 =cut
3383
3384 sub total_owed_date {
3385   my $self = shift;
3386   my $time = shift;
3387   my $total_bill = 0;
3388   foreach my $cust_bill (
3389     grep { $_->_date <= $time }
3390       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3391   ) {
3392     $total_bill += $cust_bill->owed;
3393   }
3394   sprintf( "%.2f", $total_bill );
3395 }
3396
3397 =item apply_payments_and_credits
3398
3399 Applies unapplied payments and credits.
3400
3401 In most cases, this new method should be used in place of sequential
3402 apply_payments and apply_credits methods.
3403
3404 If there is an error, returns the error, otherwise returns false.
3405
3406 =cut
3407
3408 sub apply_payments_and_credits {
3409   my $self = shift;
3410
3411   local $SIG{HUP} = 'IGNORE';
3412   local $SIG{INT} = 'IGNORE';
3413   local $SIG{QUIT} = 'IGNORE';
3414   local $SIG{TERM} = 'IGNORE';
3415   local $SIG{TSTP} = 'IGNORE';
3416   local $SIG{PIPE} = 'IGNORE';
3417
3418   my $oldAutoCommit = $FS::UID::AutoCommit;
3419   local $FS::UID::AutoCommit = 0;
3420   my $dbh = dbh;
3421
3422   $self->select_for_update; #mutex
3423
3424   foreach my $cust_bill ( $self->open_cust_bill ) {
3425     my $error = $cust_bill->apply_payments_and_credits;
3426     if ( $error ) {
3427       $dbh->rollback if $oldAutoCommit;
3428       return "Error applying: $error";
3429     }
3430   }
3431
3432   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3433   ''; #no error
3434
3435 }
3436
3437 =item apply_credits OPTION => VALUE ...
3438
3439 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
3440 to outstanding invoice balances in chronological order (or reverse
3441 chronological order if the I<order> option is set to B<newest>) and returns the
3442 value of any remaining unapplied credits available for refund (see
3443 L<FS::cust_refund>).
3444
3445 Dies if there is an error.
3446
3447 =cut
3448
3449 sub apply_credits {
3450   my $self = shift;
3451   my %opt = @_;
3452
3453   local $SIG{HUP} = 'IGNORE';
3454   local $SIG{INT} = 'IGNORE';
3455   local $SIG{QUIT} = 'IGNORE';
3456   local $SIG{TERM} = 'IGNORE';
3457   local $SIG{TSTP} = 'IGNORE';
3458   local $SIG{PIPE} = 'IGNORE';
3459
3460   my $oldAutoCommit = $FS::UID::AutoCommit;
3461   local $FS::UID::AutoCommit = 0;
3462   my $dbh = dbh;
3463
3464   $self->select_for_update; #mutex
3465
3466   unless ( $self->total_credited ) {
3467     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3468     return 0;
3469   }
3470
3471   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
3472       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
3473
3474   my @invoices = $self->open_cust_bill;
3475   @invoices = sort { $b->_date <=> $a->_date } @invoices
3476     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
3477
3478   my $credit;
3479   foreach my $cust_bill ( @invoices ) {
3480     my $amount;
3481
3482     if ( !defined($credit) || $credit->credited == 0) {
3483       $credit = pop @credits or last;
3484     }
3485
3486     if ($cust_bill->owed >= $credit->credited) {
3487       $amount=$credit->credited;
3488     }else{
3489       $amount=$cust_bill->owed;
3490     }
3491
3492     my $cust_credit_bill = new FS::cust_credit_bill ( {
3493       'crednum' => $credit->crednum,
3494       'invnum'  => $cust_bill->invnum,
3495       'amount'  => $amount,
3496     } );
3497     my $error = $cust_credit_bill->insert;
3498     if ( $error ) {
3499       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
3500       die $error;
3501     }
3502
3503     redo if ($cust_bill->owed > 0);
3504
3505   }
3506
3507   my $total_credited = $self->total_credited;
3508
3509   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3510
3511   return $total_credited;
3512 }
3513
3514 =item apply_payments
3515
3516 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
3517 to outstanding invoice balances in chronological order.
3518
3519  #and returns the value of any remaining unapplied payments.
3520
3521 Dies if there is an error.
3522
3523 =cut
3524
3525 sub apply_payments {
3526   my $self = shift;
3527
3528   local $SIG{HUP} = 'IGNORE';
3529   local $SIG{INT} = 'IGNORE';
3530   local $SIG{QUIT} = 'IGNORE';
3531   local $SIG{TERM} = 'IGNORE';
3532   local $SIG{TSTP} = 'IGNORE';
3533   local $SIG{PIPE} = 'IGNORE';
3534
3535   my $oldAutoCommit = $FS::UID::AutoCommit;
3536   local $FS::UID::AutoCommit = 0;
3537   my $dbh = dbh;
3538
3539   $self->select_for_update; #mutex
3540
3541   #return 0 unless
3542
3543   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
3544       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
3545
3546   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
3547       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
3548
3549   my $payment;
3550
3551   foreach my $cust_bill ( @invoices ) {
3552     my $amount;
3553
3554     if ( !defined($payment) || $payment->unapplied == 0 ) {
3555       $payment = pop @payments or last;
3556     }
3557
3558     if ( $cust_bill->owed >= $payment->unapplied ) {
3559       $amount = $payment->unapplied;
3560     } else {
3561       $amount = $cust_bill->owed;
3562     }
3563
3564     my $cust_bill_pay = new FS::cust_bill_pay ( {
3565       'paynum' => $payment->paynum,
3566       'invnum' => $cust_bill->invnum,
3567       'amount' => $amount,
3568     } );
3569     my $error = $cust_bill_pay->insert;
3570     if ( $error ) {
3571       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
3572       die $error;
3573     }
3574
3575     redo if ( $cust_bill->owed > 0);
3576
3577   }
3578
3579   my $total_unapplied_payments = $self->total_unapplied_payments;
3580
3581   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3582
3583   return $total_unapplied_payments;
3584 }
3585
3586 =item total_credited
3587
3588 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3589 customer.  See L<FS::cust_credit/credited>.
3590
3591 =cut
3592
3593 sub total_credited {
3594   my $self = shift;
3595   my $total_credit = 0;
3596   foreach my $cust_credit ( qsearch('cust_credit', {
3597     'custnum' => $self->custnum,
3598   } ) ) {
3599     $total_credit += $cust_credit->credited;
3600   }
3601   sprintf( "%.2f", $total_credit );
3602 }
3603
3604 =item total_unapplied_payments
3605
3606 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3607 See L<FS::cust_pay/unapplied>.
3608
3609 =cut
3610
3611 sub total_unapplied_payments {
3612   my $self = shift;
3613   my $total_unapplied = 0;
3614   foreach my $cust_pay ( qsearch('cust_pay', {
3615     'custnum' => $self->custnum,
3616   } ) ) {
3617     $total_unapplied += $cust_pay->unapplied;
3618   }
3619   sprintf( "%.2f", $total_unapplied );
3620 }
3621
3622 =item balance
3623
3624 Returns the balance for this customer (total_owed minus total_credited
3625 minus total_unapplied_payments).
3626
3627 =cut
3628
3629 sub balance {
3630   my $self = shift;
3631   sprintf( "%.2f",
3632     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
3633   );
3634 }
3635
3636 =item balance_date TIME
3637
3638 Returns the balance for this customer, only considering invoices with date
3639 earlier than TIME (total_owed_date minus total_credited minus
3640 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
3641 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
3642 functions.
3643
3644 =cut
3645
3646 sub balance_date {
3647   my $self = shift;
3648   my $time = shift;
3649   sprintf( "%.2f",
3650     $self->total_owed_date($time)
3651       - $self->total_credited
3652       - $self->total_unapplied_payments
3653   );
3654 }
3655
3656 =item in_transit_payments
3657
3658 Returns the total of requests for payments for this customer pending in
3659 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
3660
3661 =cut
3662
3663 sub in_transit_payments {
3664   my $self = shift;
3665   my $in_transit_payments = 0;
3666   foreach my $pay_batch ( qsearch('pay_batch', {
3667     'status' => 'I',
3668   } ) ) {
3669     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
3670       'batchnum' => $pay_batch->batchnum,
3671       'custnum' => $self->custnum,
3672     } ) ) {
3673       $in_transit_payments += $cust_pay_batch->amount;
3674     }
3675   }
3676   sprintf( "%.2f", $in_transit_payments );
3677 }
3678
3679 =item paydate_monthyear
3680
3681 Returns a two-element list consisting of the month and year of this customer's
3682 paydate (credit card expiration date for CARD customers)
3683
3684 =cut
3685
3686 sub paydate_monthyear {
3687   my $self = shift;
3688   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3689     ( $2, $1 );
3690   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3691     ( $1, $3 );
3692   } else {
3693     ('', '');
3694   }
3695 }
3696
3697 =item invoicing_list [ ARRAYREF ]
3698
3699 If an arguement is given, sets these email addresses as invoice recipients
3700 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
3701 (except as warnings), so use check_invoicing_list first.
3702
3703 Returns a list of email addresses (with svcnum entries expanded).
3704
3705 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
3706 check it without disturbing anything by passing nothing.
3707
3708 This interface may change in the future.
3709
3710 =cut
3711
3712 sub invoicing_list {
3713   my( $self, $arrayref ) = @_;
3714
3715   if ( $arrayref ) {
3716     my @cust_main_invoice;
3717     if ( $self->custnum ) {
3718       @cust_main_invoice =
3719         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3720     } else {
3721       @cust_main_invoice = ();
3722     }
3723     foreach my $cust_main_invoice ( @cust_main_invoice ) {
3724       #warn $cust_main_invoice->destnum;
3725       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3726         #warn $cust_main_invoice->destnum;
3727         my $error = $cust_main_invoice->delete;
3728         warn $error if $error;
3729       }
3730     }
3731     if ( $self->custnum ) {
3732       @cust_main_invoice =
3733         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3734     } else {
3735       @cust_main_invoice = ();
3736     }
3737     my %seen = map { $_->address => 1 } @cust_main_invoice;
3738     foreach my $address ( @{$arrayref} ) {
3739       next if exists $seen{$address} && $seen{$address};
3740       $seen{$address} = 1;
3741       my $cust_main_invoice = new FS::cust_main_invoice ( {
3742         'custnum' => $self->custnum,
3743         'dest'    => $address,
3744       } );
3745       my $error = $cust_main_invoice->insert;
3746       warn $error if $error;
3747     }
3748   }
3749
3750   if ( $self->custnum ) {
3751     map { $_->address }
3752       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3753   } else {
3754     ();
3755   }
3756
3757 }
3758
3759 =item check_invoicing_list ARRAYREF
3760
3761 Checks these arguements as valid input for the invoicing_list method.  If there
3762 is an error, returns the error, otherwise returns false.
3763
3764 =cut
3765
3766 sub check_invoicing_list {
3767   my( $self, $arrayref ) = @_;
3768
3769   foreach my $address ( @$arrayref ) {
3770
3771     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3772       return 'Can\'t add FAX invoice destination with a blank FAX number.';
3773     }
3774
3775     my $cust_main_invoice = new FS::cust_main_invoice ( {
3776       'custnum' => $self->custnum,
3777       'dest'    => $address,
3778     } );
3779     my $error = $self->custnum
3780                 ? $cust_main_invoice->check
3781                 : $cust_main_invoice->checkdest
3782     ;
3783     return $error if $error;
3784
3785   }
3786
3787   return "Email address required"
3788     if $conf->exists('cust_main-require_invoicing_list_email')
3789     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3790
3791   '';
3792 }
3793
3794 =item set_default_invoicing_list
3795
3796 Sets the invoicing list to all accounts associated with this customer,
3797 overwriting any previous invoicing list.
3798
3799 =cut
3800
3801 sub set_default_invoicing_list {
3802   my $self = shift;
3803   $self->invoicing_list($self->all_emails);
3804 }
3805
3806 =item all_emails
3807
3808 Returns the email addresses of all accounts provisioned for this customer.
3809
3810 =cut
3811
3812 sub all_emails {
3813   my $self = shift;
3814   my %list;
3815   foreach my $cust_pkg ( $self->all_pkgs ) {
3816     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3817     my @svc_acct =
3818       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3819         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3820           @cust_svc;
3821     $list{$_}=1 foreach map { $_->email } @svc_acct;
3822   }
3823   keys %list;
3824 }
3825
3826 =item invoicing_list_addpost
3827
3828 Adds postal invoicing to this customer.  If this customer is already configured
3829 to receive postal invoices, does nothing.
3830
3831 =cut
3832
3833 sub invoicing_list_addpost {
3834   my $self = shift;
3835   return if grep { $_ eq 'POST' } $self->invoicing_list;
3836   my @invoicing_list = $self->invoicing_list;
3837   push @invoicing_list, 'POST';
3838   $self->invoicing_list(\@invoicing_list);
3839 }
3840
3841 =item invoicing_list_emailonly
3842
3843 Returns the list of email invoice recipients (invoicing_list without non-email
3844 destinations such as POST and FAX).
3845
3846 =cut
3847
3848 sub invoicing_list_emailonly {
3849   my $self = shift;
3850   warn "$me invoicing_list_emailonly called"
3851     if $DEBUG;
3852   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3853 }
3854
3855 =item invoicing_list_emailonly_scalar
3856
3857 Returns the list of email invoice recipients (invoicing_list without non-email
3858 destinations such as POST and FAX) as a comma-separated scalar.
3859
3860 =cut
3861
3862 sub invoicing_list_emailonly_scalar {
3863   my $self = shift;
3864   warn "$me invoicing_list_emailonly_scalar called"
3865     if $DEBUG;
3866   join(', ', $self->invoicing_list_emailonly);
3867 }
3868
3869 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3870
3871 Returns an array of customers referred by this customer (referral_custnum set
3872 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3873 customers referred by customers referred by this customer and so on, inclusive.
3874 The default behavior is DEPTH 1 (no recursion).
3875
3876 =cut
3877
3878 sub referral_cust_main {
3879   my $self = shift;
3880   my $depth = @_ ? shift : 1;
3881   my $exclude = @_ ? shift : {};
3882
3883   my @cust_main =
3884     map { $exclude->{$_->custnum}++; $_; }
3885       grep { ! $exclude->{ $_->custnum } }
3886         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3887
3888   if ( $depth > 1 ) {
3889     push @cust_main,
3890       map { $_->referral_cust_main($depth-1, $exclude) }
3891         @cust_main;
3892   }
3893
3894   @cust_main;
3895 }
3896
3897 =item referral_cust_main_ncancelled
3898
3899 Same as referral_cust_main, except only returns customers with uncancelled
3900 packages.
3901
3902 =cut
3903
3904 sub referral_cust_main_ncancelled {
3905   my $self = shift;
3906   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3907 }
3908
3909 =item referral_cust_pkg [ DEPTH ]
3910
3911 Like referral_cust_main, except returns a flat list of all unsuspended (and
3912 uncancelled) packages for each customer.  The number of items in this list may
3913 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3914
3915 =cut
3916
3917 sub referral_cust_pkg {
3918   my $self = shift;
3919   my $depth = @_ ? shift : 1;
3920
3921   map { $_->unsuspended_pkgs }
3922     grep { $_->unsuspended_pkgs }
3923       $self->referral_cust_main($depth);
3924 }
3925
3926 =item referring_cust_main
3927
3928 Returns the single cust_main record for the customer who referred this customer
3929 (referral_custnum), or false.
3930
3931 =cut
3932
3933 sub referring_cust_main {
3934   my $self = shift;
3935   return '' unless $self->referral_custnum;
3936   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3937 }
3938
3939 =item credit AMOUNT, REASON
3940
3941 Applies a credit to this customer.  If there is an error, returns the error,
3942 otherwise returns false.
3943
3944 =cut
3945
3946 sub credit {
3947   my( $self, $amount, $reason ) = @_;
3948   my $cust_credit = new FS::cust_credit {
3949     'custnum' => $self->custnum,
3950     'amount'  => $amount,
3951     'reason'  => $reason,
3952   };
3953   $cust_credit->insert;
3954 }
3955
3956 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3957
3958 Creates a one-time charge for this customer.  If there is an error, returns
3959 the error, otherwise returns false.
3960
3961 =cut
3962
3963 sub charge {
3964   my $self = shift;
3965   my ( $amount, $pkg, $comment, $taxclass, $additional );
3966   if ( ref( $_[0] ) ) {
3967     $amount     = $_[0]->{amount};
3968     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3969     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
3970                                            : '$'. sprintf("%.2f",$amount);
3971     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3972     $additional = $_[0]->{additional};
3973   }else{
3974     $amount     = shift;
3975     $pkg        = @_ ? shift : 'One-time charge';
3976     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
3977     $taxclass   = @_ ? shift : '';
3978     $additional = [];
3979   }
3980
3981   local $SIG{HUP} = 'IGNORE';
3982   local $SIG{INT} = 'IGNORE';
3983   local $SIG{QUIT} = 'IGNORE';
3984   local $SIG{TERM} = 'IGNORE';
3985   local $SIG{TSTP} = 'IGNORE';
3986   local $SIG{PIPE} = 'IGNORE';
3987
3988   my $oldAutoCommit = $FS::UID::AutoCommit;
3989   local $FS::UID::AutoCommit = 0;
3990   my $dbh = dbh;
3991
3992   my $part_pkg = new FS::part_pkg ( {
3993     'pkg'      => $pkg,
3994     'comment'  => $comment,
3995     'plan'     => 'flat',
3996     'freq'     => 0,
3997     'disabled' => 'Y',
3998     'taxclass' => $taxclass,
3999   } );
4000
4001   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
4002                         ( 0 .. @$additional - 1 )
4003                   ),
4004                   'additional_count' => scalar(@$additional),
4005                   'setup_fee' => $amount,
4006                 );
4007
4008   my $error = $part_pkg->insert( options => \%options );
4009   if ( $error ) {
4010     $dbh->rollback if $oldAutoCommit;
4011     return $error;
4012   }
4013
4014   my $pkgpart = $part_pkg->pkgpart;
4015   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
4016   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
4017     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
4018     $error = $type_pkgs->insert;
4019     if ( $error ) {
4020       $dbh->rollback if $oldAutoCommit;
4021       return $error;
4022     }
4023   }
4024
4025   my $cust_pkg = new FS::cust_pkg ( {
4026     'custnum' => $self->custnum,
4027     'pkgpart' => $pkgpart,
4028   } );
4029
4030   $error = $cust_pkg->insert;
4031   if ( $error ) {
4032     $dbh->rollback if $oldAutoCommit;
4033     return $error;
4034   }
4035
4036   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4037   '';
4038
4039 }
4040
4041 =item cust_bill
4042
4043 Returns all the invoices (see L<FS::cust_bill>) for this customer.
4044
4045 =cut
4046
4047 sub cust_bill {
4048   my $self = shift;
4049   sort { $a->_date <=> $b->_date }
4050     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4051 }
4052
4053 =item open_cust_bill
4054
4055 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
4056 customer.
4057
4058 =cut
4059
4060 sub open_cust_bill {
4061   my $self = shift;
4062   grep { $_->owed > 0 } $self->cust_bill;
4063 }
4064
4065 =item cust_credit
4066
4067 Returns all the credits (see L<FS::cust_credit>) for this customer.
4068
4069 =cut
4070
4071 sub cust_credit {
4072   my $self = shift;
4073   sort { $a->_date <=> $b->_date }
4074     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
4075 }
4076
4077 =item cust_pay
4078
4079 Returns all the payments (see L<FS::cust_pay>) for this customer.
4080
4081 =cut
4082
4083 sub cust_pay {
4084   my $self = shift;
4085   sort { $a->_date <=> $b->_date }
4086     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
4087 }
4088
4089 =item cust_pay_void
4090
4091 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
4092
4093 =cut
4094
4095 sub cust_pay_void {
4096   my $self = shift;
4097   sort { $a->_date <=> $b->_date }
4098     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
4099 }
4100
4101
4102 =item cust_refund
4103
4104 Returns all the refunds (see L<FS::cust_refund>) for this customer.
4105
4106 =cut
4107
4108 sub cust_refund {
4109   my $self = shift;
4110   sort { $a->_date <=> $b->_date }
4111     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
4112 }
4113
4114 =item name
4115
4116 Returns a name string for this customer, either "Company (Last, First)" or
4117 "Last, First".
4118
4119 =cut
4120
4121 sub name {
4122   my $self = shift;
4123   my $name = $self->contact;
4124   $name = $self->company. " ($name)" if $self->company;
4125   $name;
4126 }
4127
4128 =item ship_name
4129
4130 Returns a name string for this (service/shipping) contact, either
4131 "Company (Last, First)" or "Last, First".
4132
4133 =cut
4134
4135 sub ship_name {
4136   my $self = shift;
4137   if ( $self->get('ship_last') ) {
4138     my $name = $self->ship_contact;
4139     $name = $self->ship_company. " ($name)" if $self->ship_company;
4140     $name;
4141   } else {
4142     $self->name;
4143   }
4144 }
4145
4146 =item contact
4147
4148 Returns this customer's full (billing) contact name only, "Last, First"
4149
4150 =cut
4151
4152 sub contact {
4153   my $self = shift;
4154   $self->get('last'). ', '. $self->first;
4155 }
4156
4157 =item ship_contact
4158
4159 Returns this customer's full (shipping) contact name only, "Last, First"
4160
4161 =cut
4162
4163 sub ship_contact {
4164   my $self = shift;
4165   $self->get('ship_last')
4166     ? $self->get('ship_last'). ', '. $self->ship_first
4167     : $self->contact;
4168 }
4169
4170 =item country_full
4171
4172 Returns this customer's full country name
4173
4174 =cut
4175
4176 sub country_full {
4177   my $self = shift;
4178   code2country($self->country);
4179 }
4180
4181 =item cust_status
4182
4183 =item status
4184
4185 Returns a status string for this customer, currently:
4186
4187 =over 4
4188
4189 =item prospect - No packages have ever been ordered
4190
4191 =item active - One or more recurring packages is active
4192
4193 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4194
4195 =item suspended - All non-cancelled recurring packages are suspended
4196
4197 =item cancelled - All recurring packages are cancelled
4198
4199 =back
4200
4201 =cut
4202
4203 sub status { shift->cust_status(@_); }
4204
4205 sub cust_status {
4206   my $self = shift;
4207   for my $status (qw( prospect active inactive suspended cancelled )) {
4208     my $method = $status.'_sql';
4209     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4210     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4211     $sth->execute( ($self->custnum) x $numnum )
4212       or die "Error executing 'SELECT $sql': ". $sth->errstr;
4213     return $status if $sth->fetchrow_arrayref->[0];
4214   }
4215 }
4216
4217 =item ucfirst_cust_status
4218
4219 =item ucfirst_status
4220
4221 Returns the status with the first character capitalized.
4222
4223 =cut
4224
4225 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4226
4227 sub ucfirst_cust_status {
4228   my $self = shift;
4229   ucfirst($self->cust_status);
4230 }
4231
4232 =item statuscolor
4233
4234 Returns a hex triplet color string for this customer's status.
4235
4236 =cut
4237
4238 use vars qw(%statuscolor);
4239 %statuscolor = (
4240   'prospect'  => '7e0079', #'000000', #black?  naw, purple
4241   'active'    => '00CC00', #green
4242   'inactive'  => '0000CC', #blue
4243   'suspended' => 'FF9900', #yellow
4244   'cancelled' => 'FF0000', #red
4245 );
4246
4247 sub statuscolor { shift->cust_statuscolor(@_); }
4248
4249 sub cust_statuscolor {
4250   my $self = shift;
4251   $statuscolor{$self->cust_status};
4252 }
4253
4254 =back
4255
4256 =head1 CLASS METHODS
4257
4258 =over 4
4259
4260 =item prospect_sql
4261
4262 Returns an SQL expression identifying prospective cust_main records (customers
4263 with no packages ever ordered)
4264
4265 =cut
4266
4267 use vars qw($select_count_pkgs);
4268 $select_count_pkgs =
4269   "SELECT COUNT(*) FROM cust_pkg
4270     WHERE cust_pkg.custnum = cust_main.custnum";
4271
4272 sub select_count_pkgs_sql {
4273   $select_count_pkgs;
4274 }
4275
4276 sub prospect_sql { "
4277   0 = ( $select_count_pkgs )
4278 "; }
4279
4280 =item active_sql
4281
4282 Returns an SQL expression identifying active cust_main records (customers with
4283 no active recurring packages, but otherwise unsuspended/uncancelled).
4284
4285 =cut
4286
4287 sub active_sql { "
4288   0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
4289       )
4290 "; }
4291
4292 =item inactive_sql
4293
4294 Returns an SQL expression identifying inactive cust_main records (customers with
4295 active recurring packages).
4296
4297 =cut
4298
4299 sub inactive_sql { "
4300   0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
4301   AND
4302   0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
4303 "; }
4304
4305 =item susp_sql
4306 =item suspended_sql
4307
4308 Returns an SQL expression identifying suspended cust_main records.
4309
4310 =cut
4311
4312
4313 sub suspended_sql { susp_sql(@_); }
4314 sub susp_sql { "
4315     0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
4316     AND
4317     0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
4318 "; }
4319
4320 =item cancel_sql
4321 =item cancelled_sql
4322
4323 Returns an SQL expression identifying cancelled cust_main records.
4324
4325 =cut
4326
4327 sub cancelled_sql { cancel_sql(@_); }
4328 sub cancel_sql {
4329
4330   my $recurring_sql = FS::cust_pkg->recurring_sql;
4331   #my $recurring_sql = "
4332   #  '0' != ( select freq from part_pkg
4333   #             where cust_pkg.pkgpart = part_pkg.pkgpart )
4334   #";
4335
4336   "
4337     0 < ( $select_count_pkgs )
4338     AND 0 = ( $select_count_pkgs AND $recurring_sql
4339                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4340             )
4341   ";
4342 }
4343
4344 =item uncancel_sql
4345 =item uncancelled_sql
4346
4347 Returns an SQL expression identifying un-cancelled cust_main records.
4348
4349 =cut
4350
4351 sub uncancelled_sql { uncancel_sql(@_); }
4352 sub uncancel_sql { "
4353   ( 0 < ( $select_count_pkgs
4354                    AND ( cust_pkg.cancel IS NULL
4355                          OR cust_pkg.cancel = 0
4356                        )
4357         )
4358     OR 0 = ( $select_count_pkgs )
4359   )
4360 "; }
4361
4362 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
4363
4364 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
4365 records.  Currently, I<first>, I<last> and/or I<company> may be specified (the
4366 appropriate ship_ field is also searched).
4367
4368 Additional options are the same as FS::Record::qsearch
4369
4370 =cut
4371
4372 sub fuzzy_search {
4373   my( $self, $fuzzy, $hash, @opt) = @_;
4374   #$self
4375   $hash ||= {};
4376   my @cust_main = ();
4377
4378   check_and_rebuild_fuzzyfiles();
4379   foreach my $field ( keys %$fuzzy ) {
4380
4381     my $all = $self->all_X($field);
4382     next unless scalar(@$all);
4383
4384     my %match = ();
4385     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
4386
4387     my @fcust = ();
4388     foreach ( keys %match ) {
4389       push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
4390       push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
4391     }
4392     my %fsaw = ();
4393     push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
4394   }
4395
4396   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
4397   my %saw = ();
4398   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
4399
4400   @cust_main;
4401
4402 }
4403
4404 =item masked FIELD
4405
4406  Returns a masked version of the named field
4407
4408 =cut
4409
4410 sub masked {
4411   my ($self, $field) = @_;
4412
4413   # Show last four
4414
4415   'x'x(length($self->getfield($field))-4).
4416     substr($self->getfield($field), (length($self->getfield($field))-4));
4417
4418 }
4419
4420 =back
4421
4422 =head1 SUBROUTINES
4423
4424 =over 4
4425
4426 =item smart_search OPTION => VALUE ...
4427
4428 Accepts the following options: I<search>, the string to search for.  The string
4429 will be searched for as a customer number, phone number, name or company name,
4430 as an exact, or, in some cases, a substring or fuzzy match (see the source code
4431 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
4432 skip fuzzy matching when an exact match is found.
4433
4434 Any additional options are treated as an additional qualifier on the search
4435 (i.e. I<agentnum>).
4436
4437 Returns a (possibly empty) array of FS::cust_main objects.
4438
4439 =cut
4440
4441 sub smart_search {
4442   my %options = @_;
4443
4444   #here is the agent virtualization
4445   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
4446
4447   my @cust_main = ();
4448
4449   my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
4450   my $search = delete $options{'search'};
4451   ( my $alphanum_search = $search ) =~ s/\W//g;
4452
4453   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
4454
4455     #false laziness w/Record::ut_phone
4456     my $phonen = "$1-$2-$3";
4457     $phonen .= " x$4" if $4;
4458
4459     push @cust_main, qsearch( {
4460       'table'   => 'cust_main',
4461       'hashref' => { %options },
4462       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
4463                      ' ( '.
4464                          join(' OR ', map "$_ = '$phonen'",
4465                                           qw( daytime night fax
4466                                               ship_daytime ship_night ship_fax )
4467                              ).
4468                      ' ) '.
4469                      " AND $agentnums_sql", #agent virtualization
4470     } );
4471
4472     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
4473       #try looking for matches with extensions unless one was specified
4474
4475       push @cust_main, qsearch( {
4476         'table'   => 'cust_main',
4477         'hashref' => { %options },
4478         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
4479                        ' ( '.
4480                            join(' OR ', map "$_ LIKE '$phonen\%'",
4481                                             qw( daytime night
4482                                                 ship_daytime ship_night )
4483                                ).
4484                        ' ) '.
4485                        " AND $agentnums_sql", #agent virtualization
4486       } );
4487
4488     }
4489
4490   } elsif ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
4491
4492     push @cust_main, qsearch( {
4493       'table'     => 'cust_main',
4494       'hashref'   => { 'custnum' => $1, %options },
4495       'extra_sql' => " AND $agentnums_sql", #agent virtualization
4496     } );
4497
4498   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
4499
4500     my($company, $last, $first) = ( $1, $2, $3 );
4501
4502     # "Company (Last, First)"
4503     #this is probably something a browser remembered,
4504     #so just do an exact search
4505
4506     foreach my $prefix ( '', 'ship_' ) {
4507       push @cust_main, qsearch( {
4508         'table'     => 'cust_main',
4509         'hashref'   => { $prefix.'first'   => $first,
4510                          $prefix.'last'    => $last,
4511                          $prefix.'company' => $company,
4512                          %options,
4513                        },
4514         'extra_sql' => " AND $agentnums_sql",
4515       } );
4516     }
4517
4518   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
4519                                               # try (ship_){last,company}
4520
4521     my $value = lc($1);
4522
4523     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
4524     # # full strings the browser remembers won't work
4525     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
4526
4527     use Lingua::EN::NameParse;
4528     my $NameParse = new Lingua::EN::NameParse(
4529              auto_clean     => 1,
4530              allow_reversed => 1,
4531     );
4532
4533     my($last, $first) = ( '', '' );
4534     #maybe disable this too and just rely on NameParse?
4535     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
4536
4537       ($last, $first) = ( $1, $2 );
4538
4539     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
4540     } elsif ( ! $NameParse->parse($value) ) {
4541
4542       my %name = $NameParse->components;
4543       $first = $name{'given_name_1'};
4544       $last  = $name{'surname_1'};
4545
4546     }
4547
4548     if ( $first && $last ) {
4549
4550       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
4551
4552       #exact
4553       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
4554       $sql .= "
4555         (     ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
4556            OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
4557         )";
4558
4559       push @cust_main, qsearch( {
4560         'table'     => 'cust_main',
4561         'hashref'   => \%options,
4562         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
4563       } );
4564
4565       # or it just be something that was typed in... (try that in a sec)
4566
4567     }
4568
4569     my $q_value = dbh->quote($value);
4570
4571     #exact
4572     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
4573     $sql .= " (    LOWER(last)         = $q_value
4574                 OR LOWER(company)      = $q_value
4575                 OR LOWER(ship_last)    = $q_value
4576                 OR LOWER(ship_company) = $q_value
4577               )";
4578
4579     push @cust_main, qsearch( {
4580       'table'     => 'cust_main',
4581       'hashref'   => \%options,
4582       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
4583     } );
4584
4585     #always do substring & fuzzy,
4586     #getting complains searches are not returning enough
4587     unless ( @cust_main && $skip_fuzzy ) {  #no exact match, trying substring/fuzzy
4588
4589       #still some false laziness w/ search/cust_main.cgi
4590
4591       #substring
4592
4593       my @hashrefs = (
4594         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
4595         { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
4596       );
4597
4598       if ( $first && $last ) {
4599
4600         push @hashrefs,
4601           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
4602             'last'         => { op=>'ILIKE', value=>"%$last%" },
4603           },
4604           { 'ship_first'   => { op=>'ILIKE', value=>"%$first%" },
4605             'ship_last'    => { op=>'ILIKE', value=>"%$last%" },
4606           },
4607         ;
4608
4609       } else {
4610
4611         push @hashrefs,
4612           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
4613           { 'ship_last'    => { op=>'ILIKE', value=>"%$value%" }, },
4614         ;
4615       }
4616
4617       foreach my $hashref ( @hashrefs ) {
4618
4619         push @cust_main, qsearch( {
4620           'table'     => 'cust_main',
4621           'hashref'   => { %$hashref,
4622                            %options,
4623                          },
4624           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
4625         } );
4626
4627       }
4628
4629       #fuzzy
4630       my @fuzopts = (
4631         \%options,                #hashref
4632         '',                       #select
4633         " AND $agentnums_sql",    #extra_sql  #agent virtualization
4634       );
4635
4636       if ( $first && $last ) {
4637         push @cust_main, FS::cust_main->fuzzy_search(
4638           { 'last'   => $last,    #fuzzy hashref
4639             'first'  => $first }, #
4640           @fuzopts
4641         );
4642       }
4643       foreach my $field ( 'last', 'company' ) {
4644         push @cust_main,
4645           FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
4646       }
4647
4648     }
4649
4650     #eliminate duplicates
4651     my %saw = ();
4652     @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
4653
4654   }
4655
4656   @cust_main;
4657
4658 }
4659
4660 =item check_and_rebuild_fuzzyfiles
4661
4662 =cut
4663
4664 use vars qw(@fuzzyfields);
4665 @fuzzyfields = ( 'last', 'first', 'company' );
4666
4667 sub check_and_rebuild_fuzzyfiles {
4668   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4669   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
4670 }
4671
4672 =item rebuild_fuzzyfiles
4673
4674 =cut
4675
4676 sub rebuild_fuzzyfiles {
4677
4678   use Fcntl qw(:flock);
4679
4680   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4681   mkdir $dir, 0700 unless -d $dir;
4682
4683   foreach my $fuzzy ( @fuzzyfields ) {
4684
4685     open(LOCK,">>$dir/cust_main.$fuzzy")
4686       or die "can't open $dir/cust_main.$fuzzy: $!";
4687     flock(LOCK,LOCK_EX)
4688       or die "can't lock $dir/cust_main.$fuzzy: $!";
4689
4690     open (CACHE,">$dir/cust_main.$fuzzy.tmp")
4691       or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
4692
4693     foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
4694       my $sth = dbh->prepare("SELECT $field FROM cust_main".
4695                              " WHERE $field != '' AND $field IS NOT NULL");
4696       $sth->execute or die $sth->errstr;
4697
4698       while ( my $row = $sth->fetchrow_arrayref ) {
4699         print CACHE $row->[0]. "\n";
4700       }
4701
4702     }
4703
4704     close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
4705
4706     rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
4707     close LOCK;
4708   }
4709
4710 }
4711
4712 =item all_X
4713
4714 =cut
4715
4716 sub all_X {
4717   my( $self, $field ) = @_;
4718   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4719   open(CACHE,"<$dir/cust_main.$field")
4720     or die "can't open $dir/cust_main.$field: $!";
4721   my @array = map { chomp; $_; } <CACHE>;
4722   close CACHE;
4723   \@array;
4724 }
4725
4726 =item append_fuzzyfiles LASTNAME COMPANY
4727
4728 =cut
4729
4730 sub append_fuzzyfiles {
4731   #my( $first, $last, $company ) = @_;
4732
4733   &check_and_rebuild_fuzzyfiles;
4734
4735   use Fcntl qw(:flock);
4736
4737   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4738
4739   foreach my $field (qw( first last company )) {
4740     my $value = shift;
4741
4742     if ( $value ) {
4743
4744       open(CACHE,">>$dir/cust_main.$field")
4745         or die "can't open $dir/cust_main.$field: $!";
4746       flock(CACHE,LOCK_EX)
4747         or die "can't lock $dir/cust_main.$field: $!";
4748
4749       print CACHE "$value\n";
4750
4751       flock(CACHE,LOCK_UN)
4752         or die "can't unlock $dir/cust_main.$field: $!";
4753       close CACHE;
4754     }
4755
4756   }
4757
4758   1;
4759 }
4760
4761 =item batch_import
4762
4763 =cut
4764
4765 sub batch_import {
4766   my $param = shift;
4767   #warn join('-',keys %$param);
4768   my $fh = $param->{filehandle};
4769   my $agentnum = $param->{agentnum};
4770
4771   my $refnum = $param->{refnum};
4772   my $pkgpart = $param->{pkgpart};
4773
4774   #my @fields = @{$param->{fields}};
4775   my $format = $param->{'format'};
4776   my @fields;
4777   my $payby;
4778   if ( $format eq 'simple' ) {
4779     @fields = qw( cust_pkg.setup dayphone first last
4780                   address1 address2 city state zip comments );
4781     $payby = 'BILL';
4782   } elsif ( $format eq 'extended' ) {
4783     @fields = qw( agent_custid refnum
4784                   last first address1 address2 city state zip country
4785                   daytime night
4786                   ship_last ship_first ship_address1 ship_address2
4787                   ship_city ship_state ship_zip ship_country
4788                   payinfo paycvv paydate
4789                   invoicing_list
4790                   cust_pkg.pkgpart
4791                   svc_acct.username svc_acct._password
4792                 );
4793     $payby = 'BILL';
4794   } else {
4795     die "unknown format $format";
4796   }
4797
4798   eval "use Text::CSV_XS;";
4799   die $@ if $@;
4800
4801   my $csv = new Text::CSV_XS;
4802   #warn $csv;
4803   #warn $fh;
4804
4805   my $imported = 0;
4806   #my $columns;
4807
4808   local $SIG{HUP} = 'IGNORE';
4809   local $SIG{INT} = 'IGNORE';
4810   local $SIG{QUIT} = 'IGNORE';
4811   local $SIG{TERM} = 'IGNORE';
4812   local $SIG{TSTP} = 'IGNORE';
4813   local $SIG{PIPE} = 'IGNORE';
4814
4815   my $oldAutoCommit = $FS::UID::AutoCommit;
4816   local $FS::UID::AutoCommit = 0;
4817   my $dbh = dbh;
4818
4819   #while ( $columns = $csv->getline($fh) ) {
4820   my $line;
4821   while ( defined($line=<$fh>) ) {
4822
4823     $csv->parse($line) or do {
4824       $dbh->rollback if $oldAutoCommit;
4825       return "can't parse: ". $csv->error_input();
4826     };
4827
4828     my @columns = $csv->fields();
4829     #warn join('-',@columns);
4830
4831     my %cust_main = (
4832       agentnum => $agentnum,
4833       refnum   => $refnum,
4834       country  => $conf->config('countrydefault') || 'US',
4835       payby    => $payby, #default
4836       paydate  => '12/2037', #default
4837     );
4838     my $billtime = time;
4839     my %cust_pkg = ( pkgpart => $pkgpart );
4840     my %svc_acct = ();
4841     foreach my $field ( @fields ) {
4842
4843       if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|adjourn|expire|cancel)$/ ) {
4844
4845         #$cust_pkg{$1} = str2time( shift @$columns );
4846         if ( $1 eq 'pkgpart' ) {
4847           $cust_pkg{$1} = shift @columns;
4848         } elsif ( $1 eq 'setup' ) {
4849           $billtime = str2time(shift @columns);
4850         } else {
4851           $cust_pkg{$1} = str2time( shift @columns );
4852         }
4853
4854       } elsif ( $field =~ /^svc_acct\.(username|_password)$/ ) {
4855
4856         $svc_acct{$1} = shift @columns;
4857
4858       } else {
4859
4860         #refnum interception
4861         if ( $field eq 'refnum' && $columns[0] !~ /^\s*(\d+)\s*$/ ) {
4862
4863           my $referral = $columns[0];
4864           my %hash = ( 'referral' => $referral,
4865                        'agentnum' => $agentnum,
4866                        'disabled' => '',
4867                      );
4868
4869           my $part_referral = qsearchs('part_referral', \%hash )
4870                               || new FS::part_referral \%hash;
4871
4872           unless ( $part_referral->refnum ) {
4873             my $error = $part_referral->insert;
4874             if ( $error ) {
4875               $dbh->rollback if $oldAutoCommit;
4876               return "can't auto-insert advertising source: $referral: $error";
4877             }
4878           }
4879
4880           $columns[0] = $part_referral->refnum;
4881         }
4882
4883         #$cust_main{$field} = shift @$columns;
4884         $cust_main{$field} = shift @columns;
4885       }
4886     }
4887
4888     $cust_main{'payby'} = 'CARD' if length($cust_main{'payinfo'});
4889
4890     my $invoicing_list = $cust_main{'invoicing_list'}
4891                            ? [ delete $cust_main{'invoicing_list'} ]
4892                            : [];
4893
4894     my $cust_main = new FS::cust_main ( \%cust_main );
4895
4896     use Tie::RefHash;
4897     tie my %hash, 'Tie::RefHash'; #this part is important
4898
4899     if ( $cust_pkg{'pkgpart'} ) {
4900       my $cust_pkg = new FS::cust_pkg ( \%cust_pkg );
4901
4902       my @svc_acct = ();
4903       if ( $svc_acct{'username'} ) {
4904         my $part_pkg = $cust_pkg->part_pkg;
4905         unless ( $part_pkg ) {
4906           $dbh->rollback if $oldAutoCommit;
4907           return "unknown pkgpart: ". $cust_pkg{'pkgpart'};
4908         }
4909         $svc_acct{svcpart} = $part_pkg->svcpart( 'svc_acct' );
4910         push @svc_acct, new FS::svc_acct ( \%svc_acct )
4911       }
4912
4913       $hash{$cust_pkg} = \@svc_acct;
4914     }
4915
4916     my $error = $cust_main->insert( \%hash, $invoicing_list );
4917
4918     if ( $error ) {
4919       $dbh->rollback if $oldAutoCommit;
4920       return "can't insert customer for $line: $error";
4921     }
4922
4923     if ( $format eq 'simple' ) {
4924
4925       #false laziness w/bill.cgi
4926       $error = $cust_main->bill( 'time' => $billtime );
4927       if ( $error ) {
4928         $dbh->rollback if $oldAutoCommit;
4929         return "can't bill customer for $line: $error";
4930       }
4931
4932       $error = $cust_main->apply_payments_and_credits;
4933       if ( $error ) {
4934         $dbh->rollback if $oldAutoCommit;
4935         return "can't bill customer for $line: $error";
4936       }
4937
4938       $error = $cust_main->collect();
4939       if ( $error ) {
4940         $dbh->rollback if $oldAutoCommit;
4941         return "can't collect customer for $line: $error";
4942       }
4943
4944     }
4945
4946     $imported++;
4947   }
4948
4949   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4950
4951   return "Empty file!" unless $imported;
4952
4953   ''; #no error
4954
4955 }
4956
4957 =item batch_charge
4958
4959 =cut
4960
4961 sub batch_charge {
4962   my $param = shift;
4963   #warn join('-',keys %$param);
4964   my $fh = $param->{filehandle};
4965   my @fields = @{$param->{fields}};
4966
4967   eval "use Text::CSV_XS;";
4968   die $@ if $@;
4969
4970   my $csv = new Text::CSV_XS;
4971   #warn $csv;
4972   #warn $fh;
4973
4974   my $imported = 0;
4975   #my $columns;
4976
4977   local $SIG{HUP} = 'IGNORE';
4978   local $SIG{INT} = 'IGNORE';
4979   local $SIG{QUIT} = 'IGNORE';
4980   local $SIG{TERM} = 'IGNORE';
4981   local $SIG{TSTP} = 'IGNORE';
4982   local $SIG{PIPE} = 'IGNORE';
4983
4984   my $oldAutoCommit = $FS::UID::AutoCommit;
4985   local $FS::UID::AutoCommit = 0;
4986   my $dbh = dbh;
4987
4988   #while ( $columns = $csv->getline($fh) ) {
4989   my $line;
4990   while ( defined($line=<$fh>) ) {
4991
4992     $csv->parse($line) or do {
4993       $dbh->rollback if $oldAutoCommit;
4994       return "can't parse: ". $csv->error_input();
4995     };
4996
4997     my @columns = $csv->fields();
4998     #warn join('-',@columns);
4999
5000     my %row = ();
5001     foreach my $field ( @fields ) {
5002       $row{$field} = shift @columns;
5003     }
5004
5005     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
5006     unless ( $cust_main ) {
5007       $dbh->rollback if $oldAutoCommit;
5008       return "unknown custnum $row{'custnum'}";
5009     }
5010
5011     if ( $row{'amount'} > 0 ) {
5012       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
5013       if ( $error ) {
5014         $dbh->rollback if $oldAutoCommit;
5015         return $error;
5016       }
5017       $imported++;
5018     } elsif ( $row{'amount'} < 0 ) {
5019       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
5020                                       $row{'pkg'}                         );
5021       if ( $error ) {
5022         $dbh->rollback if $oldAutoCommit;
5023         return $error;
5024       }
5025       $imported++;
5026     } else {
5027       #hmm?
5028     }
5029
5030   }
5031
5032   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5033
5034   return "Empty file!" unless $imported;
5035
5036   ''; #no error
5037
5038 }
5039
5040 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5041
5042 Sends a templated email notification to the customer (see L<Text::Template>).
5043
5044 OPTIONS is a hash and may include
5045
5046 I<from> - the email sender (default is invoice_from)
5047
5048 I<to> - comma-separated scalar or arrayref of recipients
5049    (default is invoicing_list)
5050
5051 I<subject> - The subject line of the sent email notification
5052    (default is "Notice from company_name")
5053
5054 I<extra_fields> - a hashref of name/value pairs which will be substituted
5055    into the template
5056
5057 The following variables are vavailable in the template.
5058
5059 I<$first> - the customer first name
5060 I<$last> - the customer last name
5061 I<$company> - the customer company
5062 I<$payby> - a description of the method of payment for the customer
5063             # would be nice to use FS::payby::shortname
5064 I<$payinfo> - the account information used to collect for this customer
5065 I<$expdate> - the expiration of the customer payment in seconds from epoch
5066
5067 =cut
5068
5069 sub notify {
5070   my ($customer, $template, %options) = @_;
5071
5072   return unless $conf->exists($template);
5073
5074   my $from = $conf->config('invoice_from') if $conf->exists('invoice_from');
5075   $from = $options{from} if exists($options{from});
5076
5077   my $to = join(',', $customer->invoicing_list_emailonly);
5078   $to = $options{to} if exists($options{to});
5079
5080   my $subject = "Notice from " . $conf->config('company_name')
5081     if $conf->exists('company_name');
5082   $subject = $options{subject} if exists($options{subject});
5083
5084   my $notify_template = new Text::Template (TYPE => 'ARRAY',
5085                                             SOURCE => [ map "$_\n",
5086                                               $conf->config($template)]
5087                                            )
5088     or die "can't create new Text::Template object: Text::Template::ERROR";
5089   $notify_template->compile()
5090     or die "can't compile template: Text::Template::ERROR";
5091
5092   my $paydate = $customer->paydate;
5093   $FS::notify_template::_template::first = $customer->first;
5094   $FS::notify_template::_template::last = $customer->last;
5095   $FS::notify_template::_template::company = $customer->company;
5096   $FS::notify_template::_template::payinfo = $customer->mask_payinfo;
5097   my $payby = $customer->payby;
5098   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5099   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5100
5101   #credit cards expire at the end of the month/year of their exp date
5102   if ($payby eq 'CARD' || $payby eq 'DCRD') {
5103     $FS::notify_template::_template::payby = 'credit card';
5104     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5105     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5106     $expire_time--;
5107   }elsif ($payby eq 'COMP') {
5108     $FS::notify_template::_template::payby = 'complimentary account';
5109   }else{
5110     $FS::notify_template::_template::payby = 'current method';
5111   }
5112   $FS::notify_template::_template::expdate = $expire_time;
5113
5114   for (keys %{$options{extra_fields}}){
5115     no strict "refs";
5116     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
5117   }
5118
5119   send_email(from => $from,
5120              to => $to,
5121              subject => $subject,
5122              body => $notify_template->fill_in( PACKAGE =>
5123                                                 'FS::notify_template::_template'                                              ),
5124             );
5125
5126 }
5127
5128 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5129
5130 Generates a templated notification to the customer (see L<Text::Template>).
5131
5132 OPTIONS is a hash and may include
5133
5134 I<extra_fields> - a hashref of name/value pairs which will be substituted
5135    into the template.  These values may override values mentioned below
5136    and those from the customer record.
5137
5138 The following variables are available in the template instead of or in addition
5139 to the fields of the customer record.
5140
5141 I<$payby> - a description of the method of payment for the customer
5142             # would be nice to use FS::payby::shortname
5143 I<$payinfo> - the masked account information used to collect for this customer
5144 I<$expdate> - the expiration of the customer payment method in seconds from epoch
5145 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress
5146
5147 =cut
5148
5149 sub generate_letter {
5150   my ($self, $template, %options) = @_;
5151
5152   return unless $conf->exists($template);
5153
5154   my $letter_template = new Text::Template
5155                         ( TYPE       => 'ARRAY',
5156                           SOURCE     => [ map "$_\n", $conf->config($template)],
5157                           DELIMITERS => [ '[@--', '--@]' ],
5158                         )
5159     or die "can't create new Text::Template object: Text::Template::ERROR";
5160
5161   $letter_template->compile()
5162     or die "can't compile template: Text::Template::ERROR";
5163
5164   my %letter_data = map { $_ => $self->$_ } $self->fields;
5165   $letter_data{payinfo} = $self->mask_payinfo;
5166
5167   my $paydate = $self->paydate || '2037-12';
5168   my $payby = $self->payby;
5169   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5170   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5171
5172   #credit cards expire at the end of the month/year of their exp date
5173   if ($payby eq 'CARD' || $payby eq 'DCRD') {
5174     $letter_data{payby} = 'credit card';
5175     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5176     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5177     $expire_time--;
5178   }elsif ($payby eq 'COMP') {
5179     $letter_data{payby} = 'complimentary account';
5180   }else{
5181     $letter_data{payby} = 'current method';
5182   }
5183   $letter_data{expdate} = $expire_time;
5184
5185   for (keys %{$options{extra_fields}}){
5186     $letter_data{$_} = $options{extra_fields}->{$_};
5187   }
5188
5189   unless(exists($letter_data{returnaddress})){
5190     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
5191                                                   $self->_agent_template)
5192                      );
5193
5194     $letter_data{returnaddress} = length($retadd) ? $retadd : '~';
5195   }
5196
5197   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
5198
5199   my $dir = $FS::UID::conf_dir."cache.". $FS::UID::datasrc;
5200   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5201                            DIR      => $dir,
5202                            SUFFIX   => '.tex',
5203                            UNLINK   => 0,
5204                          ) or die "can't open temp file: $!\n";
5205
5206   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
5207   close $fh;
5208   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
5209   return $1;
5210 }
5211
5212 =item print_ps TEMPLATE
5213
5214 Returns an postscript letter filled in from TEMPLATE, as a scalar.
5215
5216 =cut
5217
5218 sub print_ps {
5219   my $self = shift;
5220   my $file = $self->generate_letter(@_);
5221   FS::Misc::generate_ps($file);
5222 }
5223
5224 =item print TEMPLATE
5225
5226 Prints the filled in template.
5227
5228 TEMPLATE is the name of a L<Text::Template> to fill in and print.
5229
5230 =cut
5231
5232 sub queueable_print {
5233   my %opt = @_;
5234
5235   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
5236     or die "invalid customer number: " . $opt{custvnum};
5237
5238   my $error = $self->print( $opt{template} );
5239   die $error if $error;
5240 }
5241
5242 sub print {
5243   my ($self, $template) = (shift, shift);
5244   do_print [ $self->print_ps($template) ];
5245 }
5246
5247 sub agent_template {
5248   my $self = shift;
5249   $self->_agent_plandata('agent_templatename');
5250 }
5251
5252 sub agent_invoice_from {
5253   my $self = shift;
5254   $self->_agent_plandata('agent_invoice_from');
5255 }
5256
5257 sub _agent_plandata {
5258   my( $self, $option ) = @_;
5259
5260   my $part_bill_event = qsearchs( 'part_bill_event',
5261     {
5262       'payby'     => $self->payby,
5263       'plan'      => 'send_agent',
5264       'plandata'  => { 'op'    => '~',
5265                        'value' => "(^|\n)agentnum ".
5266                                    '([0-9]*, )*'.
5267                                   $self->agentnum.
5268                                    '(, [0-9]*)*'.
5269                                   "(\n|\$)",
5270                      },
5271     },
5272     '',
5273     'ORDER BY seconds LIMIT 1'
5274   );
5275
5276   return '' unless $part_bill_event;
5277
5278   if ( $part_bill_event->plandata =~ /^$option (.*)$/m ) {
5279     return $1;
5280   } else {
5281     warn "can't parse part_bill_event eventpart#". $part_bill_event->eventpart.
5282          " plandata for $option";
5283     return '';
5284   }
5285
5286 }
5287
5288 =back
5289
5290 =head1 BUGS
5291
5292 The delete method.
5293
5294 The delete method should possibly take an FS::cust_main object reference
5295 instead of a scalar customer number.
5296
5297 Bill and collect options should probably be passed as references instead of a
5298 list.
5299
5300 There should probably be a configuration file with a list of allowed credit
5301 card types.
5302
5303 No multiple currency support (probably a larger project than just this module).
5304
5305 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5306
5307 Birthdates rely on negative epoch values.
5308
5309 The payby for card/check batches is broken.  With mixed batching, bad
5310 things will happen.
5311
5312 =head1 SEE ALSO
5313
5314 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5315 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5316 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
5317
5318 =cut
5319
5320 1;
5321