FS/FS/cust_main.pm

   1 package FS::cust_main;
   2
   3 require 5.006;
   4 use strict;
   5 use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields
   6              $import $skip_fuzzyfiles $ignore_expired_card @paytypes);
   7 use vars qw( $realtime_bop_decline_quiet ); #ugh
   8 use Safe;
   9 use Carp;
  10 use Exporter;
  11 use Scalar::Util qw( blessed );
  12 use Time::Local qw(timelocal_nocheck);
  13 use Data::Dumper;
  14 use Tie::IxHash;
  15 use Digest::MD5 qw(md5_base64);
  16 use Date::Format;
  17 use Date::Parse;
  18 #use Date::Manip;
  19 use File::Slurp qw( slurp );
  20 use File::Temp qw( tempfile );
  21 use String::Approx qw(amatch);
  22 use Business::CreditCard 0.28;
  23 use Locale::Country;
  24 use FS::UID qw( getotaker dbh driver_name );
  25 use FS::Record qw( qsearchs qsearch dbdef );
  26 use FS::Misc qw( generate_email send_email generate_ps do_print );
  27 use FS::Msgcat qw(gettext);
  28 use FS::cust_pkg;
  29 use FS::cust_svc;
  30 use FS::cust_bill;
  31 use FS::cust_bill_pkg;
  32 use FS::cust_pay;
  33 use FS::cust_pay_pending;
  34 use FS::cust_pay_void;
  35 use FS::cust_pay_batch;
  36 use FS::cust_credit;
  37 use FS::cust_refund;
  38 use FS::part_referral;
  39 use FS::cust_main_county;
  40 use FS::cust_tax_location;
  41 use FS::agent;
  42 use FS::cust_main_invoice;
  43 use FS::cust_credit_bill;
  44 use FS::cust_bill_pay;
  45 use FS::prepay_credit;
  46 use FS::queue;
  47 use FS::part_pkg;
  48 use FS::part_event;
  49 use FS::part_event_condition;
  50 #use FS::cust_event;
  51 use FS::type_pkgs;
  52 use FS::payment_gateway;
  53 use FS::agent_payment_gateway;
  54 use FS::banned_pay;
  55 use FS::payinfo_Mixin;
  56 use FS::TicketSystem;
  57
  58 @ISA = qw( FS::payinfo_Mixin FS::Record );
  59
  60 @EXPORT_OK = qw( smart_search );
  61
  62 $realtime_bop_decline_quiet = 0;
  63
  64 # 1 is mostly method/subroutine entry and options
  65 # 2 traces progress of some operations
  66 # 3 is even more information including possibly sensitive data
  67 $DEBUG = 0;
  68 $me = '[FS::cust_main]';
  69
  70 $import = 0;
  71 $skip_fuzzyfiles = 0;
  72 $ignore_expired_card = 0;
  73
  74 @encrypted_fields = ('payinfo', 'paycvv');
  75 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
  76
  77 #ask FS::UID to run this stuff for us later
  78 #$FS::UID::callback{'FS::cust_main'} = sub {
  79 install_callback FS::UID sub {
  80   $conf = new FS::Conf;
  81   #yes, need it for stuff below (prolly should be cached)
  82 };
  83
  84 sub _cache {
  85   my $self = shift;
  86   my ( $hashref, $cache ) = @_;
  87   if ( exists $hashref->{'pkgnum'} ) {
  88     #@{ $self->{'_pkgnum'} } = ();
  89     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
  90     $self->{'_pkgnum'} = $subcache;
  91     #push @{ $self->{'_pkgnum'} },
  92     FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
  93   }
  94 }
  95
  96 =head1 NAME
  97
  98 FS::cust_main - Object methods for cust_main records
  99
 100 =head1 SYNOPSIS
 101
 102   use FS::cust_main;
 103
 104   $record = new FS::cust_main \%hash;
 105   $record = new FS::cust_main { 'column' => 'value' };
 106
 107   $error = $record->insert;
 108
 109   $error = $new_record->replace($old_record);
 110
 111   $error = $record->delete;
 112
 113   $error = $record->check;
 114
 115   @cust_pkg = $record->all_pkgs;
 116
 117   @cust_pkg = $record->ncancelled_pkgs;
 118
 119   @cust_pkg = $record->suspended_pkgs;
 120
 121   $error = $record->bill;
 122   $error = $record->bill %options;
 123   $error = $record->bill 'time' => $time;
 124
 125   $error = $record->collect;
 126   $error = $record->collect %options;
 127   $error = $record->collect 'invoice_time'   => $time,
 128                           ;
 129
 130 =head1 DESCRIPTION
 131
 132 An FS::cust_main object represents a customer.  FS::cust_main inherits from
 133 FS::Record.  The following fields are currently supported:
 134
 135 =over 4
 136
 137 =item custnum - primary key (assigned automatically for new customers)
 138
 139 =item agentnum - agent (see L<FS::agent>)
 140
 141 =item refnum - Advertising source (see L<FS::part_referral>)
 142
 143 =item first - name
 144
 145 =item last - name
 146
 147 =item ss - social security number (optional)
 148
 149 =item company - (optional)
 150
 151 =item address1
 152
 153 =item address2 - (optional)
 154
 155 =item city
 156
 157 =item county - (optional, see L<FS::cust_main_county>)
 158
 159 =item state - (see L<FS::cust_main_county>)
 160
 161 =item zip
 162
 163 =item country - (see L<FS::cust_main_county>)
 164
 165 =item daytime - phone (optional)
 166
 167 =item night - phone (optional)
 168
 169 =item fax - phone (optional)
 170
 171 =item ship_first - name
 172
 173 =item ship_last - name
 174
 175 =item ship_company - (optional)
 176
 177 =item ship_address1
 178
 179 =item ship_address2 - (optional)
 180
 181 =item ship_city
 182
 183 =item ship_county - (optional, see L<FS::cust_main_county>)
 184
 185 =item ship_state - (see L<FS::cust_main_county>)
 186
 187 =item ship_zip
 188
 189 =item ship_country - (see L<FS::cust_main_county>)
 190
 191 =item ship_daytime - phone (optional)
 192
 193 =item ship_night - phone (optional)
 194
 195 =item ship_fax - phone (optional)
 196
 197 =item payby - Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
 198
 199 =item payinfo - Payment Information (See L<FS::payinfo_Mixin> for data format)
 200
 201 =item paymask - Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
 202
 203 =item paycvv
 204
 205 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
 206
 207 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 208
 209 =item paystart_month - start date month (maestro/solo cards only)
 210
 211 =item paystart_year - start date year (maestro/solo cards only)
 212
 213 =item payissue - issue number (maestro/solo cards only)
 214
 215 =item payname - name on card or billing name
 216
 217 =item payip - IP address from which payment information was received
 218
 219 =item tax - tax exempt, empty or `Y'
 220
 221 =item otaker - order taker (assigned automatically, see L<FS::UID>)
 222
 223 =item comments - comments (optional)
 224
 225 =item referral_custnum - referring customer number
 226
 227 =item spool_cdr - Enable individual CDR spooling, empty or `Y'
 228
 229 =item squelch_cdr - Discourage individual CDR printing, empty or `Y'
 230
 231 =back
 232
 233 =head1 METHODS
 234
 235 =over 4
 236
 237 =item new HASHREF
 238
 239 Creates a new customer.  To add the customer to the database, see L<"insert">.
 240
 241 Note that this stores the hash reference, not a distinct copy of the hash it
 242 points to.  You can ask the object for a copy with the I<hash> method.
 243
 244 =cut
 245
 246 sub table { 'cust_main'; }
 247
 248 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
 249
 250 Adds this customer to the database.  If there is an error, returns the error,
 251 otherwise returns false.
 252
 253 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
 254 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
 255 are inserted atomicly, or the transaction is rolled back.  Passing an empty
 256 hash reference is equivalent to not supplying this parameter.  There should be
 257 a better explanation of this, but until then, here's an example:
 258
 259   use Tie::RefHash;
 260   tie %hash, 'Tie::RefHash'; #this part is important
 261   %hash = (
 262     $cust_pkg => [ $svc_acct ],
 263     ...
 264   );
 265   $cust_main->insert( \%hash );
 266
 267 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 268 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 269 expected and rollback the entire transaction; it is not necessary to call
 270 check_invoicing_list first.  The invoicing_list is set after the records in the
 271 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
 272 invoicing_list destination to the newly-created svc_acct.  Here's an example:
 273
 274   $cust_main->insert( {}, [ $email, 'POST' ] );
 275
 276 Currently available options are: I<depend_jobnum> and I<noexport>.
 277
 278 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 279 on the supplied jobnum (they will not run until the specific job completes).
 280 This can be used to defer provisioning until some action completes (such
 281 as running the customer's credit card successfully).
 282
 283 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 284 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 285 the B<reexport> method.)
 286
 287 =cut
 288
 289 sub insert {
 290   my $self = shift;
 291   my $cust_pkgs = @_ ? shift : {};
 292   my $invoicing_list = @_ ? shift : '';
 293   my %options = @_;
 294   warn "$me insert called with options ".
 295        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 296     if $DEBUG;
 297
 298   local $SIG{HUP} = 'IGNORE';
 299   local $SIG{INT} = 'IGNORE';
 300   local $SIG{QUIT} = 'IGNORE';
 301   local $SIG{TERM} = 'IGNORE';
 302   local $SIG{TSTP} = 'IGNORE';
 303   local $SIG{PIPE} = 'IGNORE';
 304
 305   my $oldAutoCommit = $FS::UID::AutoCommit;
 306   local $FS::UID::AutoCommit = 0;
 307   my $dbh = dbh;
 308
 309   my $prepay_identifier = '';
 310   my( $amount, $seconds ) = ( 0, 0 );
 311   my $payby = '';
 312   if ( $self->payby eq 'PREPAY' ) {
 313
 314     $self->payby('BILL');
 315     $prepay_identifier = $self->payinfo;
 316     $self->payinfo('');
 317
 318     warn "  looking up prepaid card $prepay_identifier\n"
 319       if $DEBUG > 1;
 320
 321     my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds);
 322     if ( $error ) {
 323       $dbh->rollback if $oldAutoCommit;
 324       #return "error applying prepaid card (transaction rolled back): $error";
 325       return $error;
 326     }
 327
 328     $payby = 'PREP' if $amount;
 329
 330   } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
 331
 332     $payby = $1;
 333     $self->payby('BILL');
 334     $amount = $self->paid;
 335
 336   }
 337
 338   warn "  inserting $self\n"
 339     if $DEBUG > 1;
 340
 341   $self->signupdate(time) unless $self->signupdate;
 342
 343   my $error = $self->SUPER::insert;
 344   if ( $error ) {
 345     $dbh->rollback if $oldAutoCommit;
 346     #return "inserting cust_main record (transaction rolled back): $error";
 347     return $error;
 348   }
 349
 350   warn "  setting invoicing list\n"
 351     if $DEBUG > 1;
 352
 353   if ( $invoicing_list ) {
 354     $error = $self->check_invoicing_list( $invoicing_list );
 355     if ( $error ) {
 356       $dbh->rollback if $oldAutoCommit;
 357       #return "checking invoicing_list (transaction rolled back): $error";
 358       return $error;
 359     }
 360     $self->invoicing_list( $invoicing_list );
 361   }
 362
 363   if (    $conf->config('cust_main-skeleton_tables')
 364        && $conf->config('cust_main-skeleton_custnum') ) {
 365
 366     warn "  inserting skeleton records\n"
 367       if $DEBUG > 1;
 368
 369     my $error = $self->start_copy_skel;
 370     if ( $error ) {
 371       $dbh->rollback if $oldAutoCommit;
 372       return $error;
 373     }
 374
 375   }
 376
 377   warn "  ordering packages\n"
 378     if $DEBUG > 1;
 379
 380   $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
 381   if ( $error ) {
 382     $dbh->rollback if $oldAutoCommit;
 383     return $error;
 384   }
 385
 386   if ( $seconds ) {
 387     $dbh->rollback if $oldAutoCommit;
 388     return "No svc_acct record to apply pre-paid time";
 389   }
 390
 391   if ( $amount ) {
 392     warn "  inserting initial $payby payment of $amount\n"
 393       if $DEBUG > 1;
 394     $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
 395     if ( $error ) {
 396       $dbh->rollback if $oldAutoCommit;
 397       return "inserting payment (transaction rolled back): $error";
 398     }
 399   }
 400
 401   unless ( $import || $skip_fuzzyfiles ) {
 402     warn "  queueing fuzzyfiles update\n"
 403       if $DEBUG > 1;
 404     $error = $self->queue_fuzzyfiles_update;
 405     if ( $error ) {
 406       $dbh->rollback if $oldAutoCommit;
 407       return "updating fuzzy search cache: $error";
 408     }
 409   }
 410
 411   warn "  insert complete; committing transaction\n"
 412     if $DEBUG > 1;
 413
 414   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 415   '';
 416
 417 }
 418
 419 sub start_copy_skel {
 420   my $self = shift;
 421
 422   #'mg_user_preference' => {},
 423   #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
 424   #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
 425   #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
 426   #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
 427   my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
 428   die $@ if $@;
 429
 430   _copy_skel( 'cust_main',                                 #tablename
 431               $conf->config('cust_main-skeleton_custnum'), #sourceid
 432               $self->custnum,                              #destid
 433               @tables,                                     #child tables
 434             );
 435 }
 436
 437 #recursive subroutine, not a method
 438 sub _copy_skel {
 439   my( $table, $sourceid, $destid, %child_tables ) = @_;
 440
 441   my $primary_key;
 442   if ( $table =~ /^(\w+)\.(\w+)$/ ) {
 443     ( $table, $primary_key ) = ( $1, $2 );
 444   } else {
 445     my $dbdef_table = dbdef->table($table);
 446     $primary_key = $dbdef_table->primary_key
 447       or return "$table has no primary key".
 448                 " (or do you need to run dbdef-create?)";
 449   }
 450
 451   warn "  _copy_skel: $table.$primary_key $sourceid to $destid for ".
 452        join (', ', keys %child_tables). "\n"
 453     if $DEBUG > 2;
 454
 455   foreach my $child_table_def ( keys %child_tables ) {
 456
 457     my $child_table;
 458     my $child_pkey = '';
 459     if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
 460       ( $child_table, $child_pkey ) = ( $1, $2 );
 461     } else {
 462       $child_table = $child_table_def;
 463
 464       $child_pkey = dbdef->table($child_table)->primary_key;
 465       #  or return "$table has no primary key".
 466       #            " (or do you need to run dbdef-create?)\n";
 467     }
 468
 469     my $sequence = '';
 470     if ( keys %{ $child_tables{$child_table_def} } ) {
 471
 472       return "$child_table has no primary key".
 473              " (run dbdef-create or try specifying it?)\n"
 474         unless $child_pkey;
 475
 476       #false laziness w/Record::insert and only works on Pg
 477       #refactor the proper last-inserted-id stuff out of Record::insert if this
 478       # ever gets use for anything besides a quick kludge for one customer
 479       my $default = dbdef->table($child_table)->column($child_pkey)->default;
 480       $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
 481         or return "can't parse $child_table.$child_pkey default value ".
 482                   " for sequence name: $default";
 483       $sequence = $1;
 484
 485     }
 486
 487     my @sel_columns = grep { $_ ne $primary_key }
 488                            dbdef->table($child_table)->columns;
 489     my $sel_columns = join(', ', @sel_columns );
 490
 491     my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
 492     my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
 493     my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
 494
 495     my $sel_st = "SELECT $sel_columns FROM $child_table".
 496                  " WHERE $primary_key = $sourceid";
 497     warn "    $sel_st\n"
 498       if $DEBUG > 2;
 499     my $sel_sth = dbh->prepare( $sel_st )
 500       or return dbh->errstr;
 501
 502     $sel_sth->execute or return $sel_sth->errstr;
 503
 504     while ( my $row = $sel_sth->fetchrow_hashref ) {
 505
 506       warn "    selected row: ".
 507            join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
 508         if $DEBUG > 2;
 509
 510       my $statement =
 511         "INSERT INTO $child_table $ins_columns VALUES $placeholders";
 512       my $ins_sth =dbh->prepare($statement)
 513           or return dbh->errstr;
 514       my @param = ( $destid, map $row->{$_}, @ins_columns );
 515       warn "    $statement: [ ". join(', ', @param). " ]\n"
 516         if $DEBUG > 2;
 517       $ins_sth->execute( @param )
 518         or return $ins_sth->errstr;
 519
 520       #next unless keys %{ $child_tables{$child_table} };
 521       next unless $sequence;
 522
 523       #another section of that laziness
 524       my $seq_sql = "SELECT currval('$sequence')";
 525       my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
 526       $seq_sth->execute or return $seq_sth->errstr;
 527       my $insertid = $seq_sth->fetchrow_arrayref->[0];
 528
 529       # don't drink soap!  recurse!  recurse!  okay!
 530       my $error =
 531         _copy_skel( $child_table_def,
 532                     $row->{$child_pkey}, #sourceid
 533                     $insertid, #destid
 534                     %{ $child_tables{$child_table_def} },
 535                   );
 536       return $error if $error;
 537
 538     }
 539
 540   }
 541
 542   return '';
 543
 544 }
 545
 546 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
 547
 548 Like the insert method on an existing record, this method orders a package
 549 and included services atomicaly.  Pass a Tie::RefHash data structure to this
 550 method containing FS::cust_pkg and FS::svc_I<tablename> objects.  There should
 551 be a better explanation of this, but until then, here's an example:
 552
 553   use Tie::RefHash;
 554   tie %hash, 'Tie::RefHash'; #this part is important
 555   %hash = (
 556     $cust_pkg => [ $svc_acct ],
 557     ...
 558   );
 559   $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
 560
 561 Services can be new, in which case they are inserted, or existing unaudited
 562 services, in which case they are linked to the newly-created package.
 563
 564 Currently available options are: I<depend_jobnum> and I<noexport>.
 565
 566 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 567 on the supplied jobnum (they will not run until the specific job completes).
 568 This can be used to defer provisioning until some action completes (such
 569 as running the customer's credit card successfully).
 570
 571 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 572 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 573 the B<reexport> method for each cust_pkg object.  Using the B<reexport> method
 574 on the cust_main object is not recommended, as existing services will also be
 575 reexported.)
 576
 577 =cut
 578
 579 sub order_pkgs {
 580   my $self = shift;
 581   my $cust_pkgs = shift;
 582   my $seconds = shift;
 583   my %options = @_;
 584   my %svc_options = ();
 585   $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
 586     if exists $options{'depend_jobnum'};
 587   warn "$me order_pkgs called with options ".
 588        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 589     if $DEBUG;
 590
 591   local $SIG{HUP} = 'IGNORE';
 592   local $SIG{INT} = 'IGNORE';
 593   local $SIG{QUIT} = 'IGNORE';
 594   local $SIG{TERM} = 'IGNORE';
 595   local $SIG{TSTP} = 'IGNORE';
 596   local $SIG{PIPE} = 'IGNORE';
 597
 598   my $oldAutoCommit = $FS::UID::AutoCommit;
 599   local $FS::UID::AutoCommit = 0;
 600   my $dbh = dbh;
 601
 602   local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
 603
 604   foreach my $cust_pkg ( keys %$cust_pkgs ) {
 605     $cust_pkg->custnum( $self->custnum );
 606     my $error = $cust_pkg->insert;
 607     if ( $error ) {
 608       $dbh->rollback if $oldAutoCommit;
 609       return "inserting cust_pkg (transaction rolled back): $error";
 610     }
 611     foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
 612       if ( $svc_something->svcnum ) {
 613         my $old_cust_svc = $svc_something->cust_svc;
 614         my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
 615         $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
 616         $error = $new_cust_svc->replace($old_cust_svc);
 617       } else {
 618         $svc_something->pkgnum( $cust_pkg->pkgnum );
 619         if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
 620           $svc_something->seconds( $svc_something->seconds + $$seconds );
 621           $$seconds = 0;
 622         }
 623         $error = $svc_something->insert(%svc_options);
 624       }
 625       if ( $error ) {
 626         $dbh->rollback if $oldAutoCommit;
 627         #return "inserting svc_ (transaction rolled back): $error";
 628         return $error;
 629       }
 630     }
 631   }
 632
 633   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 634   ''; #no error
 635 }
 636
 637 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
 638
 639 Recharges this (existing) customer with the specified prepaid card (see
 640 L<FS::prepay_credit>), specified either by I<identifier> or as an
 641 FS::prepay_credit object.  If there is an error, returns the error, otherwise
 642 returns false.
 643
 644 Optionally, four scalar references can be passed as well.  They will have their
 645 values filled in with the amount, number of seconds, and number of upload and
 646 download bytes applied by this prepaid
 647 card.
 648
 649 =cut
 650
 651 sub recharge_prepay {
 652   my( $self, $prepay_credit, $amountref, $secondsref,
 653       $upbytesref, $downbytesref, $totalbytesref ) = @_;
 654
 655   local $SIG{HUP} = 'IGNORE';
 656   local $SIG{INT} = 'IGNORE';
 657   local $SIG{QUIT} = 'IGNORE';
 658   local $SIG{TERM} = 'IGNORE';
 659   local $SIG{TSTP} = 'IGNORE';
 660   local $SIG{PIPE} = 'IGNORE';
 661
 662   my $oldAutoCommit = $FS::UID::AutoCommit;
 663   local $FS::UID::AutoCommit = 0;
 664   my $dbh = dbh;
 665
 666   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
 667
 668   my $error = $self->get_prepay($prepay_credit, \$amount,
 669                                 \$seconds, \$upbytes, \$downbytes, \$totalbytes)
 670            || $self->increment_seconds($seconds)
 671            || $self->increment_upbytes($upbytes)
 672            || $self->increment_downbytes($downbytes)
 673            || $self->increment_totalbytes($totalbytes)
 674            || $self->insert_cust_pay_prepay( $amount,
 675                                              ref($prepay_credit)
 676                                                ? $prepay_credit->identifier
 677                                                : $prepay_credit
 678                                            );
 679
 680   if ( $error ) {
 681     $dbh->rollback if $oldAutoCommit;
 682     return $error;
 683   }
 684
 685   if ( defined($amountref)  ) { $$amountref  = $amount;  }
 686   if ( defined($secondsref) ) { $$secondsref = $seconds; }
 687   if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
 688   if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
 689   if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
 690
 691   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 692   '';
 693
 694 }
 695
 696 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF
 697
 698 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
 699 specified either by I<identifier> or as an FS::prepay_credit object.
 700
 701 References to I<amount> and I<seconds> scalars should be passed as arguments
 702 and will be incremented by the values of the prepaid card.
 703
 704 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
 705 check or set this customer's I<agentnum>.
 706
 707 If there is an error, returns the error, otherwise returns false.
 708
 709 =cut
 710
 711
 712 sub get_prepay {
 713   my( $self, $prepay_credit, $amountref, $secondsref,
 714       $upref, $downref, $totalref) = @_;
 715
 716   local $SIG{HUP} = 'IGNORE';
 717   local $SIG{INT} = 'IGNORE';
 718   local $SIG{QUIT} = 'IGNORE';
 719   local $SIG{TERM} = 'IGNORE';
 720   local $SIG{TSTP} = 'IGNORE';
 721   local $SIG{PIPE} = 'IGNORE';
 722
 723   my $oldAutoCommit = $FS::UID::AutoCommit;
 724   local $FS::UID::AutoCommit = 0;
 725   my $dbh = dbh;
 726
 727   unless ( ref($prepay_credit) ) {
 728
 729     my $identifier = $prepay_credit;
 730
 731     $prepay_credit = qsearchs(
 732       'prepay_credit',
 733       { 'identifier' => $prepay_credit },
 734       '',
 735       'FOR UPDATE'
 736     );
 737
 738     unless ( $prepay_credit ) {
 739       $dbh->rollback if $oldAutoCommit;
 740       return "Invalid prepaid card: ". $identifier;
 741     }
 742
 743   }
 744
 745   if ( $prepay_credit->agentnum ) {
 746     if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
 747       $dbh->rollback if $oldAutoCommit;
 748       return "prepaid card not valid for agent ". $self->agentnum;
 749     }
 750     $self->agentnum($prepay_credit->agentnum);
 751   }
 752
 753   my $error = $prepay_credit->delete;
 754   if ( $error ) {
 755     $dbh->rollback if $oldAutoCommit;
 756     return "removing prepay_credit (transaction rolled back): $error";
 757   }
 758
 759   $$amountref  += $prepay_credit->amount;
 760   $$secondsref += $prepay_credit->seconds;
 761   $$upref      += $prepay_credit->upbytes;
 762   $$downref    += $prepay_credit->downbytes;
 763   $$totalref   += $prepay_credit->totalbytes;
 764
 765   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 766   '';
 767
 768 }
 769
 770 =item increment_upbytes SECONDS
 771
 772 Updates this customer's single or primary account (see L<FS::svc_acct>) by
 773 the specified number of upbytes.  If there is an error, returns the error,
 774 otherwise returns false.
 775
 776 =cut
 777
 778 sub increment_upbytes {
 779   _increment_column( shift, 'upbytes', @_);
 780 }
 781
 782 =item increment_downbytes SECONDS
 783
 784 Updates this customer's single or primary account (see L<FS::svc_acct>) by
 785 the specified number of downbytes.  If there is an error, returns the error,
 786 otherwise returns false.
 787
 788 =cut
 789
 790 sub increment_downbytes {
 791   _increment_column( shift, 'downbytes', @_);
 792 }
 793
 794 =item increment_totalbytes SECONDS
 795
 796 Updates this customer's single or primary account (see L<FS::svc_acct>) by
 797 the specified number of totalbytes.  If there is an error, returns the error,
 798 otherwise returns false.
 799
 800 =cut
 801
 802 sub increment_totalbytes {
 803   _increment_column( shift, 'totalbytes', @_);
 804 }
 805
 806 =item increment_seconds SECONDS
 807
 808 Updates this customer's single or primary account (see L<FS::svc_acct>) by
 809 the specified number of seconds.  If there is an error, returns the error,
 810 otherwise returns false.
 811
 812 =cut
 813
 814 sub increment_seconds {
 815   _increment_column( shift, 'seconds', @_);
 816 }
 817
 818 =item _increment_column AMOUNT
 819
 820 Updates this customer's single or primary account (see L<FS::svc_acct>) by
 821 the specified number of seconds or bytes.  If there is an error, returns
 822 the error, otherwise returns false.
 823
 824 =cut
 825
 826 sub _increment_column {
 827   my( $self, $column, $amount ) = @_;
 828   warn "$me increment_column called: $column, $amount\n"
 829     if $DEBUG;
 830
 831   return '' unless $amount;
 832
 833   my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
 834                       $self->ncancelled_pkgs;
 835
 836   if ( ! @cust_pkg ) {
 837     return 'No packages with primary or single services found'.
 838            ' to apply pre-paid time';
 839   } elsif ( scalar(@cust_pkg) > 1 ) {
 840     #maybe have a way to specify the package/account?
 841     return 'Multiple packages found to apply pre-paid time';
 842   }
 843
 844   my $cust_pkg = $cust_pkg[0];
 845   warn "  found package pkgnum ". $cust_pkg->pkgnum. "\n"
 846     if $DEBUG > 1;
 847
 848   my @cust_svc =
 849     $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
 850
 851   if ( ! @cust_svc ) {
 852     return 'No account found to apply pre-paid time';
 853   } elsif ( scalar(@cust_svc) > 1 ) {
 854     return 'Multiple accounts found to apply pre-paid time';
 855   }
 856
 857   my $svc_acct = $cust_svc[0]->svc_x;
 858   warn "  found service svcnum ". $svc_acct->pkgnum.
 859        ' ('. $svc_acct->email. ")\n"
 860     if $DEBUG > 1;
 861
 862   $column = "increment_$column";
 863   $svc_acct->$column($amount);
 864
 865 }
 866
 867 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
 868
 869 Inserts a prepayment in the specified amount for this customer.  An optional
 870 second argument can specify the prepayment identifier for tracking purposes.
 871 If there is an error, returns the error, otherwise returns false.
 872
 873 =cut
 874
 875 sub insert_cust_pay_prepay {
 876   shift->insert_cust_pay('PREP', @_);
 877 }
 878
 879 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
 880
 881 Inserts a cash payment in the specified amount for this customer.  An optional
 882 second argument can specify the payment identifier for tracking purposes.
 883 If there is an error, returns the error, otherwise returns false.
 884
 885 =cut
 886
 887 sub insert_cust_pay_cash {
 888   shift->insert_cust_pay('CASH', @_);
 889 }
 890
 891 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
 892
 893 Inserts a Western Union payment in the specified amount for this customer.  An
 894 optional second argument can specify the prepayment identifier for tracking
 895 purposes.  If there is an error, returns the error, otherwise returns false.
 896
 897 =cut
 898
 899 sub insert_cust_pay_west {
 900   shift->insert_cust_pay('WEST', @_);
 901 }
 902
 903 sub insert_cust_pay {
 904   my( $self, $payby, $amount ) = splice(@_, 0, 3);
 905   my $payinfo = scalar(@_) ? shift : '';
 906
 907   my $cust_pay = new FS::cust_pay {
 908     'custnum' => $self->custnum,
 909     'paid'    => sprintf('%.2f', $amount),
 910     #'_date'   => #date the prepaid card was purchased???
 911     'payby'   => $payby,
 912     'payinfo' => $payinfo,
 913   };
 914   $cust_pay->insert;
 915
 916 }
 917
 918 =item reexport
 919
 920 This method is deprecated.  See the I<depend_jobnum> option to the insert and
 921 order_pkgs methods for a better way to defer provisioning.
 922
 923 Re-schedules all exports by calling the B<reexport> method of all associated
 924 packages (see L<FS::cust_pkg>).  If there is an error, returns the error;
 925 otherwise returns false.
 926
 927 =cut
 928
 929 sub reexport {
 930   my $self = shift;
 931
 932   carp "WARNING: FS::cust_main::reexport is deprectated; ".
 933        "use the depend_jobnum option to insert or order_pkgs to delay export";
 934
 935   local $SIG{HUP} = 'IGNORE';
 936   local $SIG{INT} = 'IGNORE';
 937   local $SIG{QUIT} = 'IGNORE';
 938   local $SIG{TERM} = 'IGNORE';
 939   local $SIG{TSTP} = 'IGNORE';
 940   local $SIG{PIPE} = 'IGNORE';
 941
 942   my $oldAutoCommit = $FS::UID::AutoCommit;
 943   local $FS::UID::AutoCommit = 0;
 944   my $dbh = dbh;
 945
 946   foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
 947     my $error = $cust_pkg->reexport;
 948     if ( $error ) {
 949       $dbh->rollback if $oldAutoCommit;
 950       return $error;
 951     }
 952   }
 953
 954   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 955   '';
 956
 957 }
 958
 959 =item delete NEW_CUSTNUM
 960
 961 This deletes the customer.  If there is an error, returns the error, otherwise
 962 returns false.
 963
 964 This will completely remove all traces of the customer record.  This is not
 965 what you want when a customer cancels service; for that, cancel all of the
 966 customer's packages (see L</cancel>).
 967
 968 If the customer has any uncancelled packages, you need to pass a new (valid)
 969 customer number for those packages to be transferred to.  Cancelled packages
 970 will be deleted.  Did I mention that this is NOT what you want when a customer
 971 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
 972
 973 You can't delete a customer with invoices (see L<FS::cust_bill>),
 974 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
 975 refunds (see L<FS::cust_refund>).
 976
 977 =cut
 978
 979 sub delete {
 980   my $self = shift;
 981
 982   local $SIG{HUP} = 'IGNORE';
 983   local $SIG{INT} = 'IGNORE';
 984   local $SIG{QUIT} = 'IGNORE';
 985   local $SIG{TERM} = 'IGNORE';
 986   local $SIG{TSTP} = 'IGNORE';
 987   local $SIG{PIPE} = 'IGNORE';
 988
 989   my $oldAutoCommit = $FS::UID::AutoCommit;
 990   local $FS::UID::AutoCommit = 0;
 991   my $dbh = dbh;
 992
 993   if ( $self->cust_bill ) {
 994     $dbh->rollback if $oldAutoCommit;
 995     return "Can't delete a customer with invoices";
 996   }
 997   if ( $self->cust_credit ) {
 998     $dbh->rollback if $oldAutoCommit;
 999     return "Can't delete a customer with credits";
1000   }
1001   if ( $self->cust_pay ) {
1002     $dbh->rollback if $oldAutoCommit;
1003     return "Can't delete a customer with payments";
1004   }
1005   if ( $self->cust_refund ) {
1006     $dbh->rollback if $oldAutoCommit;
1007     return "Can't delete a customer with refunds";
1008   }
1009
1010   my @cust_pkg = $self->ncancelled_pkgs;
1011   if ( @cust_pkg ) {
1012     my $new_custnum = shift;
1013     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1014       $dbh->rollback if $oldAutoCommit;
1015       return "Invalid new customer number: $new_custnum";
1016     }
1017     foreach my $cust_pkg ( @cust_pkg ) {
1018       my %hash = $cust_pkg->hash;
1019       $hash{'custnum'} = $new_custnum;
1020       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1021       my $error = $new_cust_pkg->replace($cust_pkg,
1022                                          options => { $cust_pkg->options },
1023                                         );
1024       if ( $error ) {
1025         $dbh->rollback if $oldAutoCommit;
1026         return $error;
1027       }
1028     }
1029   }
1030   my @cancelled_cust_pkg = $self->all_pkgs;
1031   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1032     my $error = $cust_pkg->delete;
1033     if ( $error ) {
1034       $dbh->rollback if $oldAutoCommit;
1035       return $error;
1036     }
1037   }
1038
1039   foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
1040     qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
1041   ) {
1042     my $error = $cust_main_invoice->delete;
1043     if ( $error ) {
1044       $dbh->rollback if $oldAutoCommit;
1045       return $error;
1046     }
1047   }
1048
1049   my $error = $self->SUPER::delete;
1050   if ( $error ) {
1051     $dbh->rollback if $oldAutoCommit;
1052     return $error;
1053   }
1054
1055   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1056   '';
1057
1058 }
1059
1060 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ]
1061
1062 Replaces the OLD_RECORD with this one in the database.  If there is an error,
1063 returns the error, otherwise returns false.
1064
1065 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1066 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
1067 expected and rollback the entire transaction; it is not necessary to call
1068 check_invoicing_list first.  Here's an example:
1069
1070   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1071
1072 =cut
1073
1074 sub replace {
1075   my $self = shift;
1076
1077   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1078               ? shift
1079               : $self->replace_old;
1080
1081   my @param = @_;
1082
1083   warn "$me replace called\n"
1084     if $DEBUG;
1085
1086   my $curuser = $FS::CurrentUser::CurrentUser;
1087   if (    $self->payby eq 'COMP'
1088        && $self->payby ne $old->payby
1089        && ! $curuser->access_right('Complimentary customer')
1090      )
1091   {
1092     return "You are not permitted to create complimentary accounts.";
1093   }
1094
1095   local($ignore_expired_card) = 1
1096     if $old->payby  =~ /^(CARD|DCRD)$/
1097     && $self->payby =~ /^(CARD|DCRD)$/
1098     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1099
1100   local $SIG{HUP} = 'IGNORE';
1101   local $SIG{INT} = 'IGNORE';
1102   local $SIG{QUIT} = 'IGNORE';
1103   local $SIG{TERM} = 'IGNORE';
1104   local $SIG{TSTP} = 'IGNORE';
1105   local $SIG{PIPE} = 'IGNORE';
1106
1107   my $oldAutoCommit = $FS::UID::AutoCommit;
1108   local $FS::UID::AutoCommit = 0;
1109   my $dbh = dbh;
1110
1111   my $error = $self->SUPER::replace($old);
1112
1113   if ( $error ) {
1114     $dbh->rollback if $oldAutoCommit;
1115     return $error;
1116   }
1117
1118   if ( @param ) { # INVOICING_LIST_ARYREF
1119     my $invoicing_list = shift @param;
1120     $error = $self->check_invoicing_list( $invoicing_list );
1121     if ( $error ) {
1122       $dbh->rollback if $oldAutoCommit;
1123       return $error;
1124     }
1125     $self->invoicing_list( $invoicing_list );
1126   }
1127
1128   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
1129        grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
1130     # card/check/lec info has changed, want to retry realtime_ invoice events
1131     my $error = $self->retry_realtime;
1132     if ( $error ) {
1133       $dbh->rollback if $oldAutoCommit;
1134       return $error;
1135     }
1136   }
1137
1138   unless ( $import || $skip_fuzzyfiles ) {
1139     $error = $self->queue_fuzzyfiles_update;
1140     if ( $error ) {
1141       $dbh->rollback if $oldAutoCommit;
1142       return "updating fuzzy search cache: $error";
1143     }
1144   }
1145
1146   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1147   '';
1148
1149 }
1150
1151 =item queue_fuzzyfiles_update
1152
1153 Used by insert & replace to update the fuzzy search cache
1154
1155 =cut
1156
1157 sub queue_fuzzyfiles_update {
1158   my $self = shift;
1159
1160   local $SIG{HUP} = 'IGNORE';
1161   local $SIG{INT} = 'IGNORE';
1162   local $SIG{QUIT} = 'IGNORE';
1163   local $SIG{TERM} = 'IGNORE';
1164   local $SIG{TSTP} = 'IGNORE';
1165   local $SIG{PIPE} = 'IGNORE';
1166
1167   my $oldAutoCommit = $FS::UID::AutoCommit;
1168   local $FS::UID::AutoCommit = 0;
1169   my $dbh = dbh;
1170
1171   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1172   my $error = $queue->insert( map $self->getfield($_),
1173                                   qw(first last company)
1174                             );
1175   if ( $error ) {
1176     $dbh->rollback if $oldAutoCommit;
1177     return "queueing job (transaction rolled back): $error";
1178   }
1179
1180   if ( $self->ship_last ) {
1181     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1182     $error = $queue->insert( map $self->getfield("ship_$_"),
1183                                  qw(first last company)
1184                            );
1185     if ( $error ) {
1186       $dbh->rollback if $oldAutoCommit;
1187       return "queueing job (transaction rolled back): $error";
1188     }
1189   }
1190
1191   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1192   '';
1193
1194 }
1195
1196 =item check
1197
1198 Checks all fields to make sure this is a valid customer record.  If there is
1199 an error, returns the error, otherwise returns false.  Called by the insert
1200 and replace methods.
1201
1202 =cut
1203
1204 sub check {
1205   my $self = shift;
1206
1207   warn "$me check BEFORE: \n". $self->_dump
1208     if $DEBUG > 2;
1209
1210   my $error =
1211     $self->ut_numbern('custnum')
1212     || $self->ut_number('agentnum')
1213     || $self->ut_textn('agent_custid')
1214     || $self->ut_number('refnum')
1215     || $self->ut_textn('custbatch')
1216     || $self->ut_name('last')
1217     || $self->ut_name('first')
1218     || $self->ut_snumbern('birthdate')
1219     || $self->ut_snumbern('signupdate')
1220     || $self->ut_textn('company')
1221     || $self->ut_text('address1')
1222     || $self->ut_textn('address2')
1223     || $self->ut_text('city')
1224     || $self->ut_textn('county')
1225     || $self->ut_textn('state')
1226     || $self->ut_country('country')
1227     || $self->ut_anything('comments')
1228     || $self->ut_numbern('referral_custnum')
1229     || $self->ut_textn('stateid')
1230     || $self->ut_textn('stateid_state')
1231     || $self->ut_textn('invoice_terms')
1232   ;
1233   #barf.  need message catalogs.  i18n.  etc.
1234   $error .= "Please select an advertising source."
1235     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1236   return $error if $error;
1237
1238   return "Unknown agent"
1239     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1240
1241   return "Unknown refnum"
1242     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1243
1244   return "Unknown referring custnum: ". $self->referral_custnum
1245     unless ! $self->referral_custnum
1246            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1247
1248   if ( $self->ss eq '' ) {
1249     $self->ss('');
1250   } else {
1251     my $ss = $self->ss;
1252     $ss =~ s/\D//g;
1253     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1254       or return "Illegal social security number: ". $self->ss;
1255     $self->ss("$1-$2-$3");
1256   }
1257
1258
1259 # bad idea to disable, causes billing to fail because of no tax rates later
1260 #  unless ( $import ) {
1261     unless ( qsearch('cust_main_county', {
1262       'country' => $self->country,
1263       'state'   => '',
1264      } ) ) {
1265       return "Unknown state/county/country: ".
1266         $self->state. "/". $self->county. "/". $self->country
1267         unless qsearch('cust_main_county',{
1268           'state'   => $self->state,
1269           'county'  => $self->county,
1270           'country' => $self->country,
1271         } );
1272     }
1273 #  }
1274
1275   $error =
1276     $self->ut_phonen('daytime', $self->country)
1277     || $self->ut_phonen('night', $self->country)
1278     || $self->ut_phonen('fax', $self->country)
1279     || $self->ut_zip('zip', $self->country)
1280   ;
1281   return $error if $error;
1282
1283   if ( $conf->exists('cust_main-require_phone')
1284        && ! length($self->daytime) && ! length($self->night)
1285      ) {
1286
1287     my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1288                           ? 'Day Phone'
1289                           : FS::Msgcat::_gettext('daytime');
1290     my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1291                         ? 'Night Phone'
1292                         : FS::Msgcat::_gettext('night');
1293
1294     return "$daytime_label or $night_label is required"
1295
1296   }
1297
1298   if ( $self->has_ship_address
1299        && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1300                         $self->addr_fields )
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     return "Unit # is required."
1340       if $self->ship_address2 =~ /^\s*$/
1341       && $conf->exists('cust_main-require_address2');
1342
1343   } else { # ship_ info eq billing info, so don't store dup info in database
1344
1345     $self->setfield("ship_$_", '')
1346       foreach $self->addr_fields;
1347
1348     return "Unit # is required."
1349       if $self->address2 =~ /^\s*$/
1350       && $conf->exists('cust_main-require_address2');
1351
1352   }
1353
1354   #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1355   #  or return "Illegal payby: ". $self->payby;
1356   #$self->payby($1);
1357   FS::payby->can_payby($self->table, $self->payby)
1358     or return "Illegal payby: ". $self->payby;
1359
1360   $error =    $self->ut_numbern('paystart_month')
1361            || $self->ut_numbern('paystart_year')
1362            || $self->ut_numbern('payissue')
1363            || $self->ut_textn('paytype')
1364   ;
1365   return $error if $error;
1366
1367   if ( $self->payip eq '' ) {
1368     $self->payip('');
1369   } else {
1370     $error = $self->ut_ip('payip');
1371     return $error if $error;
1372   }
1373
1374   # If it is encrypted and the private key is not availaible then we can't
1375   # check the credit card.
1376
1377   my $check_payinfo = 1;
1378
1379   if ($self->is_encrypted($self->payinfo)) {
1380     $check_payinfo = 0;
1381   }
1382
1383   if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1384
1385     my $payinfo = $self->payinfo;
1386     $payinfo =~ s/\D//g;
1387     $payinfo =~ /^(\d{13,16})$/
1388       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1389     $payinfo = $1;
1390     $self->payinfo($payinfo);
1391     validate($payinfo)
1392       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1393
1394     return gettext('unknown_card_type')
1395       if cardtype($self->payinfo) eq "Unknown";
1396
1397     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1398     if ( $ban ) {
1399       return 'Banned credit card: banned on '.
1400              time2str('%a %h %o at %r', $ban->_date).
1401              ' by '. $ban->otaker.
1402              ' (ban# '. $ban->bannum. ')';
1403     }
1404
1405     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1406       if ( cardtype($self->payinfo) eq 'American Express card' ) {
1407         $self->paycvv =~ /^(\d{4})$/
1408           or return "CVV2 (CID) for American Express cards is four digits.";
1409         $self->paycvv($1);
1410       } else {
1411         $self->paycvv =~ /^(\d{3})$/
1412           or return "CVV2 (CVC2/CID) is three digits.";
1413         $self->paycvv($1);
1414       }
1415     } else {
1416       $self->paycvv('');
1417     }
1418
1419     my $cardtype = cardtype($payinfo);
1420     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1421
1422       return "Start date or issue number is required for $cardtype cards"
1423         unless $self->paystart_month && $self->paystart_year or $self->payissue;
1424
1425       return "Start month must be between 1 and 12"
1426         if $self->paystart_month
1427            and $self->paystart_month < 1 || $self->paystart_month > 12;
1428
1429       return "Start year must be 1990 or later"
1430         if $self->paystart_year
1431            and $self->paystart_year < 1990;
1432
1433       return "Issue number must be beween 1 and 99"
1434         if $self->payissue
1435           and $self->payissue < 1 || $self->payissue > 99;
1436
1437     } else {
1438       $self->paystart_month('');
1439       $self->paystart_year('');
1440       $self->payissue('');
1441     }
1442
1443   } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1444
1445     my $payinfo = $self->payinfo;
1446     $payinfo =~ s/[^\d\@]//g;
1447     if ( $conf->exists('echeck-nonus') ) {
1448       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1449       $payinfo = "$1\@$2";
1450     } else {
1451       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1452       $payinfo = "$1\@$2";
1453     }
1454     $self->payinfo($payinfo);
1455     $self->paycvv('');
1456
1457     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1458     if ( $ban ) {
1459       return 'Banned ACH account: banned on '.
1460              time2str('%a %h %o at %r', $ban->_date).
1461              ' by '. $ban->otaker.
1462              ' (ban# '. $ban->bannum. ')';
1463     }
1464
1465   } elsif ( $self->payby eq 'LECB' ) {
1466
1467     my $payinfo = $self->payinfo;
1468     $payinfo =~ s/\D//g;
1469     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1470     $payinfo = $1;
1471     $self->payinfo($payinfo);
1472     $self->paycvv('');
1473
1474   } elsif ( $self->payby eq 'BILL' ) {
1475
1476     $error = $self->ut_textn('payinfo');
1477     return "Illegal P.O. number: ". $self->payinfo if $error;
1478     $self->paycvv('');
1479
1480   } elsif ( $self->payby eq 'COMP' ) {
1481
1482     my $curuser = $FS::CurrentUser::CurrentUser;
1483     if (    ! $self->custnum
1484          && ! $curuser->access_right('Complimentary customer')
1485        )
1486     {
1487       return "You are not permitted to create complimentary accounts."
1488     }
1489
1490     $error = $self->ut_textn('payinfo');
1491     return "Illegal comp account issuer: ". $self->payinfo if $error;
1492     $self->paycvv('');
1493
1494   } elsif ( $self->payby eq 'PREPAY' ) {
1495
1496     my $payinfo = $self->payinfo;
1497     $payinfo =~ s/\W//g; #anything else would just confuse things
1498     $self->payinfo($payinfo);
1499     $error = $self->ut_alpha('payinfo');
1500     return "Illegal prepayment identifier: ". $self->payinfo if $error;
1501     return "Unknown prepayment identifier"
1502       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1503     $self->paycvv('');
1504
1505   }
1506
1507   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1508     return "Expiration date required"
1509       unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1510     $self->paydate('');
1511   } else {
1512     my( $m, $y );
1513     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1514       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1515     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1516       ( $m, $y ) = ( $3, "20$2" );
1517     } else {
1518       return "Illegal expiration date: ". $self->paydate;
1519     }
1520     $self->paydate("$y-$m-01");
1521     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1522     return gettext('expired_card')
1523       if !$import
1524       && !$ignore_expired_card
1525       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1526   }
1527
1528   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1529        ( ! $conf->exists('require_cardname')
1530          || $self->payby !~ /^(CARD|DCRD)$/  )
1531   ) {
1532     $self->payname( $self->first. " ". $self->getfield('last') );
1533   } else {
1534     $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1535       or return gettext('illegal_name'). " payname: ". $self->payname;
1536     $self->payname($1);
1537   }
1538
1539   foreach my $flag (qw( tax spool_cdr squelch_cdr )) {
1540     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1541     $self->$flag($1);
1542   }
1543
1544   $self->otaker(getotaker) unless $self->otaker;
1545
1546   warn "$me check AFTER: \n". $self->_dump
1547     if $DEBUG > 2;
1548
1549   $self->SUPER::check;
1550 }
1551
1552 =item addr_fields
1553
1554 Returns a list of fields which have ship_ duplicates.
1555
1556 =cut
1557
1558 sub addr_fields {
1559   qw( last first company
1560       address1 address2 city county state zip country
1561       daytime night fax
1562     );
1563 }
1564
1565 =item has_ship_address
1566
1567 Returns true if this customer record has a separate shipping address.
1568
1569 =cut
1570
1571 sub has_ship_address {
1572   my $self = shift;
1573   scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1574 }
1575
1576 =item all_pkgs
1577
1578 Returns all packages (see L<FS::cust_pkg>) for this customer.
1579
1580 =cut
1581
1582 sub all_pkgs {
1583   my $self = shift;
1584
1585   return $self->num_pkgs unless wantarray;
1586
1587   my @cust_pkg = ();
1588   if ( $self->{'_pkgnum'} ) {
1589     @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
1590   } else {
1591     @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1592   }
1593
1594   sort sort_packages @cust_pkg;
1595 }
1596
1597 =item cust_pkg
1598
1599 Synonym for B<all_pkgs>.
1600
1601 =cut
1602
1603 sub cust_pkg {
1604   shift->all_pkgs(@_);
1605 }
1606
1607 =item ncancelled_pkgs
1608
1609 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1610
1611 =cut
1612
1613 sub ncancelled_pkgs {
1614   my $self = shift;
1615
1616   return $self->num_ncancelled_pkgs unless wantarray;
1617
1618   my @cust_pkg = ();
1619   if ( $self->{'_pkgnum'} ) {
1620
1621     warn "$me ncancelled_pkgs: returning cached objects"
1622       if $DEBUG > 1;
1623
1624     @cust_pkg = grep { ! $_->getfield('cancel') }
1625                 values %{ $self->{'_pkgnum'}->cache };
1626
1627   } else {
1628
1629     warn "$me ncancelled_pkgs: searching for packages with custnum ".
1630          $self->custnum. "\n"
1631       if $DEBUG > 1;
1632
1633     @cust_pkg =
1634       qsearch( 'cust_pkg', {
1635                              'custnum' => $self->custnum,
1636                              'cancel'  => '',
1637                            });
1638     push @cust_pkg,
1639       qsearch( 'cust_pkg', {
1640                              'custnum' => $self->custnum,
1641                              'cancel'  => 0,
1642                            });
1643   }
1644
1645   sort sort_packages @cust_pkg;
1646
1647 }
1648
1649 # This should be generalized to use config options to determine order.
1650 sub sort_packages {
1651   if ( $a->get('cancel') and $b->get('cancel') ) {
1652     $a->pkgnum <=> $b->pkgnum;
1653   } elsif ( $a->get('cancel') or $b->get('cancel') ) {
1654     return -1 if $b->get('cancel');
1655     return  1 if $a->get('cancel');
1656     return 0;
1657   } else {
1658     $a->pkgnum <=> $b->pkgnum;
1659   }
1660 }
1661
1662 =item suspended_pkgs
1663
1664 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1665
1666 =cut
1667
1668 sub suspended_pkgs {
1669   my $self = shift;
1670   grep { $_->susp } $self->ncancelled_pkgs;
1671 }
1672
1673 =item unflagged_suspended_pkgs
1674
1675 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1676 customer (thouse packages without the `manual_flag' set).
1677
1678 =cut
1679
1680 sub unflagged_suspended_pkgs {
1681   my $self = shift;
1682   return $self->suspended_pkgs
1683     unless dbdef->table('cust_pkg')->column('manual_flag');
1684   grep { ! $_->manual_flag } $self->suspended_pkgs;
1685 }
1686
1687 =item unsuspended_pkgs
1688
1689 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1690 this customer.
1691
1692 =cut
1693
1694 sub unsuspended_pkgs {
1695   my $self = shift;
1696   grep { ! $_->susp } $self->ncancelled_pkgs;
1697 }
1698
1699 =item num_cancelled_pkgs
1700
1701 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1702 customer.
1703
1704 =cut
1705
1706 sub num_cancelled_pkgs {
1707   shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
1708 }
1709
1710 sub num_ncancelled_pkgs {
1711   shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
1712 }
1713
1714 sub num_pkgs {
1715   my( $self ) = shift;
1716   my $sql = scalar(@_) ? shift : '';
1717   $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
1718   my $sth = dbh->prepare(
1719     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
1720   ) or die dbh->errstr;
1721   $sth->execute($self->custnum) or die $sth->errstr;
1722   $sth->fetchrow_arrayref->[0];
1723 }
1724
1725 =item unsuspend
1726
1727 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1728 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
1729 on success or a list of errors.
1730
1731 =cut
1732
1733 sub unsuspend {
1734   my $self = shift;
1735   grep { $_->unsuspend } $self->suspended_pkgs;
1736 }
1737
1738 =item suspend
1739
1740 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1741
1742 Returns a list: an empty list on success or a list of errors.
1743
1744 =cut
1745
1746 sub suspend {
1747   my $self = shift;
1748   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
1749 }
1750
1751 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
1752
1753 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1754 PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref instead
1755 of a list of pkgparts; the hashref has the following keys:
1756
1757 =over 4
1758
1759 =item pkgparts - listref of pkgparts
1760
1761 =item (other options are passed to the suspend method)
1762
1763 =back
1764
1765
1766 Returns a list: an empty list on success or a list of errors.
1767
1768 =cut
1769
1770 sub suspend_if_pkgpart {
1771   my $self = shift;
1772   my (@pkgparts, %opt);
1773   if (ref($_[0]) eq 'HASH'){
1774     @pkgparts = @{$_[0]{pkgparts}};
1775     %opt      = %{$_[0]};
1776   }else{
1777     @pkgparts = @_;
1778   }
1779   grep { $_->suspend(%opt) }
1780     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1781       $self->unsuspended_pkgs;
1782 }
1783
1784 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
1785
1786 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1787 given PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref
1788 instead of a list of pkgparts; the hashref has the following keys:
1789
1790 =over 4
1791
1792 =item pkgparts - listref of pkgparts
1793
1794 =item (other options are passed to the suspend method)
1795
1796 =back
1797
1798 Returns a list: an empty list on success or a list of errors.
1799
1800 =cut
1801
1802 sub suspend_unless_pkgpart {
1803   my $self = shift;
1804   my (@pkgparts, %opt);
1805   if (ref($_[0]) eq 'HASH'){
1806     @pkgparts = @{$_[0]{pkgparts}};
1807     %opt      = %{$_[0]};
1808   }else{
1809     @pkgparts = @_;
1810   }
1811   grep { $_->suspend(%opt) }
1812     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1813       $self->unsuspended_pkgs;
1814 }
1815
1816 =item cancel [ OPTION => VALUE ... ]
1817
1818 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1819
1820 Available options are:
1821
1822 =over 4
1823
1824 =item quiet - can be set true to supress email cancellation notices.
1825
1826 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason.  The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
1827
1828 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
1829
1830 =back
1831
1832 Always returns a list: an empty list on success or a list of errors.
1833
1834 =cut
1835
1836 sub cancel {
1837   my( $self, %opt ) = @_;
1838
1839   warn "$me cancel called on customer ". $self->custnum. " with options ".
1840        join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
1841     if $DEBUG;
1842
1843   return ( 'access denied' )
1844     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
1845
1846   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1847
1848     #should try decryption (we might have the private key)
1849     # and if not maybe queue a job for the server that does?
1850     return ( "Can't (yet) ban encrypted credit cards" )
1851       if $self->is_encrypted($self->payinfo);
1852
1853     my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1854     my $error = $ban->insert;
1855     return ( $error ) if $error;
1856
1857   }
1858
1859   my @pkgs = $self->ncancelled_pkgs;
1860
1861   warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
1862        scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
1863     if $DEBUG;
1864
1865   grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
1866 }
1867
1868 sub _banned_pay_hashref {
1869   my $self = shift;
1870
1871   my %payby2ban = (
1872     'CARD' => 'CARD',
1873     'DCRD' => 'CARD',
1874     'CHEK' => 'CHEK',
1875     'DCHK' => 'CHEK'
1876   );
1877
1878   {
1879     'payby'   => $payby2ban{$self->payby},
1880     'payinfo' => md5_base64($self->payinfo),
1881     #don't ever *search* on reason! #'reason'  =>
1882   };
1883 }
1884
1885 =item notes
1886
1887 Returns all notes (see L<FS::cust_main_note>) for this customer.
1888
1889 =cut
1890
1891 sub notes {
1892   my $self = shift;
1893   #order by?
1894   qsearch( 'cust_main_note',
1895            { 'custnum' => $self->custnum },
1896            '',
1897            'ORDER BY _DATE DESC'
1898          );
1899 }
1900
1901 =item agent
1902
1903 Returns the agent (see L<FS::agent>) for this customer.
1904
1905 =cut
1906
1907 sub agent {
1908   my $self = shift;
1909   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1910 }
1911
1912 =item bill_and_collect
1913
1914 Cancels and suspends any packages due, generates bills, applies payments and
1915 cred
1916
1917 Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.)
1918
1919 Options are passed as name-value pairs.  Currently available options are:
1920
1921 =over 4
1922
1923 =item time
1924
1925 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:
1926
1927  use Date::Parse;
1928  ...
1929  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1930
1931 =item invoice_time
1932
1933 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.
1934
1935 =item check_freq
1936
1937 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1938
1939 =item resetup
1940
1941 If set true, re-charges setup fees.
1942
1943 =item debug
1944
1945 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
1946
1947 =back
1948
1949 =cut
1950
1951 sub bill_and_collect {
1952   my( $self, %options ) = @_;
1953
1954   ###
1955   # cancel packages
1956   ###
1957
1958   #$options{actual_time} not $options{time} because freeside-daily -d is for
1959   #pre-printing invoices
1960   my @cancel_pkgs = grep { $_->expire && $_->expire <= $options{actual_time} }
1961                          $self->ncancelled_pkgs;
1962
1963   foreach my $cust_pkg ( @cancel_pkgs ) {
1964     my $error = $cust_pkg->cancel;
1965     warn "Error cancelling expired pkg ". $cust_pkg->pkgnum.
1966          " for custnum ". $self->custnum. ": $error"
1967       if $error;
1968   }
1969
1970   ###
1971   # suspend packages
1972   ###
1973
1974   #$options{actual_time} not $options{time} because freeside-daily -d is for
1975   #pre-printing invoices
1976   my @susp_pkgs =
1977     grep { ! $_->susp
1978            && (    (    $_->part_pkg->is_prepaid
1979                      && $_->bill
1980                      && $_->bill < $options{actual_time}
1981                    )
1982                 || (    $_->adjourn
1983                     && $_->adjourn <= $options{actual_time}
1984                   )
1985               )
1986          }
1987          $self->ncancelled_pkgs;
1988
1989   foreach my $cust_pkg ( @susp_pkgs ) {
1990     my $error = $cust_pkg->suspend;
1991     warn "Error suspending package ". $cust_pkg->pkgnum.
1992          " for custnum ". $self->custnum. ": $error"
1993       if $error;
1994   }
1995
1996   ###
1997   # bill and collect
1998   ###
1999
2000   my $error = $self->bill( %options );
2001   warn "Error billing, custnum ". $self->custnum. ": $error" if $error;
2002
2003   $self->apply_payments_and_credits;
2004
2005   $error = $self->collect( %options );
2006   warn "Error collecting, custnum". $self->custnum. ": $error" if $error;
2007
2008 }
2009
2010 =item bill OPTIONS
2011
2012 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
2013 conjunction with the collect method by calling B<bill_and_collect>.
2014
2015 If there is an error, returns the error, otherwise returns false.
2016
2017 Options are passed as name-value pairs.  Currently available options are:
2018
2019 =over 4
2020
2021 =item resetup
2022
2023 If set true, re-charges setup fees.
2024
2025 =item time
2026
2027 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:
2028
2029  use Date::Parse;
2030  ...
2031  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2032
2033 =item pkg_list
2034
2035 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
2036
2037  $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2038
2039 =item invoice_time
2040
2041 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.
2042
2043 =back
2044
2045 =cut
2046
2047 sub bill {
2048   my( $self, %options ) = @_;
2049   return '' if $self->payby eq 'COMP';
2050   local $DEBUG = 1;
2051   warn "$me bill customer ". $self->custnum. "\n"
2052     if $DEBUG;
2053
2054   my $time = $options{'time'} || time;
2055
2056   #put below somehow?
2057   local $SIG{HUP} = 'IGNORE';
2058   local $SIG{INT} = 'IGNORE';
2059   local $SIG{QUIT} = 'IGNORE';
2060   local $SIG{TERM} = 'IGNORE';
2061   local $SIG{TSTP} = 'IGNORE';
2062   local $SIG{PIPE} = 'IGNORE';
2063
2064   my $oldAutoCommit = $FS::UID::AutoCommit;
2065   local $FS::UID::AutoCommit = 0;
2066   my $dbh = dbh;
2067
2068   $self->select_for_update; #mutex
2069
2070   my @cust_bill_pkg = ();
2071
2072   ###
2073   # find the packages which are due for billing, find out how much they are
2074   # & generate invoice database.
2075   ###
2076
2077   my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 );
2078   my %tax;
2079   my %taxlisthash;
2080   my %taxname;
2081   my @precommit_hooks = ();
2082
2083   my @cust_pkgs = qsearch('cust_pkg', { 'custnum' => $self->custnum } );
2084   foreach my $cust_pkg (@cust_pkgs) {
2085
2086     #NO!! next if $cust_pkg->cancel;
2087     next if $cust_pkg->getfield('cancel');
2088
2089     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2090
2091     #? to avoid use of uninitialized value errors... ?
2092     $cust_pkg->setfield('bill', '')
2093       unless defined($cust_pkg->bill);
2094
2095     #my $part_pkg = $cust_pkg->part_pkg;
2096
2097     my $real_pkgpart = $cust_pkg->pkgpart;
2098     my %hash = $cust_pkg->hash;
2099
2100     foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
2101
2102       $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
2103
2104       my $error =
2105         $self->_make_lines( 'part_pkg'            => $part_pkg,
2106                             'cust_pkg'            => $cust_pkg,
2107                             'precommit_hooks'     => \@precommit_hooks,
2108                             'line_items'          => \@cust_bill_pkg,
2109                             'setup'               => \$total_setup,
2110                             'recur'               => \$total_recur,
2111                             'tax_matrix'          => \%taxlisthash,
2112                             'time'                => $time,
2113                             'options'             => \%options,
2114                           );
2115       if ($error) {
2116         $dbh->rollback if $oldAutoCommit;
2117         return $error;
2118       }
2119
2120     } #foreach my $part_pkg
2121
2122   } #foreach my $cust_pkg
2123
2124   unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items
2125     #but do commit any package date cycling that happened
2126     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2127     return '';
2128   }
2129
2130   my $postal_pkg = $self->charge_postal_fee();
2131   if ( $postal_pkg && !ref( $postal_pkg ) ) {
2132     $dbh->rollback if $oldAutoCommit;
2133     return "can't charge postal invoice fee for customer ".
2134       $self->custnum. ": $postal_pkg";
2135   }
2136   if ( $postal_pkg ) {
2137     foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
2138       my $error =
2139         $self->_make_lines( 'part_pkg'            => $part_pkg,
2140                             'cust_pkg'            => $postal_pkg,
2141                             'precommit_hooks'     => \@precommit_hooks,
2142                             'line_items'          => \@cust_bill_pkg,
2143                             'setup'               => \$total_setup,
2144                             'recur'               => \$total_recur,
2145                             'tax_matrix'          => \%taxlisthash,
2146                             'time'                => $time,
2147                             'options'             => \%options,
2148                           );
2149       if ($error) {
2150         $dbh->rollback if $oldAutoCommit;
2151         return $error;
2152       }
2153     }
2154   }
2155
2156   warn "having a look at the taxes we found...\n" if $DEBUG > 2;
2157   foreach my $tax ( keys %taxlisthash ) {
2158     my $tax_object = shift @{ $taxlisthash{$tax} };
2159     warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
2160     my $listref_or_error = $tax_object->taxline( @{ $taxlisthash{$tax} } );
2161     unless (ref($listref_or_error)) {
2162       $dbh->rollback if $oldAutoCommit;
2163       return $listref_or_error;
2164     }
2165     unshift @{ $taxlisthash{$tax} }, $tax_object;
2166
2167     warn "adding ". $listref_or_error->[1].
2168          " as ". $listref_or_error->[0]. "\n"
2169       if $DEBUG > 2;
2170     $tax{ $tax_object->taxname } += $listref_or_error->[1];
2171     if ( $taxname{ $listref_or_error->[0] } ) {
2172       push @{ $taxname{ $listref_or_error->[0] } }, $tax_object->taxname;
2173     }else{
2174       $taxname{ $listref_or_error->[0] } = [ $tax_object->taxname ];
2175     }
2176
2177   }
2178
2179   #some taxes are taxed
2180   my %totlisthash;
2181
2182   warn "finding taxed taxes...\n" if $DEBUG > 2;
2183   foreach my $tax ( keys %taxlisthash ) {
2184     my $tax_object = shift @{ $taxlisthash{$tax} };
2185     warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
2186       if $DEBUG > 2;
2187     next unless $tax_object->can('tax_on_tax');
2188
2189     foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
2190       my $totname = ref( $tot ). ' '. $tot->taxnum;
2191
2192       warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
2193         if $DEBUG > 2;
2194       next unless exists( $taxlisthash{ $totname } ); # only increase
2195                                                       # existing taxes
2196       warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
2197       if ( exists( $totlisthash{ $totname } ) ) {
2198         push @{ $totlisthash{ $totname  } }, $tax{ $tax_object->taxname };
2199       }else{
2200         $totlisthash{ $totname } = [ $tot, $tax{ $tax_object->taxname } ];
2201       }
2202     }
2203   }
2204
2205   warn "having a look at taxed taxes...\n" if $DEBUG > 2;
2206   foreach my $tax ( keys %totlisthash ) {
2207     my $tax_object = shift @{ $totlisthash{$tax} };
2208     warn "found previously found taxed tax ". $tax_object->taxname. "\n"
2209       if $DEBUG > 2;
2210     my $listref_or_error = $tax_object->taxline( @{ $totlisthash{$tax} } );
2211     unless (ref($listref_or_error)) {
2212       $dbh->rollback if $oldAutoCommit;
2213       return $listref_or_error;
2214     }
2215
2216     warn "adding taxed tax amount ". $listref_or_error->[1].
2217          " as ". $tax_object->taxname. "\n"
2218       if $DEBUG;
2219     $tax{ $tax_object->taxname } += $listref_or_error->[1];
2220   }
2221
2222   #consolidate and create tax line items
2223   warn "consolidating and generating...\n" if $DEBUG > 2;
2224   foreach my $taxname ( keys %taxname ) {
2225     my $tax = 0;
2226     my %seen = ();
2227     warn "adding $taxname\n" if $DEBUG > 1;
2228     foreach my $taxitem ( @{ $taxname{$taxname} } ) {
2229       $tax += $tax{$taxitem} unless $seen{$taxitem};
2230       warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
2231     }
2232     next unless $tax;
2233
2234     $tax = sprintf('%.2f', $tax );
2235     $total_setup = sprintf('%.2f', $total_setup+$tax );
2236
2237     push @cust_bill_pkg, new FS::cust_bill_pkg {
2238       'pkgnum'   => 0,
2239       'setup'    => $tax,
2240       'recur'    => 0,
2241       'sdate'    => '',
2242       'edate'    => '',
2243       'itemdesc' => $taxname,
2244     };
2245
2246   }
2247
2248   my $charged = sprintf('%.2f', $total_setup + $total_recur );
2249
2250   #create the new invoice
2251   my $cust_bill = new FS::cust_bill ( {
2252     'custnum' => $self->custnum,
2253     '_date'   => ( $options{'invoice_time'} || $time ),
2254     'charged' => $charged,
2255   } );
2256   my $error = $cust_bill->insert;
2257   if ( $error ) {
2258     $dbh->rollback if $oldAutoCommit;
2259     return "can't create invoice for customer #". $self->custnum. ": $error";
2260   }
2261
2262   foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
2263     $cust_bill_pkg->invnum($cust_bill->invnum);
2264     my $error = $cust_bill_pkg->insert;
2265     if ( $error ) {
2266       $dbh->rollback if $oldAutoCommit;
2267       return "can't create invoice line item: $error";
2268     }
2269   }
2270
2271
2272   foreach my $hook ( @precommit_hooks ) {
2273     eval {
2274       &{$hook}; #($self) ?
2275     };
2276     if ( $@ ) {
2277       $dbh->rollback if $oldAutoCommit;
2278       return "$@ running precommit hook $hook\n";
2279     }
2280   }
2281
2282   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2283   ''; #no error
2284 }
2285
2286
2287 sub _make_lines {
2288   my ($self, %params) = @_;
2289
2290   my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
2291   my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
2292   my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
2293   my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
2294   my $total_setup = $params{setup} or die "no setup accumulator specified";
2295   my $total_recur = $params{recur} or die "no recur accumulator specified";
2296   my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
2297   my $time = $params{'time'} or die "no time specified";
2298   my (%options) = %{$params{options}};  #hmmm  only for 'resetup'
2299
2300   my $dbh = dbh;
2301   my $real_pkgpart = $cust_pkg->pkgpart;
2302   my %hash = $cust_pkg->hash;
2303   my $old_cust_pkg = new FS::cust_pkg \%hash;
2304
2305   my @details = ();
2306
2307   my $lineitems = 0;
2308
2309   $cust_pkg->pkgpart($part_pkg->pkgpart);
2310
2311   ###
2312   # bill setup
2313   ###
2314
2315   my $setup = 0;
2316   my $unitsetup = 0;
2317   if ( ! $cust_pkg->setup &&
2318        (
2319          ( $conf->exists('disable_setup_suspended_pkgs') &&
2320           ! $cust_pkg->getfield('susp')
2321         ) || ! $conf->exists('disable_setup_suspended_pkgs')
2322        )
2323     || $options{'resetup'}
2324   ) {
2325
2326     warn "    bill setup\n" if $DEBUG > 1;
2327     $lineitems++;
2328
2329     $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
2330     return "$@ running calc_setup for $cust_pkg\n"
2331       if $@;
2332
2333     $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
2334
2335     $cust_pkg->setfield('setup', $time)
2336       unless $cust_pkg->setup;
2337           #do need it, but it won't get written to the db
2338           #|| $cust_pkg->pkgpart != $real_pkgpart;
2339
2340   }
2341
2342   ###
2343   # bill recurring fee
2344   ###
2345
2346   #XXX unit stuff here too
2347   my $recur = 0;
2348   my $unitrecur = 0;
2349   my $sdate;
2350   if ( $part_pkg->getfield('freq') ne '0' &&
2351        ! $cust_pkg->getfield('susp') &&
2352        ( $cust_pkg->getfield('bill') || 0 ) <= $time
2353   ) {
2354
2355     # XXX should this be a package event?  probably.  events are called
2356     # at collection time at the moment, though...
2357     $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
2358       if $part_pkg->can('reset_usage');
2359       #don't want to reset usage just cause we want a line item??
2360       #&& $part_pkg->pkgpart == $real_pkgpart;
2361
2362     warn "    bill recur\n" if $DEBUG > 1;
2363     $lineitems++;
2364
2365     # XXX shared with $recur_prog
2366     $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2367
2368     #over two params!  lets at least switch to a hashref for the rest...
2369     my %param = ( 'precommit_hooks' => $precommit_hooks, );
2370
2371     $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
2372     return "$@ running calc_recur for $cust_pkg\n"
2373       if ( $@ );
2374
2375
2376     #change this bit to use Date::Manip? CAREFUL with timezones (see
2377     # mailing list archive)
2378     my ($sec,$min,$hour,$mday,$mon,$year) =
2379       (localtime($sdate) )[0,1,2,3,4,5];
2380
2381     #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
2382     # only for figuring next bill date, nothing else, so, reset $sdate again
2383     # here
2384     $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2385     $cust_pkg->last_bill($sdate);
2386
2387     if ( $part_pkg->freq =~ /^\d+$/ ) {
2388       $mon += $part_pkg->freq;
2389       until ( $mon < 12 ) { $mon -= 12; $year++; }
2390     } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
2391       my $weeks = $1;
2392       $mday += $weeks * 7;
2393     } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
2394       my $days = $1;
2395       $mday += $days;
2396     } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
2397       my $hours = $1;
2398       $hour += $hours;
2399     } else {
2400       return "unparsable frequency: ". $part_pkg->freq;
2401     }
2402     $cust_pkg->setfield('bill',
2403       timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
2404
2405   }
2406
2407   warn "\$setup is undefined" unless defined($setup);
2408   warn "\$recur is undefined" unless defined($recur);
2409   warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
2410
2411   ###
2412   # If there's line items, create em cust_bill_pkg records
2413   # If $cust_pkg has been modified, update it (if we're a real pkgpart)
2414   ###
2415
2416   if ( $lineitems ) {
2417
2418     if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
2419       # hmm.. and if just the options are modified in some weird price plan?
2420
2421       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
2422         if $DEBUG >1;
2423
2424       my $error = $cust_pkg->replace( $old_cust_pkg,
2425                                       'options' => { $cust_pkg->options },
2426                                     );
2427       return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
2428         if $error; #just in case
2429     }
2430
2431     $setup = sprintf( "%.2f", $setup );
2432     $recur = sprintf( "%.2f", $recur );
2433     if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
2434       return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
2435     }
2436     if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
2437       return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
2438     }
2439
2440     if ( $setup != 0 || $recur != 0 ) {
2441
2442       warn "    charges (setup=$setup, recur=$recur); adding line items\n"
2443         if $DEBUG > 1;
2444
2445       my $cust_bill_pkg = new FS::cust_bill_pkg {
2446         'pkgnum'    => $cust_pkg->pkgnum,
2447         'setup'     => $setup,
2448         'unitsetup' => $unitsetup,
2449         'recur'     => $recur,
2450         'unitrecur' => $unitrecur,
2451         'quantity'  => $cust_pkg->quantity,
2452         'sdate'     => $sdate,
2453         'edate'     => $cust_pkg->bill,
2454         'details'   => \@details,
2455       };
2456       $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
2457         unless $part_pkg->pkgpart == $real_pkgpart;
2458
2459       $$total_setup += $setup;
2460       $$total_recur += $recur;
2461
2462       ###
2463       # handle taxes
2464       ###
2465
2466       my $err_or_cust_bill_pkg =
2467         $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg);
2468
2469       return $err_or_cust_bill_pkg
2470         unless ( ref($err_or_cust_bill_pkg) );
2471
2472       push @$cust_bill_pkgs, @$err_or_cust_bill_pkg;
2473
2474     } #if $setup != 0 || $recur != 0
2475
2476   } #if $line_items
2477
2478   '';
2479
2480 }
2481
2482 sub _handle_taxes {
2483   my $self = shift;
2484   my $part_pkg = shift;
2485   my $taxlisthash = shift;
2486   my $cust_bill_pkg = shift;
2487   my $cust_pkg = shift;
2488
2489   my %cust_bill_pkg = ();
2490   my %taxes = ();
2491
2492   my $prefix =
2493     ( $conf->exists('tax-ship_address') && length($self->ship_last) )
2494     ? 'ship_'
2495     : '';
2496
2497   my @classes;
2498   #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
2499   push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
2500   push @classes, 'setup' if $cust_bill_pkg->setup;
2501   push @classes, 'recur' if $cust_bill_pkg->recur;
2502
2503   if ( $conf->exists('enable_taxproducts')
2504        && (scalar($part_pkg->part_pkg_taxoverride) || $part_pkg->has_taxproduct)
2505        && ( $self->tax !~ /Y/i && $self->payby ne 'COMP' )
2506      )
2507   {
2508
2509     foreach my $class (@classes) {
2510       my $err_or_ref = $self->_gather_taxes( $part_pkg, $class, $prefix );
2511       return $err_or_ref unless ref($err_or_ref);
2512       $taxes{$class} = $err_or_ref;
2513     }
2514
2515     unless (exists $taxes{''}) {
2516       my $err_or_ref = $self->_gather_taxes( $part_pkg, '', $prefix );
2517       return $err_or_ref unless ref($err_or_ref);
2518       $taxes{''} = $err_or_ref;
2519     }
2520
2521   }elsif ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
2522
2523     my %taxhash = map { $_ => $self->get("$prefix$_") }
2524                       qw( state county country );
2525
2526     $taxhash{'taxclass'} = $part_pkg->taxclass;
2527
2528     my @taxes = qsearch( 'cust_main_county', \%taxhash );
2529
2530     unless ( @taxes ) {
2531       $taxhash{'taxclass'} = '';
2532       @taxes =  qsearch( 'cust_main_county', \%taxhash );
2533     }
2534
2535     #one more try at a whole-country tax rate
2536     unless ( @taxes ) {
2537       $taxhash{$_} = '' foreach qw( state county );
2538       @taxes =  qsearch( 'cust_main_county', \%taxhash );
2539     }
2540
2541     $taxes{''} = [ @taxes ];
2542     $taxes{'setup'} = [ @taxes ];
2543     $taxes{'recur'} = [ @taxes ];
2544     $taxes{$_} = [ @taxes ] foreach (@classes);
2545
2546     # maybe eliminate this entirely, along with all the 0% records
2547     unless ( @taxes ) {
2548       return
2549         "fatal: can't find tax rate for state/county/country/taxclass ".
2550         join('/', ( map $self->get("$prefix$_"),
2551                         qw(state county country)
2552                   ),
2553                   $part_pkg->taxclass ). "\n";
2554     }
2555
2556   } #if $conf->exists('enable_taxproducts') ...
2557
2558   my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!')
2559     if $cust_pkg->part_pkg->option('separate_usage');
2560   my $want_duplicate =
2561     $cust_pkg->part_pkg->option('summarize_usage', 'Hush!') &&
2562     $cust_pkg->part_pkg->option('usage_section', 'Hush!');
2563
2564   # XXX this mostly goes away with cust_bill_pkg refactor
2565
2566   $cust_bill_pkg{setup} = $cust_bill_pkg if $cust_bill_pkg->setup;
2567   $cust_bill_pkg{recur} = $cust_bill_pkg if $cust_bill_pkg->recur;
2568
2569   #split setup and recur
2570   if ($cust_bill_pkg->setup && $cust_bill_pkg->recur) {
2571     my $cust_bill_pkg_recur = new FS::cust_bill_pkg { $cust_bill_pkg->hash };
2572     $cust_bill_pkg->set('details', []);
2573     $cust_bill_pkg->recur(0);
2574     $cust_bill_pkg->unitrecur(0);
2575     $cust_bill_pkg->type('');
2576     $cust_bill_pkg_recur->setup(0);
2577     $cust_bill_pkg_recur->unitsetup(0);
2578     $cust_bill_pkg{recur} = $cust_bill_pkg_recur;
2579   }
2580
2581   #split usage from recur
2582   my $usage = sprintf( "%.2f", $cust_bill_pkg{recur}->usage );
2583   warn "usage is $usage\n" if $DEBUG;
2584   if ($usage) {
2585     my $cust_bill_pkg_usage =
2586         new FS::cust_bill_pkg { $cust_bill_pkg{recur}->hash };
2587     $cust_bill_pkg_usage->recur( $usage );
2588     $cust_bill_pkg_usage->type( 'U' );
2589     $cust_bill_pkg_usage->duplicate( $want_duplicate ? 'Y' :  '' );
2590     $cust_bill_pkg_usage->section( $section );
2591     $cust_bill_pkg_usage->post_total( $want_duplicate ? 'Y' :  '' );
2592     my $recur = sprintf( "%.2f", $cust_bill_pkg{recur}->recur - $usage );
2593     $cust_bill_pkg{recur}->recur( $recur );
2594     $cust_bill_pkg{recur}->type( '' );
2595     $cust_bill_pkg{recur}->set('details', []);
2596     $cust_bill_pkg{''} = $cust_bill_pkg_usage;
2597   }
2598
2599   #subdivide usage by usage_class
2600   if (exists($cust_bill_pkg{''})) {
2601     foreach my $class (grep {$_ && $_ ne 'setup' && $_ ne 'recur' } @classes) {
2602       my $usage = sprintf( "%.2f", $cust_bill_pkg{''}->usage($class) );
2603       my $cust_bill_pkg_usage =
2604           new FS::cust_bill_pkg { $cust_bill_pkg{''}->hash };
2605       $cust_bill_pkg_usage->recur( $usage );
2606       $cust_bill_pkg_usage->set('details', []);
2607       my $classless = sprintf( "%.2f", $cust_bill_pkg{''}->recur - $usage );
2608       $cust_bill_pkg{''}->recur( $classless );
2609       $cust_bill_pkg{$class} = $cust_bill_pkg_usage;
2610     }
2611     delete $cust_bill_pkg{''} unless $cust_bill_pkg{''}->recur;
2612   }
2613
2614   foreach my $key (keys %cust_bill_pkg) {
2615     my @taxes = @{ $taxes{$key} };
2616     my $cust_bill_pkg = $cust_bill_pkg{$key};
2617
2618     foreach my $tax ( @taxes ) {
2619       my $taxname = ref( $tax ). ' '. $tax->taxnum;
2620       if ( exists( $taxlisthash->{ $taxname } ) ) {
2621         push @{ $taxlisthash->{ $taxname  } }, $cust_bill_pkg;
2622       }else{
2623         $taxlisthash->{ $taxname } = [ $tax, $cust_bill_pkg ];
2624       }
2625     }
2626   }
2627
2628   # sort setup,recur,'', and the rest numeric && return
2629   my @result = map { $cust_bill_pkg{$_} }
2630                sort { my $ad = ($a=~/^\d+$/); my $bd = ($b=~/^\d+$/);
2631                       ( $ad cmp $bd ) || ( $ad ? $a<=>$b : $b cmp $a )
2632                     }
2633                keys %cust_bill_pkg;
2634
2635   \@result;
2636 }
2637
2638 sub _gather_taxes {
2639   my $self = shift;
2640   my $part_pkg = shift;
2641   my $class = shift;
2642   my $prefix = shift;
2643
2644   my @taxes = ();
2645   my $geocode = $self->geocode('cch');
2646
2647   my @taxclassnums = map { $_->taxclassnum }
2648                      $part_pkg->part_pkg_taxoverride($class);
2649
2650   unless (@taxclassnums) {
2651     @taxclassnums = map { $_->taxclassnum }
2652                     $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
2653   }
2654   warn "Found taxclassnum values of ". join(',', @taxclassnums)
2655     if $DEBUG;
2656
2657   my $extra_sql =
2658     "AND (".
2659     join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
2660
2661   @taxes = qsearch({ 'table' => 'tax_rate',
2662                      'hashref' => { 'geocode' => $geocode, },
2663                      'extra_sql' => $extra_sql,
2664                   })
2665     if scalar(@taxclassnums);
2666
2667   # maybe eliminate this entirely, along with all the 0% records
2668   unless ( @taxes ) {
2669     return
2670       "fatal: can't find tax rate for zip/taxproduct/pkgpart ".
2671       join('/', ( map $self->get("$prefix$_"),
2672                       qw(zip)
2673                 ),
2674                 $part_pkg->taxproduct_description,
2675                 $part_pkg->pkgpart ). "\n";
2676   }
2677
2678   warn "Found taxes ".
2679        join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
2680    if $DEBUG;
2681
2682   [ @taxes ];
2683
2684 }
2685
2686 =item collect OPTIONS
2687
2688 (Attempt to) collect money for this customer's outstanding invoices (see
2689 L<FS::cust_bill>).  Usually used after the bill method.
2690
2691 Actions are now triggered by billing events; see L<FS::part_event> and the
2692 billing events web interface.  Old-style invoice events (see
2693 L<FS::part_bill_event>) have been deprecated.
2694
2695 If there is an error, returns the error, otherwise returns false.
2696
2697 Options are passed as name-value pairs.
2698
2699 Currently available options are:
2700
2701 =over 4
2702
2703 =item invoice_time
2704
2705 Use this time when deciding when to print invoices and 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> for conversion functions.
2706
2707 =item retry
2708
2709 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
2710
2711 =item quiet
2712
2713 set true to surpress email card/ACH decline notices.
2714
2715 =item check_freq
2716
2717 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2718
2719 =item payby
2720
2721 allows for one time override of normal customer billing method
2722
2723 =item debug
2724
2725 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
2726
2727
2728 =back
2729
2730 =cut
2731
2732 sub collect {
2733   my( $self, %options ) = @_;
2734   my $invoice_time = $options{'invoice_time'} || time;
2735
2736   #put below somehow?
2737   local $SIG{HUP} = 'IGNORE';
2738   local $SIG{INT} = 'IGNORE';
2739   local $SIG{QUIT} = 'IGNORE';
2740   local $SIG{TERM} = 'IGNORE';
2741   local $SIG{TSTP} = 'IGNORE';
2742   local $SIG{PIPE} = 'IGNORE';
2743
2744   my $oldAutoCommit = $FS::UID::AutoCommit;
2745   local $FS::UID::AutoCommit = 0;
2746   my $dbh = dbh;
2747
2748   $self->select_for_update; #mutex
2749
2750   if ( $DEBUG ) {
2751     my $balance = $self->balance;
2752     warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2753   }
2754
2755   if ( exists($options{'retry_card'}) ) {
2756     carp 'retry_card option passed to collect is deprecated; use retry';
2757     $options{'retry'} ||= $options{'retry_card'};
2758   }
2759   if ( exists($options{'retry'}) && $options{'retry'} ) {
2760     my $error = $self->retry_realtime;
2761     if ( $error ) {
2762       $dbh->rollback if $oldAutoCommit;
2763       return $error;
2764     }
2765   }
2766
2767   # false laziness w/pay_batch::import_results
2768
2769   my $due_cust_event = $self->due_cust_event(
2770     'debug'      => ( $options{'debug'} || 0 ),
2771     'time'       => $invoice_time,
2772     'check_freq' => $options{'check_freq'},
2773   );
2774   unless( ref($due_cust_event) ) {
2775     $dbh->rollback if $oldAutoCommit;
2776     return $due_cust_event;
2777   }
2778
2779   foreach my $cust_event ( @$due_cust_event ) {
2780
2781     #XXX lock event
2782
2783     #re-eval event conditions (a previous event could have changed things)
2784     unless ( $cust_event->test_conditions( 'time' => $invoice_time ) ) {
2785       #don't leave stray "new/locked" records around
2786       my $error = $cust_event->delete;
2787       if ( $error ) {
2788         #gah, even with transactions
2789         $dbh->commit if $oldAutoCommit; #well.
2790         return $error;
2791       }
2792       next;
2793     }
2794
2795     {
2796       local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2797       warn "  running cust_event ". $cust_event->eventnum. "\n"
2798         if $DEBUG > 1;
2799
2800
2801       #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
2802       if ( my $error = $cust_event->do_event() ) {
2803         #XXX wtf is this?  figure out a proper dealio with return value
2804         #from do_event
2805           # gah, even with transactions.
2806           $dbh->commit if $oldAutoCommit; #well.
2807           return $error;
2808         }
2809     }
2810
2811   }
2812
2813   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2814   '';
2815
2816 }
2817
2818 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
2819
2820 Inserts database records for and returns an ordered listref of new events due
2821 for this customer, as FS::cust_event objects (see L<FS::cust_event>).  If no
2822 events are due, an empty listref is returned.  If there is an error, returns a
2823 scalar error message.
2824
2825 To actually run the events, call each event's test_condition method, and if
2826 still true, call the event's do_event method.
2827
2828 Options are passed as a hashref or as a list of name-value pairs.  Available
2829 options are:
2830
2831 =over 4
2832
2833 =item check_freq
2834
2835 Search only for events of this check frequency (how often events of this type are checked); currently "1d" (daily, the default) and "1m" (monthly) are recognized.
2836
2837 =item time
2838
2839 "Current time" for the events.
2840
2841 =item debug
2842
2843 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
2844
2845 =item eventtable
2846
2847 Only return events for the specified eventtable (by default, events of all eventtables are returned)
2848
2849 =item objects
2850
2851 Explicitly pass the objects to be tested (typically used with eventtable).
2852
2853 =back
2854
2855 =cut
2856
2857 sub due_cust_event {
2858   my $self = shift;
2859   my %opt = ref($_[0]) ? %{ $_[0] } : @_;
2860
2861   #???
2862   #my $DEBUG = $opt{'debug'}
2863   local($DEBUG) = $opt{'debug'}
2864     if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
2865
2866   warn "$me due_cust_event called with options ".
2867        join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
2868     if $DEBUG;
2869
2870   $opt{'time'} ||= time;
2871
2872   local $SIG{HUP} = 'IGNORE';
2873   local $SIG{INT} = 'IGNORE';
2874   local $SIG{QUIT} = 'IGNORE';
2875   local $SIG{TERM} = 'IGNORE';
2876   local $SIG{TSTP} = 'IGNORE';
2877   local $SIG{PIPE} = 'IGNORE';
2878
2879   my $oldAutoCommit = $FS::UID::AutoCommit;
2880   local $FS::UID::AutoCommit = 0;
2881   my $dbh = dbh;
2882
2883   $self->select_for_update; #mutex
2884
2885   ###
2886   # 1: find possible events (initial search)
2887   ###
2888
2889   my @cust_event = ();
2890
2891   my @eventtable = $opt{'eventtable'}
2892                      ? ( $opt{'eventtable'} )
2893                      : FS::part_event->eventtables_runorder;
2894
2895   foreach my $eventtable ( @eventtable ) {
2896
2897     my @objects;
2898     if ( $opt{'objects'} ) {
2899
2900       @objects = @{ $opt{'objects'} };
2901
2902     } else {
2903
2904       #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
2905       @objects = ( $eventtable eq 'cust_main' )
2906                    ? ( $self )
2907                    : ( $self->$eventtable() );
2908
2909     }
2910
2911     my @e_cust_event = ();
2912
2913     my $cross = "CROSS JOIN $eventtable";
2914     $cross .= ' LEFT JOIN cust_main USING ( custnum )'
2915       unless $eventtable eq 'cust_main';
2916
2917     foreach my $object ( @objects ) {
2918
2919       #this first search uses the condition_sql magic for optimization.
2920       #the more possible events we can eliminate in this step the better
2921
2922       my $cross_where = '';
2923       my $pkey = $object->primary_key;
2924       $cross_where = "$eventtable.$pkey = ". $object->$pkey();
2925
2926       my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
2927       my $extra_sql =
2928         FS::part_event_condition->where_conditions_sql( $eventtable,
2929                                                         'time'=>$opt{'time'}
2930                                                       );
2931       my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
2932
2933       $extra_sql = "AND $extra_sql" if $extra_sql;
2934
2935       #here is the agent virtualization
2936       $extra_sql .= " AND (    part_event.agentnum IS NULL
2937                             OR part_event.agentnum = ". $self->agentnum. ' )';
2938
2939       $extra_sql .= " $order";
2940
2941       warn "searching for events for $eventtable ". $object->$pkey. "\n"
2942         if $opt{'debug'} > 2;
2943       my @part_event = qsearch( {
2944         'debug'     => ( $opt{'debug'} > 3 ? 1 : 0 ),
2945         'select'    => 'part_event.*',
2946         'table'     => 'part_event',
2947         'addl_from' => "$cross $join",
2948         'hashref'   => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
2949                          'eventtable' => $eventtable,
2950                          'disabled'   => '',
2951                        },
2952         'extra_sql' => "AND $cross_where $extra_sql",
2953       } );
2954
2955       if ( $DEBUG > 2 ) {
2956         my $pkey = $object->primary_key;
2957         warn "      ". scalar(@part_event).
2958              " possible events found for $eventtable ". $object->$pkey(). "\n";
2959       }
2960
2961       push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
2962
2963     }
2964
2965     warn "    ". scalar(@e_cust_event).
2966          " subtotal possible cust events found for $eventtable\n"
2967       if $DEBUG > 1;
2968
2969     push @cust_event, @e_cust_event;
2970
2971   }
2972
2973   warn "  ". scalar(@cust_event).
2974        " total possible cust events found in initial search\n"
2975     if $DEBUG; # > 1;
2976
2977   ##
2978   # 2: test conditions
2979   ##
2980
2981   my %unsat = ();
2982
2983   @cust_event = grep $_->test_conditions( 'time'          => $opt{'time'},
2984                                           'stats_hashref' => \%unsat ),
2985                      @cust_event;
2986
2987   warn "  ". scalar(@cust_event). " cust events left satisfying conditions\n"
2988     if $DEBUG; # > 1;
2989
2990   warn "    invalid conditions not eliminated with condition_sql:\n".
2991        join('', map "      $_: ".$unsat{$_}."\n", keys %unsat )
2992     if $DEBUG; # > 1;
2993
2994   ##
2995   # 3: insert
2996   ##
2997
2998   foreach my $cust_event ( @cust_event ) {
2999
3000     my $error = $cust_event->insert();
3001     if ( $error ) {
3002       $dbh->rollback if $oldAutoCommit;
3003       return $error;
3004     }
3005
3006   }
3007
3008   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3009
3010   ##
3011   # 4: return
3012   ##
3013
3014   warn "  returning events: ". Dumper(@cust_event). "\n"
3015     if $DEBUG > 2;
3016
3017   \@cust_event;
3018
3019 }
3020
3021 =item retry_realtime
3022
3023 Schedules realtime / batch  credit card / electronic check / LEC billing
3024 events for for retry.  Useful if card information has changed or manual
3025 retry is desired.  The 'collect' method must be called to actually retry
3026 the transaction.
3027
3028 Implementation details: For either this customer, or for each of this
3029 customer's open invoices, changes the status of the first "done" (with
3030 statustext error) realtime processing event to "failed".
3031
3032 =cut
3033
3034 sub retry_realtime {
3035   my $self = shift;
3036
3037   local $SIG{HUP} = 'IGNORE';
3038   local $SIG{INT} = 'IGNORE';
3039   local $SIG{QUIT} = 'IGNORE';
3040   local $SIG{TERM} = 'IGNORE';
3041   local $SIG{TSTP} = 'IGNORE';
3042   local $SIG{PIPE} = 'IGNORE';
3043
3044   my $oldAutoCommit = $FS::UID::AutoCommit;
3045   local $FS::UID::AutoCommit = 0;
3046   my $dbh = dbh;
3047
3048   #a little false laziness w/due_cust_event (not too bad, really)
3049
3050   my $join = FS::part_event_condition->join_conditions_sql;
3051   my $order = FS::part_event_condition->order_conditions_sql;
3052   my $mine =
3053   '( '
3054    . join ( ' OR ' , map {
3055     "( part_event.eventtable = " . dbh->quote($_)
3056     . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3057    } FS::part_event->eventtables)
3058    . ') ';
3059
3060   #here is the agent virtualization
3061   my $agent_virt = " (    part_event.agentnum IS NULL
3062                        OR part_event.agentnum = ". $self->agentnum. ' )';
3063
3064   #XXX this shouldn't be hardcoded, actions should declare it...
3065   my @realtime_events = qw(
3066     cust_bill_realtime_card
3067     cust_bill_realtime_check
3068     cust_bill_realtime_lec
3069     cust_bill_batch
3070   );
3071
3072   my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3073                                                   @realtime_events
3074                                      ).
3075                           ' ) ';
3076
3077   my @cust_event = qsearchs({
3078     'table'     => 'cust_event',
3079     'select'    => 'cust_event.*',
3080     'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3081     'hashref'   => { 'status' => 'done' },
3082     'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3083                    " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3084   });
3085
3086   my %seen_invnum = ();
3087   foreach my $cust_event (@cust_event) {
3088
3089     #max one for the customer, one for each open invoice
3090     my $cust_X = $cust_event->cust_X;
3091     next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3092                           ? $cust_X->invnum
3093                           : 0
3094                         }++
3095          or $cust_event->part_event->eventtable eq 'cust_bill'
3096             && ! $cust_X->owed;
3097
3098     my $error = $cust_event->retry;
3099     if ( $error ) {
3100       $dbh->rollback if $oldAutoCommit;
3101       return "error scheduling event for retry: $error";
3102     }
3103
3104   }
3105
3106   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3107   '';
3108
3109 }
3110
3111 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
3112
3113 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
3114 via a Business::OnlinePayment realtime gateway.  See
3115 L<http://420.am/business-onlinepayment> for supported gateways.
3116
3117 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3118
3119 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
3120
3121 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3122 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
3123 if set, will override the value from the customer record.
3124
3125 I<description> is a free-text field passed to the gateway.  It defaults to
3126 "Internet services".
3127
3128 If an I<invnum> is specified, this payment (if successful) is applied to the
3129 specified invoice.  If you don't specify an I<invnum> you might want to
3130 call the B<apply_payments> method.
3131
3132 I<quiet> can be set true to surpress email decline notices.
3133
3134 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
3135 resulting paynum, if any.
3136
3137 I<payunique> is a unique identifier for this payment.
3138
3139 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
3140
3141 =cut
3142
3143 sub realtime_bop {
3144   my( $self, $method, $amount, %options ) = @_;
3145   if ( $DEBUG ) {
3146     warn "$me realtime_bop: $method $amount\n";
3147     warn "  $_ => $options{$_}\n" foreach keys %options;
3148   }
3149
3150   $options{'description'} ||= 'Internet services';
3151
3152   return $self->fake_bop($method, $amount, %options) if $options{'fake'};
3153
3154   eval "use Business::OnlinePayment";
3155   die $@ if $@;
3156
3157   my $payinfo = exists($options{'payinfo'})
3158                   ? $options{'payinfo'}
3159                   : $self->payinfo;
3160
3161   my %method2payby = (
3162     'CC'     => 'CARD',
3163     'ECHECK' => 'CHEK',
3164     'LEC'    => 'LECB',
3165   );
3166
3167   ###
3168   # check for banned credit card/ACH
3169   ###
3170
3171   my $ban = qsearchs('banned_pay', {
3172     'payby'   => $method2payby{$method},
3173     'payinfo' => md5_base64($payinfo),
3174   } );
3175   return "Banned credit card" if $ban;
3176
3177   ###
3178   # select a gateway
3179   ###
3180
3181   my $taxclass = '';
3182   if ( $options{'invnum'} ) {
3183     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
3184     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
3185     my @taxclasses =
3186       map  { $_->part_pkg->taxclass }
3187       grep { $_ }
3188       map  { $_->cust_pkg }
3189       $cust_bill->cust_bill_pkg;
3190     unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
3191                                                            #different taxclasses
3192       $taxclass = $taxclasses[0];
3193     }
3194   }
3195
3196   #look for an agent gateway override first
3197   my $cardtype;
3198   if ( $method eq 'CC' ) {
3199     $cardtype = cardtype($payinfo);
3200   } elsif ( $method eq 'ECHECK' ) {
3201     $cardtype = 'ACH';
3202   } else {
3203     $cardtype = $method;
3204   }
3205
3206   my $override =
3207        qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3208                                            cardtype => $cardtype,
3209                                            taxclass => $taxclass,       } )
3210     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3211                                            cardtype => '',
3212                                            taxclass => $taxclass,       } )
3213     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3214                                            cardtype => $cardtype,
3215                                            taxclass => '',              } )
3216     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3217                                            cardtype => '',
3218                                            taxclass => '',              } );
3219
3220   my $payment_gateway = '';
3221   my( $processor, $login, $password, $action, @bop_options );
3222   if ( $override ) { #use a payment gateway override
3223
3224     $payment_gateway = $override->payment_gateway;
3225
3226     $processor   = $payment_gateway->gateway_module;
3227     $login       = $payment_gateway->gateway_username;
3228     $password    = $payment_gateway->gateway_password;
3229     $action      = $payment_gateway->gateway_action;
3230     @bop_options = $payment_gateway->options;
3231
3232   } else { #use the standard settings from the config
3233
3234     ( $processor, $login, $password, $action, @bop_options ) =
3235       $self->default_payment_gateway($method);
3236
3237   }
3238
3239   ###
3240   # massage data
3241   ###
3242
3243   my $address = exists($options{'address1'})
3244                     ? $options{'address1'}
3245                     : $self->address1;
3246   my $address2 = exists($options{'address2'})
3247                     ? $options{'address2'}
3248                     : $self->address2;
3249   $address .= ", ". $address2 if length($address2);
3250
3251   my $o_payname = exists($options{'payname'})
3252                     ? $options{'payname'}
3253                     : $self->payname;
3254   my($payname, $payfirst, $paylast);
3255   if ( $o_payname && $method ne 'ECHECK' ) {
3256     ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3257       or return "Illegal payname $payname";
3258     ($payfirst, $paylast) = ($1, $2);
3259   } else {
3260     $payfirst = $self->getfield('first');
3261     $paylast = $self->getfield('last');
3262     $payname =  "$payfirst $paylast";
3263   }
3264
3265   my @invoicing_list = $self->invoicing_list_emailonly;
3266   if ( $conf->exists('emailinvoiceautoalways')
3267        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3268        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3269     push @invoicing_list, $self->all_emails;
3270   }
3271
3272   my $email = ($conf->exists('business-onlinepayment-email-override'))
3273               ? $conf->config('business-onlinepayment-email-override')
3274               : $invoicing_list[0];
3275
3276   my %content = ();
3277
3278   my $payip = exists($options{'payip'})
3279                 ? $options{'payip'}
3280                 : $self->payip;
3281   $content{customer_ip} = $payip
3282     if length($payip);
3283
3284   $content{invoice_number} = $options{'invnum'}
3285     if exists($options{'invnum'}) && length($options{'invnum'});
3286
3287   $content{email_customer} =
3288     (    $conf->exists('business-onlinepayment-email_customer')
3289       || $conf->exists('business-onlinepayment-email-override') );
3290
3291   my $paydate = '';
3292   if ( $method eq 'CC' ) {
3293
3294     $content{card_number} = $payinfo;
3295     $paydate = exists($options{'paydate'})
3296                     ? $options{'paydate'}
3297                     : $self->paydate;
3298     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3299     $content{expiration} = "$2/$1";
3300
3301     my $paycvv = exists($options{'paycvv'})
3302                    ? $options{'paycvv'}
3303                    : $self->paycvv;
3304     $content{cvv2} = $paycvv
3305       if length($paycvv);
3306
3307     my $paystart_month = exists($options{'paystart_month'})
3308                            ? $options{'paystart_month'}
3309                            : $self->paystart_month;
3310
3311     my $paystart_year  = exists($options{'paystart_year'})
3312                            ? $options{'paystart_year'}
3313                            : $self->paystart_year;
3314
3315     $content{card_start} = "$paystart_month/$paystart_year"
3316       if $paystart_month && $paystart_year;
3317
3318     my $payissue       = exists($options{'payissue'})
3319                            ? $options{'payissue'}
3320                            : $self->payissue;
3321     $content{issue_number} = $payissue if $payissue;
3322
3323     $content{recurring_billing} = 'YES'
3324       if qsearch('cust_pay', { 'custnum' => $self->custnum,
3325                                'payby'   => 'CARD',
3326                                'payinfo' => $payinfo,
3327                              } )
3328       || qsearch('cust_pay', { 'custnum' => $self->custnum,
3329                                'payby'   => 'CARD',
3330                                'paymask' => $self->mask_payinfo('CARD', $payinfo),
3331                              } );
3332
3333
3334   } elsif ( $method eq 'ECHECK' ) {
3335     ( $content{account_number}, $content{routing_code} ) =
3336       split('@', $payinfo);
3337     $content{bank_name} = $o_payname;
3338     $content{bank_state} = exists($options{'paystate'})
3339                              ? $options{'paystate'}
3340                              : $self->getfield('paystate');
3341     $content{account_type} = exists($options{'paytype'})
3342                                ? uc($options{'paytype'}) || 'CHECKING'
3343                                : uc($self->getfield('paytype')) || 'CHECKING';
3344     $content{account_name} = $payname;
3345     $content{customer_org} = $self->company ? 'B' : 'I';
3346     $content{state_id}       = exists($options{'stateid'})
3347                                  ? $options{'stateid'}
3348                                  : $self->getfield('stateid');
3349     $content{state_id_state} = exists($options{'stateid_state'})
3350                                  ? $options{'stateid_state'}
3351                                  : $self->getfield('stateid_state');
3352     $content{customer_ssn} = exists($options{'ss'})
3353                                ? $options{'ss'}
3354                                : $self->ss;
3355   } elsif ( $method eq 'LEC' ) {
3356     $content{phone} = $payinfo;
3357   }
3358
3359   ###
3360   # run transaction(s)
3361   ###
3362
3363   my $balance = exists( $options{'balance'} )
3364                   ? $options{'balance'}
3365                   : $self->balance;
3366
3367   $self->select_for_update; #mutex ... just until we get our pending record in
3368
3369   #the checks here are intended to catch concurrent payments
3370   #double-form-submission prevention is taken care of in cust_pay_pending::check
3371
3372   #check the balance
3373   return "The customer's balance has changed; $method transaction aborted."
3374     if $self->balance < $balance;
3375     #&& $self->balance < $amount; #might as well anyway?
3376
3377   #also check and make sure there aren't *other* pending payments for this cust
3378
3379   my @pending = qsearch('cust_pay_pending', {
3380     'custnum' => $self->custnum,
3381     'status'  => { op=>'!=', value=>'done' }
3382   });
3383   return "A payment is already being processed for this customer (".
3384          join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
3385          "); $method transaction aborted."
3386     if scalar(@pending);
3387
3388   #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
3389
3390   my $cust_pay_pending = new FS::cust_pay_pending {
3391     'custnum'    => $self->custnum,
3392     #'invnum'     => $options{'invnum'},
3393     'paid'       => $amount,
3394     '_date'      => '',
3395     'payby'      => $method2payby{$method},
3396     'payinfo'    => $payinfo,
3397     'paydate'    => $paydate,
3398     'status'     => 'new',
3399     'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
3400   };
3401   $cust_pay_pending->payunique( $options{payunique} )
3402     if defined($options{payunique}) && length($options{payunique});
3403   my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
3404   return $cpp_new_err if $cpp_new_err;
3405
3406   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
3407
3408   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
3409   $transaction->content(
3410     'type'           => $method,
3411     'login'          => $login,
3412     'password'       => $password,
3413     'action'         => $action1,
3414     'description'    => $options{'description'},
3415     'amount'         => $amount,
3416     #'invoice_number' => $options{'invnum'},
3417     'customer_id'    => $self->custnum,
3418     'last_name'      => $paylast,
3419     'first_name'     => $payfirst,
3420     'name'           => $payname,
3421     'address'        => $address,
3422     'city'           => ( exists($options{'city'})
3423                             ? $options{'city'}
3424                             : $self->city          ),
3425     'state'          => ( exists($options{'state'})
3426                             ? $options{'state'}
3427                             : $self->state          ),
3428     'zip'            => ( exists($options{'zip'})
3429                             ? $options{'zip'}
3430                             : $self->zip          ),
3431     'country'        => ( exists($options{'country'})
3432                             ? $options{'country'}
3433                             : $self->country          ),
3434     'referer'        => 'http://cleanwhisker.420.am/',
3435     'email'          => $email,
3436     'phone'          => $self->daytime || $self->night,
3437     %content, #after
3438   );
3439
3440   $cust_pay_pending->status('pending');
3441   my $cpp_pending_err = $cust_pay_pending->replace;
3442   return $cpp_pending_err if $cpp_pending_err;
3443
3444   #config?
3445   my $BOP_TESTING = 0;
3446   my $BOP_TESTING_SUCCESS = 1;
3447
3448   unless ( $BOP_TESTING ) {
3449     $transaction->submit();
3450   } else {
3451     if ( $BOP_TESTING_SUCCESS ) {
3452       $transaction->is_success(1);
3453       $transaction->authorization('fake auth');
3454     } else {
3455       $transaction->is_success(0);
3456       $transaction->error_message('fake failure');
3457     }
3458   }
3459
3460   if ( $transaction->is_success() && $action2 ) {
3461
3462     $cust_pay_pending->status('authorized');
3463     my $cpp_authorized_err = $cust_pay_pending->replace;
3464     return $cpp_authorized_err if $cpp_authorized_err;
3465
3466     my $auth = $transaction->authorization;
3467     my $ordernum = $transaction->can('order_number')
3468                    ? $transaction->order_number
3469                    : '';
3470
3471     my $capture =
3472       new Business::OnlinePayment( $processor, @bop_options );
3473
3474     my %capture = (
3475       %content,
3476       type           => $method,
3477       action         => $action2,
3478       login          => $login,
3479       password       => $password,
3480       order_number   => $ordernum,
3481       amount         => $amount,
3482       authorization  => $auth,
3483       description    => $options{'description'},
3484     );
3485
3486     foreach my $field (qw( authorization_source_code returned_ACI
3487                            transaction_identifier validation_code
3488                            transaction_sequence_num local_transaction_date
3489                            local_transaction_time AVS_result_code          )) {
3490       $capture{$field} = $transaction->$field() if $transaction->can($field);
3491     }
3492
3493     $capture->content( %capture );
3494
3495     $capture->submit();
3496
3497     unless ( $capture->is_success ) {
3498       my $e = "Authorization successful but capture failed, custnum #".
3499               $self->custnum. ': '.  $capture->result_code.
3500               ": ". $capture->error_message;
3501       warn $e;
3502       return $e;
3503     }
3504
3505   }
3506
3507   $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
3508   my $cpp_captured_err = $cust_pay_pending->replace;
3509   return $cpp_captured_err if $cpp_captured_err;
3510
3511   ###
3512   # remove paycvv after initial transaction
3513   ###
3514
3515   #false laziness w/misc/process/payment.cgi - check both to make sure working
3516   # correctly
3517   if ( defined $self->dbdef_table->column('paycvv')
3518        && length($self->paycvv)
3519        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
3520   ) {
3521     my $error = $self->remove_cvv;
3522     if ( $error ) {
3523       warn "WARNING: error removing cvv: $error\n";
3524     }
3525   }
3526
3527   ###
3528   # result handling
3529   ###
3530
3531   if ( $transaction->is_success() ) {
3532
3533     my $paybatch = '';
3534     if ( $payment_gateway ) { # agent override
3535       $paybatch = $payment_gateway->gatewaynum. '-';
3536     }
3537
3538     $paybatch .= "$processor:". $transaction->authorization;
3539
3540     $paybatch .= ':'. $transaction->order_number
3541       if $transaction->can('order_number')
3542       && length($transaction->order_number);
3543
3544     my $cust_pay = new FS::cust_pay ( {
3545        'custnum'  => $self->custnum,
3546        'invnum'   => $options{'invnum'},
3547        'paid'     => $amount,
3548        '_date'    => '',
3549        'payby'    => $method2payby{$method},
3550        'payinfo'  => $payinfo,
3551        'paybatch' => $paybatch,
3552        'paydate'  => $paydate,
3553     } );
3554     #doesn't hurt to know, even though the dup check is in cust_pay_pending now
3555     $cust_pay->payunique( $options{payunique} )
3556       if defined($options{payunique}) && length($options{payunique});
3557
3558     my $oldAutoCommit = $FS::UID::AutoCommit;
3559     local $FS::UID::AutoCommit = 0;
3560     my $dbh = dbh;
3561
3562     #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
3563
3564     my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3565
3566     if ( $error ) {
3567       $cust_pay->invnum(''); #try again with no specific invnum
3568       my $error2 = $cust_pay->insert( $options{'manual'} ?
3569                                       ( 'manual' => 1 ) : ()
3570                                     );
3571       if ( $error2 ) {
3572         # gah.  but at least we have a record of the state we had to abort in
3573         # from cust_pay_pending now.
3574         my $e = "WARNING: $method captured but payment not recorded - ".
3575                 "error inserting payment ($processor): $error2".
3576                 " (previously tried insert with invnum #$options{'invnum'}" .
3577                 ": $error ) - pending payment saved as paypendingnum ".
3578                 $cust_pay_pending->paypendingnum. "\n";
3579         warn $e;
3580         return $e;
3581       }
3582     }
3583
3584     if ( $options{'paynum_ref'} ) {
3585       ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3586     }
3587
3588     $cust_pay_pending->status('done');
3589     $cust_pay_pending->statustext('captured');
3590     my $cpp_done_err = $cust_pay_pending->replace;
3591
3592     if ( $cpp_done_err ) {
3593
3594       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
3595       my $e = "WARNING: $method captured but payment not recorded - ".
3596               "error updating status for paypendingnum ".
3597               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3598       warn $e;
3599       return $e;
3600
3601     } else {
3602
3603       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3604       return ''; #no error
3605
3606     }
3607
3608   } else {
3609
3610     my $perror = "$processor error: ". $transaction->error_message;
3611
3612     unless ( $transaction->error_message ) {
3613
3614       my $t_response;
3615       if ( $transaction->can('response_page') ) {
3616         $t_response = {
3617                         'page'    => ( $transaction->can('response_page')
3618                                          ? $transaction->response_page
3619                                          : ''
3620                                      ),
3621                         'code'    => ( $transaction->can('response_code')
3622                                          ? $transaction->response_code
3623                                          : ''
3624                                      ),
3625                         'headers' => ( $transaction->can('response_headers')
3626                                          ? $transaction->response_headers
3627                                          : ''
3628                                      ),
3629                       };
3630       } else {
3631         $t_response .=
3632           "No additional debugging information available for $processor";
3633       }
3634
3635       $perror .= "No error_message returned from $processor -- ".
3636                  ( ref($t_response) ? Dumper($t_response) : $t_response );
3637
3638     }
3639
3640     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
3641          && $conf->exists('emaildecline')
3642          && grep { $_ ne 'POST' } $self->invoicing_list
3643          && ! grep { $transaction->error_message =~ /$_/ }
3644                    $conf->config('emaildecline-exclude')
3645     ) {
3646       my @templ = $conf->config('declinetemplate');
3647       my $template = new Text::Template (
3648         TYPE   => 'ARRAY',
3649         SOURCE => [ map "$_\n", @templ ],
3650       ) or return "($perror) can't create template: $Text::Template::ERROR";
3651       $template->compile()
3652         or return "($perror) can't compile template: $Text::Template::ERROR";
3653
3654       my $templ_hash = { error => $transaction->error_message };
3655
3656       my $error = send_email(
3657         'from'    => $conf->config('invoice_from'),
3658         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
3659         'subject' => 'Your payment could not be processed',
3660         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
3661       );
3662
3663       $perror .= " (also received error sending decline notification: $error)"
3664         if $error;
3665
3666     }
3667
3668     $cust_pay_pending->status('done');
3669     $cust_pay_pending->statustext("declined: $perror");
3670     my $cpp_done_err = $cust_pay_pending->replace;
3671     if ( $cpp_done_err ) {
3672       my $e = "WARNING: $method declined but pending payment not resolved - ".
3673               "error updating status for paypendingnum ".
3674               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3675       warn $e;
3676       $perror = "$e ($perror)";
3677     }
3678
3679     return $perror;
3680   }
3681
3682 }
3683
3684 =item fake_bop
3685
3686 =cut
3687
3688 sub fake_bop {
3689   my( $self, $method, $amount, %options ) = @_;
3690
3691   if ( $options{'fake_failure'} ) {
3692      return "Error: No error; test failure requested with fake_failure";
3693   }
3694
3695   my %method2payby = (
3696     'CC'     => 'CARD',
3697     'ECHECK' => 'CHEK',
3698     'LEC'    => 'LECB',
3699   );
3700
3701   #my $paybatch = '';
3702   #if ( $payment_gateway ) { # agent override
3703   #  $paybatch = $payment_gateway->gatewaynum. '-';
3704   #}
3705   #
3706   #$paybatch .= "$processor:". $transaction->authorization;
3707   #
3708   #$paybatch .= ':'. $transaction->order_number
3709   #  if $transaction->can('order_number')
3710   #  && length($transaction->order_number);
3711
3712   my $paybatch = 'FakeProcessor:54:32';
3713
3714   my $cust_pay = new FS::cust_pay ( {
3715      'custnum'  => $self->custnum,
3716      'invnum'   => $options{'invnum'},
3717      'paid'     => $amount,
3718      '_date'    => '',
3719      'payby'    => $method2payby{$method},
3720      #'payinfo'  => $payinfo,
3721      'payinfo'  => '4111111111111111',
3722      'paybatch' => $paybatch,
3723      #'paydate'  => $paydate,
3724      'paydate'  => '2012-05-01',
3725   } );
3726   $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
3727
3728   my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3729
3730   if ( $error ) {
3731     $cust_pay->invnum(''); #try again with no specific invnum
3732     my $error2 = $cust_pay->insert( $options{'manual'} ?
3733                                     ( 'manual' => 1 ) : ()
3734                                   );
3735     if ( $error2 ) {
3736       # gah, even with transactions.
3737       my $e = 'WARNING: Card/ACH debited but database not updated - '.
3738               "error inserting (fake!) payment: $error2".
3739               " (previously tried insert with invnum #$options{'invnum'}" .
3740               ": $error )";
3741       warn $e;
3742       return $e;
3743     }
3744   }
3745
3746   if ( $options{'paynum_ref'} ) {
3747     ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3748   }
3749
3750   return ''; #no error
3751
3752 }
3753
3754 =item default_payment_gateway
3755
3756 =cut
3757
3758 sub default_payment_gateway {
3759   my( $self, $method ) = @_;
3760
3761   die "Real-time processing not enabled\n"
3762     unless $conf->exists('business-onlinepayment');
3763
3764   #load up config
3765   my $bop_config = 'business-onlinepayment';
3766   $bop_config .= '-ach'
3767     if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
3768   my ( $processor, $login, $password, $action, @bop_options ) =
3769     $conf->config($bop_config);
3770   $action ||= 'normal authorization';
3771   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
3772   die "No real-time processor is enabled - ".
3773       "did you set the business-onlinepayment configuration value?\n"
3774     unless $processor;
3775
3776   ( $processor, $login, $password, $action, @bop_options )
3777 }
3778
3779 =item remove_cvv
3780
3781 Removes the I<paycvv> field from the database directly.
3782
3783 If there is an error, returns the error, otherwise returns false.
3784
3785 =cut
3786
3787 sub remove_cvv {
3788   my $self = shift;
3789   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
3790     or return dbh->errstr;
3791   $sth->execute($self->custnum)
3792     or return $sth->errstr;
3793   $self->paycvv('');
3794   '';
3795 }
3796
3797 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
3798
3799 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
3800 via a Business::OnlinePayment realtime gateway.  See
3801 L<http://420.am/business-onlinepayment> for supported gateways.
3802
3803 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3804
3805 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
3806
3807 Most gateways require a reference to an original payment transaction to refund,
3808 so you probably need to specify a I<paynum>.
3809
3810 I<amount> defaults to the original amount of the payment if not specified.
3811
3812 I<reason> specifies a reason for the refund.
3813
3814 I<paydate> specifies the expiration date for a credit card overriding the
3815 value from the customer record or the payment record. Specified as yyyy-mm-dd
3816
3817 Implementation note: If I<amount> is unspecified or equal to the amount of the
3818 orignal payment, first an attempt is made to "void" the transaction via
3819 the gateway (to cancel a not-yet settled transaction) and then if that fails,
3820 the normal attempt is made to "refund" ("credit") the transaction via the
3821 gateway is attempted.
3822
3823 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3824 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
3825 #if set, will override the value from the customer record.
3826
3827 #If an I<invnum> is specified, this payment (if successful) is applied to the
3828 #specified invoice.  If you don't specify an I<invnum> you might want to
3829 #call the B<apply_payments> method.
3830
3831 =cut
3832
3833 #some false laziness w/realtime_bop, not enough to make it worth merging
3834 #but some useful small subs should be pulled out
3835 sub realtime_refund_bop {
3836   my( $self, $method, %options ) = @_;
3837   if ( $DEBUG ) {
3838     warn "$me realtime_refund_bop: $method refund\n";
3839     warn "  $_ => $options{$_}\n" foreach keys %options;
3840   }
3841
3842   eval "use Business::OnlinePayment";
3843   die $@ if $@;
3844
3845   ###
3846   # look up the original payment and optionally a gateway for that payment
3847   ###
3848
3849   my $cust_pay = '';
3850   my $amount = $options{'amount'};
3851
3852   my( $processor, $login, $password, @bop_options ) ;
3853   my( $auth, $order_number ) = ( '', '', '' );
3854
3855   if ( $options{'paynum'} ) {
3856
3857     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
3858     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
3859       or return "Unknown paynum $options{'paynum'}";
3860     $amount ||= $cust_pay->paid;
3861
3862     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
3863       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
3864                 $cust_pay->paybatch;
3865     my $gatewaynum = '';
3866     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
3867
3868     if ( $gatewaynum ) { #gateway for the payment to be refunded
3869
3870       my $payment_gateway =
3871         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
3872       die "payment gateway $gatewaynum not found"
3873         unless $payment_gateway;
3874
3875       $processor   = $payment_gateway->gateway_module;
3876       $login       = $payment_gateway->gateway_username;
3877       $password    = $payment_gateway->gateway_password;
3878       @bop_options = $payment_gateway->options;
3879
3880     } else { #try the default gateway
3881
3882       my( $conf_processor, $unused_action );
3883       ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
3884         $self->default_payment_gateway($method);
3885
3886       return "processor of payment $options{'paynum'} $processor does not".
3887              " match default processor $conf_processor"
3888         unless $processor eq $conf_processor;
3889
3890     }
3891
3892
3893   } else { # didn't specify a paynum, so look for agent gateway overrides
3894            # like a normal transaction
3895
3896     my $cardtype;
3897     if ( $method eq 'CC' ) {
3898       $cardtype = cardtype($self->payinfo);
3899     } elsif ( $method eq 'ECHECK' ) {
3900       $cardtype = 'ACH';
3901     } else {
3902       $cardtype = $method;
3903     }
3904     my $override =
3905            qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3906                                                cardtype => $cardtype,
3907                                                taxclass => '',              } )
3908         || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3909                                                cardtype => '',
3910                                                taxclass => '',              } );
3911
3912     if ( $override ) { #use a payment gateway override
3913
3914       my $payment_gateway = $override->payment_gateway;
3915
3916       $processor   = $payment_gateway->gateway_module;
3917       $login       = $payment_gateway->gateway_username;
3918       $password    = $payment_gateway->gateway_password;
3919       #$action      = $payment_gateway->gateway_action;
3920       @bop_options = $payment_gateway->options;
3921
3922     } else { #use the standard settings from the config
3923
3924       my $unused_action;
3925       ( $processor, $login, $password, $unused_action, @bop_options ) =
3926         $self->default_payment_gateway($method);
3927
3928     }
3929
3930   }
3931   return "neither amount nor paynum specified" unless $amount;
3932
3933   my %content = (
3934     'type'           => $method,
3935     'login'          => $login,
3936     'password'       => $password,
3937     'order_number'   => $order_number,
3938     'amount'         => $amount,
3939     'referer'        => 'http://cleanwhisker.420.am/',
3940   );
3941   $content{authorization} = $auth
3942     if length($auth); #echeck/ACH transactions have an order # but no auth
3943                       #(at least with authorize.net)
3944
3945   my $disable_void_after;
3946   if ($conf->exists('disable_void_after')
3947       && $conf->config('disable_void_after') =~ /^(\d+)$/) {
3948     $disable_void_after = $1;
3949   }
3950
3951   #first try void if applicable
3952   if ( $cust_pay && $cust_pay->paid == $amount
3953     && (
3954       ( not defined($disable_void_after) )
3955       || ( time < ($cust_pay->_date + $disable_void_after ) )
3956     )
3957   ) {
3958     warn "  attempting void\n" if $DEBUG > 1;
3959     my $void = new Business::OnlinePayment( $processor, @bop_options );
3960     $void->content( 'action' => 'void', %content );
3961     $void->submit();
3962     if ( $void->is_success ) {
3963       my $error = $cust_pay->void($options{'reason'});
3964       if ( $error ) {
3965         # gah, even with transactions.
3966         my $e = 'WARNING: Card/ACH voided but database not updated - '.
3967                 "error voiding payment: $error";
3968         warn $e;
3969         return $e;
3970       }
3971       warn "  void successful\n" if $DEBUG > 1;
3972       return '';
3973     }
3974   }
3975
3976   warn "  void unsuccessful, trying refund\n"
3977     if $DEBUG > 1;
3978
3979   #massage data
3980   my $address = $self->address1;
3981   $address .= ", ". $self->address2 if $self->address2;
3982
3983   my($payname, $payfirst, $paylast);
3984   if ( $self->payname && $method ne 'ECHECK' ) {
3985     $payname = $self->payname;
3986     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3987       or return "Illegal payname $payname";
3988     ($payfirst, $paylast) = ($1, $2);
3989   } else {
3990     $payfirst = $self->getfield('first');
3991     $paylast = $self->getfield('last');
3992     $payname =  "$payfirst $paylast";
3993   }
3994
3995   my @invoicing_list = $self->invoicing_list_emailonly;
3996   if ( $conf->exists('emailinvoiceautoalways')
3997        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3998        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3999     push @invoicing_list, $self->all_emails;
4000   }
4001
4002   my $email = ($conf->exists('business-onlinepayment-email-override'))
4003               ? $conf->config('business-onlinepayment-email-override')
4004               : $invoicing_list[0];
4005
4006   my $payip = exists($options{'payip'})
4007                 ? $options{'payip'}
4008                 : $self->payip;
4009   $content{customer_ip} = $payip
4010     if length($payip);
4011
4012   my $payinfo = '';
4013   if ( $method eq 'CC' ) {
4014
4015     if ( $cust_pay ) {
4016       $content{card_number} = $payinfo = $cust_pay->payinfo;
4017       (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
4018         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4019         ($content{expiration} = "$2/$1");  # where available
4020     } else {
4021       $content{card_number} = $payinfo = $self->payinfo;
4022       (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4023         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4024       $content{expiration} = "$2/$1";
4025     }
4026
4027   } elsif ( $method eq 'ECHECK' ) {
4028
4029     if ( $cust_pay ) {
4030       $payinfo = $cust_pay->payinfo;
4031     } else {
4032       $payinfo = $self->payinfo;
4033     }
4034     ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4035     $content{bank_name} = $self->payname;
4036     $content{account_type} = 'CHECKING';
4037     $content{account_name} = $payname;
4038     $content{customer_org} = $self->company ? 'B' : 'I';
4039     $content{customer_ssn} = $self->ss;
4040   } elsif ( $method eq 'LEC' ) {
4041     $content{phone} = $payinfo = $self->payinfo;
4042   }
4043
4044   #then try refund
4045   my $refund = new Business::OnlinePayment( $processor, @bop_options );
4046   my %sub_content = $refund->content(
4047     'action'         => 'credit',
4048     'customer_id'    => $self->custnum,
4049     'last_name'      => $paylast,
4050     'first_name'     => $payfirst,
4051     'name'           => $payname,
4052     'address'        => $address,
4053     'city'           => $self->city,
4054     'state'          => $self->state,
4055     'zip'            => $self->zip,
4056     'country'        => $self->country,
4057     'email'          => $email,
4058     'phone'          => $self->daytime || $self->night,
4059     %content, #after
4060   );
4061   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
4062     if $DEBUG > 1;
4063   $refund->submit();
4064
4065   return "$processor error: ". $refund->error_message
4066     unless $refund->is_success();
4067
4068   my %method2payby = (
4069     'CC'     => 'CARD',
4070     'ECHECK' => 'CHEK',
4071     'LEC'    => 'LECB',
4072   );
4073
4074   my $paybatch = "$processor:". $refund->authorization;
4075   $paybatch .= ':'. $refund->order_number
4076     if $refund->can('order_number') && $refund->order_number;
4077
4078   while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4079     my @cust_bill_pay = $cust_pay->cust_bill_pay;
4080     last unless @cust_bill_pay;
4081     my $cust_bill_pay = pop @cust_bill_pay;
4082     my $error = $cust_bill_pay->delete;
4083     last if $error;
4084   }
4085
4086   my $cust_refund = new FS::cust_refund ( {
4087     'custnum'  => $self->custnum,
4088     'paynum'   => $options{'paynum'},
4089     'refund'   => $amount,
4090     '_date'    => '',
4091     'payby'    => $method2payby{$method},
4092     'payinfo'  => $payinfo,
4093     'paybatch' => $paybatch,
4094     'reason'   => $options{'reason'} || 'card or ACH refund',
4095   } );
4096   my $error = $cust_refund->insert;
4097   if ( $error ) {
4098     $cust_refund->paynum(''); #try again with no specific paynum
4099     my $error2 = $cust_refund->insert;
4100     if ( $error2 ) {
4101       # gah, even with transactions.
4102       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4103               "error inserting refund ($processor): $error2".
4104               " (previously tried insert with paynum #$options{'paynum'}" .
4105               ": $error )";
4106       warn $e;
4107       return $e;
4108     }
4109   }
4110
4111   ''; #no error
4112
4113 }
4114
4115 =item batch_card OPTION => VALUE...
4116
4117 Adds a payment for this invoice to the pending credit card batch (see
4118 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
4119 runs the payment using a realtime gateway.
4120
4121 =cut
4122
4123 sub batch_card {
4124   my ($self, %options) = @_;
4125
4126   my $amount;
4127   if (exists($options{amount})) {
4128     $amount = $options{amount};
4129   }else{
4130     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
4131   }
4132   return '' unless $amount > 0;
4133
4134   my $invnum = delete $options{invnum};
4135   my $payby = $options{invnum} || $self->payby;  #dubious
4136
4137   if ($options{'realtime'}) {
4138     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
4139                                 $amount,
4140                                 %options,
4141                               );
4142   }
4143
4144   my $oldAutoCommit = $FS::UID::AutoCommit;
4145   local $FS::UID::AutoCommit = 0;
4146   my $dbh = dbh;
4147
4148   #this needs to handle mysql as well as Pg, like svc_acct.pm
4149   #(make it into a common function if folks need to do batching with mysql)
4150   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
4151     or return "Cannot lock pay_batch: " . $dbh->errstr;
4152
4153   my %pay_batch = (
4154     'status' => 'O',
4155     'payby'  => FS::payby->payby2payment($payby),
4156   );
4157
4158   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
4159
4160   unless ( $pay_batch ) {
4161     $pay_batch = new FS::pay_batch \%pay_batch;
4162     my $error = $pay_batch->insert;
4163     if ( $error ) {
4164       $dbh->rollback if $oldAutoCommit;
4165       die "error creating new batch: $error\n";
4166     }
4167   }
4168
4169   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
4170       'batchnum' => $pay_batch->batchnum,
4171       'custnum'  => $self->custnum,
4172   } );
4173
4174   foreach (qw( address1 address2 city state zip country payby payinfo paydate
4175                payname )) {
4176     $options{$_} = '' unless exists($options{$_});
4177   }
4178
4179   my $cust_pay_batch = new FS::cust_pay_batch ( {
4180     'batchnum' => $pay_batch->batchnum,
4181     'invnum'   => $invnum || 0,                    # is there a better value?
4182                                                    # this field should be
4183                                                    # removed...
4184                                                    # cust_bill_pay_batch now
4185     'custnum'  => $self->custnum,
4186     'last'     => $self->getfield('last'),
4187     'first'    => $self->getfield('first'),
4188     'address1' => $options{address1} || $self->address1,
4189     'address2' => $options{address2} || $self->address2,
4190     'city'     => $options{city}     || $self->city,
4191     'state'    => $options{state}    || $self->state,
4192     'zip'      => $options{zip}      || $self->zip,
4193     'country'  => $options{country}  || $self->country,
4194     'payby'    => $options{payby}    || $self->payby,
4195     'payinfo'  => $options{payinfo}  || $self->payinfo,
4196     'exp'      => $options{paydate}  || $self->paydate,
4197     'payname'  => $options{payname}  || $self->payname,
4198     'amount'   => $amount,                         # consolidating
4199   } );
4200
4201   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
4202     if $old_cust_pay_batch;
4203
4204   my $error;
4205   if ($old_cust_pay_batch) {
4206     $error = $cust_pay_batch->replace($old_cust_pay_batch)
4207   } else {
4208     $error = $cust_pay_batch->insert;
4209   }
4210
4211   if ( $error ) {
4212     $dbh->rollback if $oldAutoCommit;
4213     die $error;
4214   }
4215
4216   my $unapplied = $self->total_credited + $self->total_unapplied_payments + $self->in_transit_payments;
4217   foreach my $cust_bill ($self->open_cust_bill) {
4218     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
4219     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
4220       'invnum' => $cust_bill->invnum,
4221       'paybatchnum' => $cust_pay_batch->paybatchnum,
4222       'amount' => $cust_bill->owed,
4223       '_date' => time,
4224     };
4225     if ($unapplied >= $cust_bill_pay_batch->amount){
4226       $unapplied -= $cust_bill_pay_batch->amount;
4227       next;
4228     }else{
4229       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
4230                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
4231     }
4232     $error = $cust_bill_pay_batch->insert;
4233     if ( $error ) {
4234       $dbh->rollback if $oldAutoCommit;
4235       die $error;
4236     }
4237   }
4238
4239   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4240   '';
4241 }
4242
4243 =item total_owed
4244
4245 Returns the total owed for this customer on all invoices
4246 (see L<FS::cust_bill/owed>).
4247
4248 =cut
4249
4250 sub total_owed {
4251   my $self = shift;
4252   $self->total_owed_date(2145859200); #12/31/2037
4253 }
4254
4255 =item total_owed_date TIME
4256
4257 Returns the total owed for this customer on all invoices with date earlier than
4258 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
4259 see L<Time::Local> and L<Date::Parse> for conversion functions.
4260
4261 =cut
4262
4263 sub total_owed_date {
4264   my $self = shift;
4265   my $time = shift;
4266   my $total_bill = 0;
4267   foreach my $cust_bill (
4268     grep { $_->_date <= $time }
4269       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4270   ) {
4271     $total_bill += $cust_bill->owed;
4272   }
4273   sprintf( "%.2f", $total_bill );
4274 }
4275
4276 =item apply_payments_and_credits
4277
4278 Applies unapplied payments and credits.
4279
4280 In most cases, this new method should be used in place of sequential
4281 apply_payments and apply_credits methods.
4282
4283 If there is an error, returns the error, otherwise returns false.
4284
4285 =cut
4286
4287 sub apply_payments_and_credits {
4288   my $self = shift;
4289
4290   local $SIG{HUP} = 'IGNORE';
4291   local $SIG{INT} = 'IGNORE';
4292   local $SIG{QUIT} = 'IGNORE';
4293   local $SIG{TERM} = 'IGNORE';
4294   local $SIG{TSTP} = 'IGNORE';
4295   local $SIG{PIPE} = 'IGNORE';
4296
4297   my $oldAutoCommit = $FS::UID::AutoCommit;
4298   local $FS::UID::AutoCommit = 0;
4299   my $dbh = dbh;
4300
4301   $self->select_for_update; #mutex
4302
4303   foreach my $cust_bill ( $self->open_cust_bill ) {
4304     my $error = $cust_bill->apply_payments_and_credits;
4305     if ( $error ) {
4306       $dbh->rollback if $oldAutoCommit;
4307       return "Error applying: $error";
4308     }
4309   }
4310
4311   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4312   ''; #no error
4313
4314 }
4315
4316 =item apply_credits OPTION => VALUE ...
4317
4318 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
4319 to outstanding invoice balances in chronological order (or reverse
4320 chronological order if the I<order> option is set to B<newest>) and returns the
4321 value of any remaining unapplied credits available for refund (see
4322 L<FS::cust_refund>).
4323
4324 Dies if there is an error.
4325
4326 =cut
4327
4328 sub apply_credits {
4329   my $self = shift;
4330   my %opt = @_;
4331
4332   local $SIG{HUP} = 'IGNORE';
4333   local $SIG{INT} = 'IGNORE';
4334   local $SIG{QUIT} = 'IGNORE';
4335   local $SIG{TERM} = 'IGNORE';
4336   local $SIG{TSTP} = 'IGNORE';
4337   local $SIG{PIPE} = 'IGNORE';
4338
4339   my $oldAutoCommit = $FS::UID::AutoCommit;
4340   local $FS::UID::AutoCommit = 0;
4341   my $dbh = dbh;
4342
4343   $self->select_for_update; #mutex
4344
4345   unless ( $self->total_credited ) {
4346     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4347     return 0;
4348   }
4349
4350   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
4351       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
4352
4353   my @invoices = $self->open_cust_bill;
4354   @invoices = sort { $b->_date <=> $a->_date } @invoices
4355     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
4356
4357   my $credit;
4358   foreach my $cust_bill ( @invoices ) {
4359     my $amount;
4360
4361     if ( !defined($credit) || $credit->credited == 0) {
4362       $credit = pop @credits or last;
4363     }
4364
4365     if ($cust_bill->owed >= $credit->credited) {
4366       $amount=$credit->credited;
4367     }else{
4368       $amount=$cust_bill->owed;
4369     }
4370
4371     my $cust_credit_bill = new FS::cust_credit_bill ( {
4372       'crednum' => $credit->crednum,
4373       'invnum'  => $cust_bill->invnum,
4374       'amount'  => $amount,
4375     } );
4376     my $error = $cust_credit_bill->insert;
4377     if ( $error ) {
4378       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4379       die $error;
4380     }
4381
4382     redo if ($cust_bill->owed > 0);
4383
4384   }
4385
4386   my $total_credited = $self->total_credited;
4387
4388   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4389
4390   return $total_credited;
4391 }
4392
4393 =item apply_payments
4394
4395 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
4396 to outstanding invoice balances in chronological order.
4397
4398  #and returns the value of any remaining unapplied payments.
4399
4400 Dies if there is an error.
4401
4402 =cut
4403
4404 sub apply_payments {
4405   my $self = shift;
4406
4407   local $SIG{HUP} = 'IGNORE';
4408   local $SIG{INT} = 'IGNORE';
4409   local $SIG{QUIT} = 'IGNORE';
4410   local $SIG{TERM} = 'IGNORE';
4411   local $SIG{TSTP} = 'IGNORE';
4412   local $SIG{PIPE} = 'IGNORE';
4413
4414   my $oldAutoCommit = $FS::UID::AutoCommit;
4415   local $FS::UID::AutoCommit = 0;
4416   my $dbh = dbh;
4417
4418   $self->select_for_update; #mutex
4419
4420   #return 0 unless
4421
4422   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
4423       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
4424
4425   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
4426       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
4427
4428   my $payment;
4429
4430   foreach my $cust_bill ( @invoices ) {
4431     my $amount;
4432
4433     if ( !defined($payment) || $payment->unapplied == 0 ) {
4434       $payment = pop @payments or last;
4435     }
4436
4437     if ( $cust_bill->owed >= $payment->unapplied ) {
4438       $amount = $payment->unapplied;
4439     } else {
4440       $amount = $cust_bill->owed;
4441     }
4442
4443     my $cust_bill_pay = new FS::cust_bill_pay ( {
4444       'paynum' => $payment->paynum,
4445       'invnum' => $cust_bill->invnum,
4446       'amount' => $amount,
4447     } );
4448     my $error = $cust_bill_pay->insert;
4449     if ( $error ) {
4450       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4451       die $error;
4452     }
4453
4454     redo if ( $cust_bill->owed > 0);
4455
4456   }
4457
4458   my $total_unapplied_payments = $self->total_unapplied_payments;
4459
4460   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4461
4462   return $total_unapplied_payments;
4463 }
4464
4465 =item total_credited
4466
4467 Returns the total outstanding credit (see L<FS::cust_credit>) for this
4468 customer.  See L<FS::cust_credit/credited>.
4469
4470 =cut
4471
4472 sub total_credited {
4473   my $self = shift;
4474   my $total_credit = 0;
4475   foreach my $cust_credit ( qsearch('cust_credit', {
4476     'custnum' => $self->custnum,
4477   } ) ) {
4478     $total_credit += $cust_credit->credited;
4479   }
4480   sprintf( "%.2f", $total_credit );
4481 }
4482
4483 =item total_unapplied_payments
4484
4485 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
4486 See L<FS::cust_pay/unapplied>.
4487
4488 =cut
4489
4490 sub total_unapplied_payments {
4491   my $self = shift;
4492   my $total_unapplied = 0;
4493   foreach my $cust_pay ( qsearch('cust_pay', {
4494     'custnum' => $self->custnum,
4495   } ) ) {
4496     $total_unapplied += $cust_pay->unapplied;
4497   }
4498   sprintf( "%.2f", $total_unapplied );
4499 }
4500
4501 =item total_unapplied_refunds
4502
4503 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
4504 customer.  See L<FS::cust_refund/unapplied>.
4505
4506 =cut
4507
4508 sub total_unapplied_refunds {
4509   my $self = shift;
4510   my $total_unapplied = 0;
4511   foreach my $cust_refund ( qsearch('cust_refund', {
4512     'custnum' => $self->custnum,
4513   } ) ) {
4514     $total_unapplied += $cust_refund->unapplied;
4515   }
4516   sprintf( "%.2f", $total_unapplied );
4517 }
4518
4519 =item balance
4520
4521 Returns the balance for this customer (total_owed plus total_unrefunded, minus
4522 total_credited minus total_unapplied_payments).
4523
4524 =cut
4525
4526 sub balance {
4527   my $self = shift;
4528   sprintf( "%.2f",
4529       $self->total_owed
4530     + $self->total_unapplied_refunds
4531     - $self->total_credited
4532     - $self->total_unapplied_payments
4533   );
4534 }
4535
4536 =item balance_date TIME
4537
4538 Returns the balance for this customer, only considering invoices with date
4539 earlier than TIME (total_owed_date minus total_credited minus
4540 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
4541 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
4542 functions.
4543
4544 =cut
4545
4546 sub balance_date {
4547   my $self = shift;
4548   my $time = shift;
4549   sprintf( "%.2f",
4550         $self->total_owed_date($time)
4551       + $self->total_unapplied_refunds
4552       - $self->total_credited
4553       - $self->total_unapplied_payments
4554   );
4555 }
4556
4557 =item in_transit_payments
4558
4559 Returns the total of requests for payments for this customer pending in
4560 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
4561
4562 =cut
4563
4564 sub in_transit_payments {
4565   my $self = shift;
4566   my $in_transit_payments = 0;
4567   foreach my $pay_batch ( qsearch('pay_batch', {
4568     'status' => 'I',
4569   } ) ) {
4570     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
4571       'batchnum' => $pay_batch->batchnum,
4572       'custnum' => $self->custnum,
4573     } ) ) {
4574       $in_transit_payments += $cust_pay_batch->amount;
4575     }
4576   }
4577   sprintf( "%.2f", $in_transit_payments );
4578 }
4579
4580 =item paydate_monthyear
4581
4582 Returns a two-element list consisting of the month and year of this customer's
4583 paydate (credit card expiration date for CARD customers)
4584
4585 =cut
4586
4587 sub paydate_monthyear {
4588   my $self = shift;
4589   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
4590     ( $2, $1 );
4591   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
4592     ( $1, $3 );
4593   } else {
4594     ('', '');
4595   }
4596 }
4597
4598 =item invoicing_list [ ARRAYREF ]
4599
4600 If an arguement is given, sets these email addresses as invoice recipients
4601 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
4602 (except as warnings), so use check_invoicing_list first.
4603
4604 Returns a list of email addresses (with svcnum entries expanded).
4605
4606 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
4607 check it without disturbing anything by passing nothing.
4608
4609 This interface may change in the future.
4610
4611 =cut
4612
4613 sub invoicing_list {
4614   my( $self, $arrayref ) = @_;
4615
4616   if ( $arrayref ) {
4617     my @cust_main_invoice;
4618     if ( $self->custnum ) {
4619       @cust_main_invoice =
4620         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4621     } else {
4622       @cust_main_invoice = ();
4623     }
4624     foreach my $cust_main_invoice ( @cust_main_invoice ) {
4625       #warn $cust_main_invoice->destnum;
4626       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
4627         #warn $cust_main_invoice->destnum;
4628         my $error = $cust_main_invoice->delete;
4629         warn $error if $error;
4630       }
4631     }
4632     if ( $self->custnum ) {
4633       @cust_main_invoice =
4634         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4635     } else {
4636       @cust_main_invoice = ();
4637     }
4638     my %seen = map { $_->address => 1 } @cust_main_invoice;
4639     foreach my $address ( @{$arrayref} ) {
4640       next if exists $seen{$address} && $seen{$address};
4641       $seen{$address} = 1;
4642       my $cust_main_invoice = new FS::cust_main_invoice ( {
4643         'custnum' => $self->custnum,
4644         'dest'    => $address,
4645       } );
4646       my $error = $cust_main_invoice->insert;
4647       warn $error if $error;
4648     }
4649   }
4650
4651   if ( $self->custnum ) {
4652     map { $_->address }
4653       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4654   } else {
4655     ();
4656   }
4657
4658 }
4659
4660 =item check_invoicing_list ARRAYREF
4661
4662 Checks these arguements as valid input for the invoicing_list method.  If there
4663 is an error, returns the error, otherwise returns false.
4664
4665 =cut
4666
4667 sub check_invoicing_list {
4668   my( $self, $arrayref ) = @_;
4669
4670   foreach my $address ( @$arrayref ) {
4671
4672     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
4673       return 'Can\'t add FAX invoice destination with a blank FAX number.';
4674     }
4675
4676     my $cust_main_invoice = new FS::cust_main_invoice ( {
4677       'custnum' => $self->custnum,
4678       'dest'    => $address,
4679     } );
4680     my $error = $self->custnum
4681                 ? $cust_main_invoice->check
4682                 : $cust_main_invoice->checkdest
4683     ;
4684     return $error if $error;
4685
4686   }
4687
4688   return "Email address required"
4689     if $conf->exists('cust_main-require_invoicing_list_email')
4690     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
4691
4692   '';
4693 }
4694
4695 =item set_default_invoicing_list
4696
4697 Sets the invoicing list to all accounts associated with this customer,
4698 overwriting any previous invoicing list.
4699
4700 =cut
4701
4702 sub set_default_invoicing_list {
4703   my $self = shift;
4704   $self->invoicing_list($self->all_emails);
4705 }
4706
4707 =item all_emails
4708
4709 Returns the email addresses of all accounts provisioned for this customer.
4710
4711 =cut
4712
4713 sub all_emails {
4714   my $self = shift;
4715   my %list;
4716   foreach my $cust_pkg ( $self->all_pkgs ) {
4717     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
4718     my @svc_acct =
4719       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
4720         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
4721           @cust_svc;
4722     $list{$_}=1 foreach map { $_->email } @svc_acct;
4723   }
4724   keys %list;
4725 }
4726
4727 =item invoicing_list_addpost
4728
4729 Adds postal invoicing to this customer.  If this customer is already configured
4730 to receive postal invoices, does nothing.
4731
4732 =cut
4733
4734 sub invoicing_list_addpost {
4735   my $self = shift;
4736   return if grep { $_ eq 'POST' } $self->invoicing_list;
4737   my @invoicing_list = $self->invoicing_list;
4738   push @invoicing_list, 'POST';
4739   $self->invoicing_list(\@invoicing_list);
4740 }
4741
4742 =item invoicing_list_emailonly
4743
4744 Returns the list of email invoice recipients (invoicing_list without non-email
4745 destinations such as POST and FAX).
4746
4747 =cut
4748
4749 sub invoicing_list_emailonly {
4750   my $self = shift;
4751   warn "$me invoicing_list_emailonly called"
4752     if $DEBUG;
4753   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
4754 }
4755
4756 =item invoicing_list_emailonly_scalar
4757
4758 Returns the list of email invoice recipients (invoicing_list without non-email
4759 destinations such as POST and FAX) as a comma-separated scalar.
4760
4761 =cut
4762
4763 sub invoicing_list_emailonly_scalar {
4764   my $self = shift;
4765   warn "$me invoicing_list_emailonly_scalar called"
4766     if $DEBUG;
4767   join(', ', $self->invoicing_list_emailonly);
4768 }
4769
4770 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
4771
4772 Returns an array of customers referred by this customer (referral_custnum set
4773 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
4774 customers referred by customers referred by this customer and so on, inclusive.
4775 The default behavior is DEPTH 1 (no recursion).
4776
4777 =cut
4778
4779 sub referral_cust_main {
4780   my $self = shift;
4781   my $depth = @_ ? shift : 1;
4782   my $exclude = @_ ? shift : {};
4783
4784   my @cust_main =
4785     map { $exclude->{$_->custnum}++; $_; }
4786       grep { ! $exclude->{ $_->custnum } }
4787         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
4788
4789   if ( $depth > 1 ) {
4790     push @cust_main,
4791       map { $_->referral_cust_main($depth-1, $exclude) }
4792         @cust_main;
4793   }
4794
4795   @cust_main;
4796 }
4797
4798 =item referral_cust_main_ncancelled
4799
4800 Same as referral_cust_main, except only returns customers with uncancelled
4801 packages.
4802
4803 =cut
4804
4805 sub referral_cust_main_ncancelled {
4806   my $self = shift;
4807   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
4808 }
4809
4810 =item referral_cust_pkg [ DEPTH ]
4811
4812 Like referral_cust_main, except returns a flat list of all unsuspended (and
4813 uncancelled) packages for each customer.  The number of items in this list may
4814 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
4815
4816 =cut
4817
4818 sub referral_cust_pkg {
4819   my $self = shift;
4820   my $depth = @_ ? shift : 1;
4821
4822   map { $_->unsuspended_pkgs }
4823     grep { $_->unsuspended_pkgs }
4824       $self->referral_cust_main($depth);
4825 }
4826
4827 =item referring_cust_main
4828
4829 Returns the single cust_main record for the customer who referred this customer
4830 (referral_custnum), or false.
4831
4832 =cut
4833
4834 sub referring_cust_main {
4835   my $self = shift;
4836   return '' unless $self->referral_custnum;
4837   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
4838 }
4839
4840 =item credit AMOUNT, REASON
4841
4842 Applies a credit to this customer.  If there is an error, returns the error,
4843 otherwise returns false.
4844
4845 =cut
4846
4847 sub credit {
4848   my( $self, $amount, $reason, %options ) = @_;
4849   my $cust_credit = new FS::cust_credit {
4850     'custnum' => $self->custnum,
4851     'amount'  => $amount,
4852     'reason'  => $reason,
4853   };
4854   $cust_credit->insert(%options);
4855 }
4856
4857 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
4858
4859 Creates a one-time charge for this customer.  If there is an error, returns
4860 the error, otherwise returns false.
4861
4862 =cut
4863
4864 sub charge {
4865   my $self = shift;
4866   my ( $amount, $quantity, $pkg, $comment, $taxclass, $additional, $classnum );
4867   my ( $taxproduct, $override );
4868   if ( ref( $_[0] ) ) {
4869     $amount     = $_[0]->{amount};
4870     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
4871     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
4872     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
4873                                            : '$'. sprintf("%.2f",$amount);
4874     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
4875     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
4876     $additional = $_[0]->{additional};
4877     $taxproduct = $_[0]->{taxproductnum};
4878     $override   = { '' => $_[0]->{tax_override} };
4879   }else{
4880     $amount     = shift;
4881     $quantity   = 1;
4882     $pkg        = @_ ? shift : 'One-time charge';
4883     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
4884     $taxclass   = @_ ? shift : '';
4885     $additional = [];
4886   }
4887
4888   local $SIG{HUP} = 'IGNORE';
4889   local $SIG{INT} = 'IGNORE';
4890   local $SIG{QUIT} = 'IGNORE';
4891   local $SIG{TERM} = 'IGNORE';
4892   local $SIG{TSTP} = 'IGNORE';
4893   local $SIG{PIPE} = 'IGNORE';
4894
4895   my $oldAutoCommit = $FS::UID::AutoCommit;
4896   local $FS::UID::AutoCommit = 0;
4897   my $dbh = dbh;
4898
4899   my $part_pkg = new FS::part_pkg ( {
4900     'pkg'           => $pkg,
4901     'comment'       => $comment,
4902     'plan'          => 'flat',
4903     'freq'          => 0,
4904     'disabled'      => 'Y',
4905     'classnum'      => $classnum ? $classnum : '',
4906     'taxclass'      => $taxclass,
4907     'taxproductnum' => $taxproduct,
4908   } );
4909
4910   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
4911                         ( 0 .. @$additional - 1 )
4912                   ),
4913                   'additional_count' => scalar(@$additional),
4914                   'setup_fee' => $amount,
4915                 );
4916
4917   my $error = $part_pkg->insert( options       => \%options,
4918                                  tax_overrides => $override,
4919                                );
4920   if ( $error ) {
4921     $dbh->rollback if $oldAutoCommit;
4922     return $error;
4923   }
4924
4925   my $pkgpart = $part_pkg->pkgpart;
4926   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
4927   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
4928     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
4929     $error = $type_pkgs->insert;
4930     if ( $error ) {
4931       $dbh->rollback if $oldAutoCommit;
4932       return $error;
4933     }
4934   }
4935
4936   my $cust_pkg = new FS::cust_pkg ( {
4937     'custnum'  => $self->custnum,
4938     'pkgpart'  => $pkgpart,
4939     'quantity' => $quantity,
4940   } );
4941
4942   $error = $cust_pkg->insert;
4943   if ( $error ) {
4944     $dbh->rollback if $oldAutoCommit;
4945     return $error;
4946   }
4947
4948   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4949   '';
4950
4951 }
4952
4953 #=item charge_postal_fee
4954 #
4955 #Applies a one time charge this customer.  If there is an error,
4956 #returns the error, returns the cust_pkg charge object or false
4957 #if there was no charge.
4958 #
4959 #=cut
4960 #
4961 # This should be a customer event.  For that to work requires that bill
4962 # also be a customer event.
4963
4964 sub charge_postal_fee {
4965   my $self = shift;
4966
4967   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
4968   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
4969
4970   my $cust_pkg = new FS::cust_pkg ( {
4971     'custnum'  => $self->custnum,
4972     'pkgpart'  => $pkgpart,
4973     'quantity' => 1,
4974   } );
4975
4976   my $error = $cust_pkg->insert;
4977   $error ? $error : $cust_pkg;
4978 }
4979
4980 =item cust_bill
4981
4982 Returns all the invoices (see L<FS::cust_bill>) for this customer.
4983
4984 =cut
4985
4986 sub cust_bill {
4987   my $self = shift;
4988   sort { $a->_date <=> $b->_date }
4989     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4990 }
4991
4992 =item open_cust_bill
4993
4994 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
4995 customer.
4996
4997 =cut
4998
4999 sub open_cust_bill {
5000   my $self = shift;
5001   grep { $_->owed > 0 } $self->cust_bill;
5002 }
5003
5004 =item cust_credit
5005
5006 Returns all the credits (see L<FS::cust_credit>) for this customer.
5007
5008 =cut
5009
5010 sub cust_credit {
5011   my $self = shift;
5012   sort { $a->_date <=> $b->_date }
5013     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
5014 }
5015
5016 =item cust_pay
5017
5018 Returns all the payments (see L<FS::cust_pay>) for this customer.
5019
5020 =cut
5021
5022 sub cust_pay {
5023   my $self = shift;
5024   sort { $a->_date <=> $b->_date }
5025     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
5026 }
5027
5028 =item cust_pay_void
5029
5030 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
5031
5032 =cut
5033
5034 sub cust_pay_void {
5035   my $self = shift;
5036   sort { $a->_date <=> $b->_date }
5037     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
5038 }
5039
5040 =item cust_pay_batch
5041
5042 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
5043
5044 =cut
5045
5046 sub cust_pay_batch {
5047   my $self = shift;
5048   sort { $a->_date <=> $b->_date }
5049     qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
5050 }
5051
5052 =item cust_refund
5053
5054 Returns all the refunds (see L<FS::cust_refund>) for this customer.
5055
5056 =cut
5057
5058 sub cust_refund {
5059   my $self = shift;
5060   sort { $a->_date <=> $b->_date }
5061     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
5062 }
5063
5064 =item name
5065
5066 Returns a name string for this customer, either "Company (Last, First)" or
5067 "Last, First".
5068
5069 =cut
5070
5071 sub name {
5072   my $self = shift;
5073   my $name = $self->contact;
5074   $name = $self->company. " ($name)" if $self->company;
5075   $name;
5076 }
5077
5078 =item ship_name
5079
5080 Returns a name string for this (service/shipping) contact, either
5081 "Company (Last, First)" or "Last, First".
5082
5083 =cut
5084
5085 sub ship_name {
5086   my $self = shift;
5087   if ( $self->get('ship_last') ) {
5088     my $name = $self->ship_contact;
5089     $name = $self->ship_company. " ($name)" if $self->ship_company;
5090     $name;
5091   } else {
5092     $self->name;
5093   }
5094 }
5095
5096 =item contact
5097
5098 Returns this customer's full (billing) contact name only, "Last, First"
5099
5100 =cut
5101
5102 sub contact {
5103   my $self = shift;
5104   $self->get('last'). ', '. $self->first;
5105 }
5106
5107 =item ship_contact
5108
5109 Returns this customer's full (shipping) contact name only, "Last, First"
5110
5111 =cut
5112
5113 sub ship_contact {
5114   my $self = shift;
5115   $self->get('ship_last')
5116     ? $self->get('ship_last'). ', '. $self->ship_first
5117     : $self->contact;
5118 }
5119
5120 =item country_full
5121
5122 Returns this customer's full country name
5123
5124 =cut
5125
5126 sub country_full {
5127   my $self = shift;
5128   code2country($self->country);
5129 }
5130
5131 =item geocode DATA_VENDOR
5132
5133 Returns a value for the customer location as encoded by DATA_VENDOR.
5134 Currently this only makes sense for "CCH" as DATA_VENDOR.
5135
5136 =cut
5137
5138 sub geocode {
5139   my ($self, $data_vendor) = (shift, shift);  #always cch for now
5140
5141   my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
5142                ? 'ship_'
5143                : '';
5144
5145   my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
5146     if $self->country eq 'US';
5147
5148   #CCH specific location stuff
5149   my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
5150
5151   my $geocode = '';
5152   my $cust_tax_location =
5153     qsearchs( {
5154                 'table'     => 'cust_tax_location',
5155                 'hashref'   => { 'zip' => $zip, 'data_vendor' => $data_vendor },
5156                 'extra_sql' => $extra_sql,
5157               }
5158             );
5159   $geocode = $cust_tax_location->geocode
5160     if $cust_tax_location;
5161
5162   $geocode;
5163 }
5164
5165 =item cust_status
5166
5167 =item status
5168
5169 Returns a status string for this customer, currently:
5170
5171 =over 4
5172
5173 =item prospect - No packages have ever been ordered
5174
5175 =item active - One or more recurring packages is active
5176
5177 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
5178
5179 =item suspended - All non-cancelled recurring packages are suspended
5180
5181 =item cancelled - All recurring packages are cancelled
5182
5183 =back
5184
5185 =cut
5186
5187 sub status { shift->cust_status(@_); }
5188
5189 sub cust_status {
5190   my $self = shift;
5191   for my $status (qw( prospect active inactive suspended cancelled )) {
5192     my $method = $status.'_sql';
5193     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
5194     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
5195     $sth->execute( ($self->custnum) x $numnum )
5196       or die "Error executing 'SELECT $sql': ". $sth->errstr;
5197     return $status if $sth->fetchrow_arrayref->[0];
5198   }
5199 }
5200
5201 =item ucfirst_cust_status
5202
5203 =item ucfirst_status
5204
5205 Returns the status with the first character capitalized.
5206
5207 =cut
5208
5209 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
5210
5211 sub ucfirst_cust_status {
5212   my $self = shift;
5213   ucfirst($self->cust_status);
5214 }
5215
5216 =item statuscolor
5217
5218 Returns a hex triplet color string for this customer's status.
5219
5220 =cut
5221
5222 use vars qw(%statuscolor);
5223 tie %statuscolor, 'Tie::IxHash',
5224   'prospect'  => '7e0079', #'000000', #black?  naw, purple
5225   'active'    => '00CC00', #green
5226   'inactive'  => '0000CC', #blue
5227   'suspended' => 'FF9900', #yellow
5228   'cancelled' => 'FF0000', #red
5229 ;
5230
5231 sub statuscolor { shift->cust_statuscolor(@_); }
5232
5233 sub cust_statuscolor {
5234   my $self = shift;
5235   $statuscolor{$self->cust_status};
5236 }
5237
5238 =item tickets
5239
5240 Returns an array of hashes representing the customer's RT tickets.
5241
5242 =cut
5243
5244 sub tickets {
5245   my $self = shift;
5246
5247   my $num = $conf->config('cust_main-max_tickets') || 10;
5248   my @tickets = ();
5249
5250   unless ( $conf->config('ticket_system-custom_priority_field') ) {
5251
5252     @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
5253
5254   } else {
5255
5256     foreach my $priority (
5257       $conf->config('ticket_system-custom_priority_field-values'), ''
5258     ) {
5259       last if scalar(@tickets) >= $num;
5260       push @tickets,
5261         @{ FS::TicketSystem->customer_tickets( $self->custnum,
5262                                                $num - scalar(@tickets),
5263                                                $priority,
5264                                              )
5265          };
5266     }
5267   }
5268   (@tickets);
5269 }
5270
5271 # Return services representing svc_accts in customer support packages
5272 sub support_services {
5273   my $self = shift;
5274   my %packages = map { $_ => 1 } $conf->config('support_packages');
5275
5276   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
5277     grep { $_->part_svc->svcdb eq 'svc_acct' }
5278     map { $_->cust_svc }
5279     grep { exists $packages{ $_->pkgpart } }
5280     $self->ncancelled_pkgs;
5281
5282 }
5283
5284 =back
5285
5286 =head1 CLASS METHODS
5287
5288 =over 4
5289
5290 =item statuses
5291
5292 Class method that returns the list of possible status strings for customers
5293 (see L<the status method|/status>).  For example:
5294
5295   @statuses = FS::cust_main->statuses();
5296
5297 =cut
5298
5299 sub statuses {
5300   #my $self = shift; #could be class...
5301   keys %statuscolor;
5302 }
5303
5304 =item prospect_sql
5305
5306 Returns an SQL expression identifying prospective cust_main records (customers
5307 with no packages ever ordered)
5308
5309 =cut
5310
5311 use vars qw($select_count_pkgs);
5312 $select_count_pkgs =
5313   "SELECT COUNT(*) FROM cust_pkg
5314     WHERE cust_pkg.custnum = cust_main.custnum";
5315
5316 sub select_count_pkgs_sql {
5317   $select_count_pkgs;
5318 }
5319
5320 sub prospect_sql { "
5321   0 = ( $select_count_pkgs )
5322 "; }
5323
5324 =item active_sql
5325
5326 Returns an SQL expression identifying active cust_main records (customers with
5327 active recurring packages).
5328
5329 =cut
5330
5331 sub active_sql { "
5332   0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
5333       )
5334 "; }
5335
5336 =item inactive_sql
5337
5338 Returns an SQL expression identifying inactive cust_main records (customers with
5339 no active recurring packages, but otherwise unsuspended/uncancelled).
5340
5341 =cut
5342
5343 sub inactive_sql { "
5344   0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
5345   AND
5346   0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
5347 "; }
5348
5349 =item susp_sql
5350 =item suspended_sql
5351
5352 Returns an SQL expression identifying suspended cust_main records.
5353
5354 =cut
5355
5356
5357 sub suspended_sql { susp_sql(@_); }
5358 sub susp_sql { "
5359     0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
5360     AND
5361     0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
5362 "; }
5363
5364 =item cancel_sql
5365 =item cancelled_sql
5366
5367 Returns an SQL expression identifying cancelled cust_main records.
5368
5369 =cut
5370
5371 sub cancelled_sql { cancel_sql(@_); }
5372 sub cancel_sql {
5373
5374   my $recurring_sql = FS::cust_pkg->recurring_sql;
5375   my $cancelled_sql = FS::cust_pkg->cancelled_sql;
5376
5377   "
5378         0 < ( $select_count_pkgs )
5379     AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql   )
5380     AND 0 = ( $select_count_pkgs AND $recurring_sql
5381                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
5382             )
5383     AND 0 = (  $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
5384   ";
5385
5386 }
5387
5388 =item uncancel_sql
5389 =item uncancelled_sql
5390
5391 Returns an SQL expression identifying un-cancelled cust_main records.
5392
5393 =cut
5394
5395 sub uncancelled_sql { uncancel_sql(@_); }
5396 sub uncancel_sql { "
5397   ( 0 < ( $select_count_pkgs
5398                    AND ( cust_pkg.cancel IS NULL
5399                          OR cust_pkg.cancel = 0
5400                        )
5401         )
5402     OR 0 = ( $select_count_pkgs )
5403   )
5404 "; }
5405
5406 =item balance_sql
5407
5408 Returns an SQL fragment to retreive the balance.
5409
5410 =cut
5411
5412 sub balance_sql { "
5413     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
5414         WHERE cust_bill.custnum   = cust_main.custnum     )
5415   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
5416         WHERE cust_pay.custnum    = cust_main.custnum     )
5417   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
5418         WHERE cust_credit.custnum = cust_main.custnum     )
5419   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
5420         WHERE cust_refund.custnum = cust_main.custnum     )
5421 "; }
5422
5423 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5424
5425 Returns an SQL fragment to retreive the balance for this customer, only
5426 considering invoices with date earlier than START_TIME, and optionally not
5427 later than END_TIME (total_owed_date minus total_credited minus
5428 total_unapplied_payments).
5429
5430 Times are specified as SQL fragments or numeric
5431 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
5432 L<Date::Parse> for conversion functions.  The empty string can be passed
5433 to disable that time constraint completely.
5434
5435 Available options are:
5436
5437 =over 4
5438
5439 =item unapplied_date
5440
5441 set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering)
5442
5443 =item total
5444
5445 (unused.  obsolete?)
5446 set to true to remove all customer comparison clauses, for totals
5447
5448 =item where
5449
5450 (unused.  obsolete?)
5451 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
5452
5453 =item join
5454
5455 (unused.  obsolete?)
5456 JOIN clause (typically used with the total option)
5457
5458 =back
5459
5460 =cut
5461
5462 sub balance_date_sql {
5463   my( $class, $start, $end, %opt ) = @_;
5464
5465   my $owed         = FS::cust_bill->owed_sql;
5466   my $unapp_refund = FS::cust_refund->unapplied_sql;
5467   my $unapp_credit = FS::cust_credit->unapplied_sql;
5468   my $unapp_pay    = FS::cust_pay->unapplied_sql;
5469
5470   my $j = $opt{'join'} || '';
5471
5472   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
5473   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
5474   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
5475   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
5476
5477   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
5478     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
5479     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
5480     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
5481   ";
5482
5483 }
5484
5485 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5486
5487 Helper method for balance_date_sql; name (and usage) subject to change
5488 (suggestions welcome).
5489
5490 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
5491 cust_refund, cust_credit or cust_pay).
5492
5493 If TABLE is "cust_bill" or the unapplied_date option is true, only
5494 considers records with date earlier than START_TIME, and optionally not
5495 later than END_TIME .
5496
5497 =cut
5498
5499 sub _money_table_where {
5500   my( $class, $table, $start, $end, %opt ) = @_;
5501
5502   my @where = ();
5503   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
5504   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
5505     push @where, "$table._date <= $start" if defined($start) && length($start);
5506     push @where, "$table._date >  $end"   if defined($end)   && length($end);
5507   }
5508   push @where, @{$opt{'where'}} if $opt{'where'};
5509   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5510
5511   $where;
5512
5513 }
5514
5515 =item search_sql HASHREF
5516
5517 (Class method)
5518
5519 Returns a qsearch hash expression to search for parameters specified in HREF.
5520 Valid parameters are
5521
5522 =over 4
5523
5524 =item agentnum
5525
5526 =item status
5527
5528 =item cancelled_pkgs
5529
5530 bool
5531
5532 =item signupdate
5533
5534 listref of start date, end date
5535
5536 =item payby
5537
5538 listref
5539
5540 =item current_balance
5541
5542 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
5543
5544 =item cust_fields
5545
5546 =item flattened_pkgs
5547
5548 bool
5549
5550 =back
5551
5552 =cut
5553
5554 sub search_sql {
5555   my ($class, $params) = @_;
5556
5557   my $dbh = dbh;
5558
5559   my @where = ();
5560   my $orderby;
5561
5562   ##
5563   # parse agent
5564   ##
5565
5566   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
5567     push @where,
5568       "cust_main.agentnum = $1";
5569   }
5570
5571   ##
5572   # parse status
5573   ##
5574
5575   #prospect active inactive suspended cancelled
5576   if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
5577     my $method = $params->{'status'}. '_sql';
5578     #push @where, $class->$method();
5579     push @where, FS::cust_main->$method();
5580   }
5581
5582   ##
5583   # parse cancelled package checkbox
5584   ##
5585
5586   my $pkgwhere = "";
5587
5588   $pkgwhere .= "AND (cancel = 0 or cancel is null)"
5589     unless $params->{'cancelled_pkgs'};
5590
5591   ##
5592   # dates
5593   ##
5594
5595   foreach my $field (qw( signupdate )) {
5596
5597     next unless exists($params->{$field});
5598
5599     my($beginning, $ending) = @{$params->{$field}};
5600
5601     push @where,
5602       "cust_main.$field IS NOT NULL",
5603       "cust_main.$field >= $beginning",
5604       "cust_main.$field <= $ending";
5605
5606     $orderby ||= "ORDER BY cust_main.$field";
5607
5608   }
5609
5610   ###
5611   # payby
5612   ###
5613
5614   my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
5615   if ( @payby ) {
5616     push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
5617   }
5618
5619   ##
5620   # amounts
5621   ##
5622
5623   #my $balance_sql = $class->balance_sql();
5624   my $balance_sql = FS::cust_main->balance_sql();
5625
5626   push @where, map { s/current_balance/$balance_sql/; $_ }
5627                    @{ $params->{'current_balance'} };
5628
5629   ##
5630   # custbatch
5631   ##
5632
5633   if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
5634     push @where,
5635       "cust_main.custbatch = '$1'";
5636   }
5637
5638   ##
5639   # setup queries, subs, etc. for the search
5640   ##
5641
5642   $orderby ||= 'ORDER BY custnum';
5643
5644   # here is the agent virtualization
5645   push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
5646
5647   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
5648
5649   my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum  ) ';
5650
5651   my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
5652
5653   my $select = join(', ',
5654                  'cust_main.custnum',
5655                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
5656                );
5657
5658   my(@extra_headers) = ();
5659   my(@extra_fields)  = ();
5660
5661   if ($params->{'flattened_pkgs'}) {
5662
5663     if ($dbh->{Driver}->{Name} eq 'Pg') {
5664
5665       $select .= ", array_to_string(array(select pkg from cust_pkg left join part_pkg using ( pkgpart ) where cust_main.custnum = cust_pkg.custnum $pkgwhere),'|') as magic";
5666
5667     }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
5668       $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
5669       $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
5670     }else{
5671       warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
5672            "omitting packing information from report.";
5673     }
5674
5675     my $header_query = "SELECT COUNT(cust_pkg.custnum = cust_main.custnum) AS count FROM cust_main $addl_from $extra_sql $pkgwhere group by cust_main.custnum order by count desc limit 1";
5676
5677     my $sth = dbh->prepare($header_query) or die dbh->errstr;
5678     $sth->execute() or die $sth->errstr;
5679     my $headerrow = $sth->fetchrow_arrayref;
5680     my $headercount = $headerrow ? $headerrow->[0] : 0;
5681     while($headercount) {
5682       unshift @extra_headers, "Package ". $headercount;
5683       unshift @extra_fields, eval q!sub {my $c = shift;
5684                                          my @a = split '\|', $c->magic;
5685                                          my $p = $a[!.--$headercount. q!];
5686                                          $p;
5687                                         };!;
5688     }
5689
5690   }
5691
5692   my $sql_query = {
5693     'table'         => 'cust_main',
5694     'select'        => $select,
5695     'hashref'       => {},
5696     'extra_sql'     => $extra_sql,
5697     'order_by'      => $orderby,
5698     'count_query'   => $count_query,
5699     'extra_headers' => \@extra_headers,
5700     'extra_fields'  => \@extra_fields,
5701   };
5702
5703 }
5704
5705 =item email_search_sql HASHREF
5706
5707 (Class method)
5708
5709 Emails a notice to the specified customers.
5710
5711 Valid parameters are those of the L<search_sql> method, plus the following:
5712
5713 =over 4
5714
5715 =item from
5716
5717 From: address
5718
5719 =item subject
5720
5721 Email Subject:
5722
5723 =item html_body
5724
5725 HTML body
5726
5727 =item text_body
5728
5729 Text body
5730
5731 =item job
5732
5733 Optional job queue job for status updates.
5734
5735 =back
5736
5737 Returns an error message, or false for success.
5738
5739 If an error occurs during any email, stops the enture send and returns that
5740 error.  Presumably if you're getting SMTP errors aborting is better than
5741 retrying everything.
5742
5743 =cut
5744
5745 sub email_search_sql {
5746   my($class, $params) = @_;
5747
5748   my $from = delete $params->{from};
5749   my $subject = delete $params->{subject};
5750   my $html_body = delete $params->{html_body};
5751   my $text_body = delete $params->{text_body};
5752
5753   my $job = delete $params->{'job'};
5754
5755   my $sql_query = $class->search_sql($params);
5756
5757   my $count_query   = delete($sql_query->{'count_query'});
5758   my $count_sth = dbh->prepare($count_query)
5759     or die "Error preparing $count_query: ". dbh->errstr;
5760   $count_sth->execute
5761     or die "Error executing $count_query: ". $count_sth->errstr;
5762   my $count_arrayref = $count_sth->fetchrow_arrayref;
5763   my $num_cust = $count_arrayref->[0];
5764
5765   #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
5766   #my @extra_fields  = @{ delete($sql_query->{'extra_fields'})  };
5767
5768
5769   my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
5770
5771   #eventually order+limit magic to reduce memory use?
5772   foreach my $cust_main ( qsearch($sql_query) ) {
5773
5774     my $to = $cust_main->invoicing_list_emailonly_scalar;
5775     next unless $to;
5776
5777     my $error = send_email(
5778       generate_email(
5779         'from'      => $from,
5780         'to'        => $to,
5781         'subject'   => $subject,
5782         'html_body' => $html_body,
5783         'text_body' => $text_body,
5784       )
5785     );
5786     return $error if $error;
5787
5788     if ( $job ) { #progressbar foo
5789       $num++;
5790       if ( time - $min_sec > $last ) {
5791         my $error = $job->update_statustext(
5792           int( 100 * $num / $num_cust )
5793         );
5794         die $error if $error;
5795         $last = time;
5796       }
5797     }
5798
5799   }
5800
5801   return '';
5802 }
5803
5804 use Storable qw(thaw);
5805 use Data::Dumper;
5806 use MIME::Base64;
5807 sub process_email_search_sql {
5808   my $job = shift;
5809   #warn "$me process_re_X $method for job $job\n" if $DEBUG;
5810
5811   my $param = thaw(decode_base64(shift));
5812   warn Dumper($param) if $DEBUG;
5813
5814   $param->{'job'} = $job;
5815
5816   my $error = FS::cust_main->email_search_sql( $param );
5817   die $error if $error;
5818
5819 }
5820
5821 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
5822
5823 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
5824 records.  Currently, I<first>, I<last> and/or I<company> may be specified (the
5825 appropriate ship_ field is also searched).
5826
5827 Additional options are the same as FS::Record::qsearch
5828
5829 =cut
5830
5831 sub fuzzy_search {
5832   my( $self, $fuzzy, $hash, @opt) = @_;
5833   #$self
5834   $hash ||= {};
5835   my @cust_main = ();
5836
5837   check_and_rebuild_fuzzyfiles();
5838   foreach my $field ( keys %$fuzzy ) {
5839
5840     my $all = $self->all_X($field);
5841     next unless scalar(@$all);
5842
5843     my %match = ();
5844     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
5845
5846     my @fcust = ();
5847     foreach ( keys %match ) {
5848       push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
5849       push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
5850     }
5851     my %fsaw = ();
5852     push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
5853   }
5854
5855   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
5856   my %saw = ();
5857   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
5858
5859   @cust_main;
5860
5861 }
5862
5863 =item masked FIELD
5864
5865 Returns a masked version of the named field
5866
5867 =cut
5868
5869 sub masked {
5870 my ($self,$field) = @_;
5871
5872 # Show last four
5873
5874 'x'x(length($self->getfield($field))-4).
5875   substr($self->getfield($field), (length($self->getfield($field))-4));
5876
5877 }
5878
5879 =back
5880
5881 =head1 SUBROUTINES
5882
5883 =over 4
5884
5885 =item smart_search OPTION => VALUE ...
5886
5887 Accepts the following options: I<search>, the string to search for.  The string
5888 will be searched for as a customer number, phone number, name or company name,
5889 as an exact, or, in some cases, a substring or fuzzy match (see the source code
5890 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
5891 skip fuzzy matching when an exact match is found.
5892
5893 Any additional options are treated as an additional qualifier on the search
5894 (i.e. I<agentnum>).
5895
5896 Returns a (possibly empty) array of FS::cust_main objects.
5897
5898 =cut
5899
5900 sub smart_search {
5901   my %options = @_;
5902
5903   #here is the agent virtualization
5904   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
5905
5906   my @cust_main = ();
5907
5908   my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
5909   my $search = delete $options{'search'};
5910   ( my $alphanum_search = $search ) =~ s/\W//g;
5911
5912   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
5913
5914     #false laziness w/Record::ut_phone
5915     my $phonen = "$1-$2-$3";
5916     $phonen .= " x$4" if $4;
5917
5918     push @cust_main, qsearch( {
5919       'table'   => 'cust_main',
5920       'hashref' => { %options },
5921       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
5922                      ' ( '.
5923                          join(' OR ', map "$_ = '$phonen'",
5924                                           qw( daytime night fax
5925                                               ship_daytime ship_night ship_fax )
5926                              ).
5927                      ' ) '.
5928                      " AND $agentnums_sql", #agent virtualization
5929     } );
5930
5931     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
5932       #try looking for matches with extensions unless one was specified
5933
5934       push @cust_main, qsearch( {
5935         'table'   => 'cust_main',
5936         'hashref' => { %options },
5937         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
5938                        ' ( '.
5939                            join(' OR ', map "$_ LIKE '$phonen\%'",
5940                                             qw( daytime night
5941                                                 ship_daytime ship_night )
5942                                ).
5943                        ' ) '.
5944                        " AND $agentnums_sql", #agent virtualization
5945       } );
5946
5947     }
5948
5949   # custnum search (also try agent_custid), with some tweaking options if your
5950   # legacy cust "numbers" have letters
5951   } elsif ( $search =~ /^\s*(\d+)\s*$/
5952             || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
5953                  && $search =~ /^\s*(\w\w?\d+)\s*$/
5954                )
5955           )
5956   {
5957
5958     push @cust_main, qsearch( {
5959       'table'     => 'cust_main',
5960       'hashref'   => { 'custnum' => $1, %options },
5961       'extra_sql' => " AND $agentnums_sql", #agent virtualization
5962     } );
5963
5964     push @cust_main, qsearch( {
5965       'table'     => 'cust_main',
5966       'hashref'   => { 'agent_custid' => $1, %options },
5967       'extra_sql' => " AND $agentnums_sql", #agent virtualization
5968     } );
5969
5970   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
5971
5972     my($company, $last, $first) = ( $1, $2, $3 );
5973
5974     # "Company (Last, First)"
5975     #this is probably something a browser remembered,
5976     #so just do an exact search
5977
5978     foreach my $prefix ( '', 'ship_' ) {
5979       push @cust_main, qsearch( {
5980         'table'     => 'cust_main',
5981         'hashref'   => { $prefix.'first'   => $first,
5982                          $prefix.'last'    => $last,
5983                          $prefix.'company' => $company,
5984                          %options,
5985                        },
5986         'extra_sql' => " AND $agentnums_sql",
5987       } );
5988     }
5989
5990   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
5991                                               # try (ship_){last,company}
5992
5993     my $value = lc($1);
5994
5995     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
5996     # # full strings the browser remembers won't work
5997     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
5998
5999     use Lingua::EN::NameParse;
6000     my $NameParse = new Lingua::EN::NameParse(
6001              auto_clean     => 1,
6002              allow_reversed => 1,
6003     );
6004
6005     my($last, $first) = ( '', '' );
6006     #maybe disable this too and just rely on NameParse?
6007     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
6008
6009       ($last, $first) = ( $1, $2 );
6010
6011     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
6012     } elsif ( ! $NameParse->parse($value) ) {
6013
6014       my %name = $NameParse->components;
6015       $first = $name{'given_name_1'};
6016       $last  = $name{'surname_1'};
6017
6018     }
6019
6020     if ( $first && $last ) {
6021
6022       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
6023
6024       #exact
6025       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
6026       $sql .= "
6027         (     ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
6028            OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
6029         )";
6030
6031       push @cust_main, qsearch( {
6032         'table'     => 'cust_main',
6033         'hashref'   => \%options,
6034         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
6035       } );
6036
6037       # or it just be something that was typed in... (try that in a sec)
6038
6039     }
6040
6041     my $q_value = dbh->quote($value);
6042
6043     #exact
6044     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
6045     $sql .= " (    LOWER(last)         = $q_value
6046                 OR LOWER(company)      = $q_value
6047                 OR LOWER(ship_last)    = $q_value
6048                 OR LOWER(ship_company) = $q_value
6049               )";
6050
6051     push @cust_main, qsearch( {
6052       'table'     => 'cust_main',
6053       'hashref'   => \%options,
6054       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
6055     } );
6056
6057     #no exact match, trying substring/fuzzy
6058     #always do substring & fuzzy (unless they're explicity config'ed off)
6059     #getting complaints searches are not returning enough
6060     unless ( @cust_main  && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
6061
6062       #still some false laziness w/search_sql (was search/cust_main.cgi)
6063
6064       #substring
6065
6066       my @hashrefs = (
6067         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
6068         { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
6069       );
6070
6071       if ( $first && $last ) {
6072
6073         push @hashrefs,
6074           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
6075             'last'         => { op=>'ILIKE', value=>"%$last%" },
6076           },
6077           { 'ship_first'   => { op=>'ILIKE', value=>"%$first%" },
6078             'ship_last'    => { op=>'ILIKE', value=>"%$last%" },
6079           },
6080         ;
6081
6082       } else {
6083
6084         push @hashrefs,
6085           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
6086           { 'ship_last'    => { op=>'ILIKE', value=>"%$value%" }, },
6087         ;
6088       }
6089
6090       foreach my $hashref ( @hashrefs ) {
6091
6092         push @cust_main, qsearch( {
6093           'table'     => 'cust_main',
6094           'hashref'   => { %$hashref,
6095                            %options,
6096                          },
6097           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
6098         } );
6099
6100       }
6101
6102       #fuzzy
6103       my @fuzopts = (
6104         \%options,                #hashref
6105         '',                       #select
6106         " AND $agentnums_sql",    #extra_sql  #agent virtualization
6107       );
6108
6109       if ( $first && $last ) {
6110         push @cust_main, FS::cust_main->fuzzy_search(
6111           { 'last'   => $last,    #fuzzy hashref
6112             'first'  => $first }, #
6113           @fuzopts
6114         );
6115       }
6116       foreach my $field ( 'last', 'company' ) {
6117         push @cust_main,
6118           FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
6119       }
6120
6121     }
6122
6123     #eliminate duplicates
6124     my %saw = ();
6125     @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
6126
6127   }
6128
6129   @cust_main;
6130
6131 }
6132
6133 =item email_search
6134
6135 Accepts the following options: I<email>, the email address to search for.  The
6136 email address will be searched for as an email invoice destination and as an
6137 svc_acct account.
6138
6139 #Any additional options are treated as an additional qualifier on the search
6140 #(i.e. I<agentnum>).
6141
6142 Returns a (possibly empty) array of FS::cust_main objects (but usually just
6143 none or one).
6144
6145 =cut
6146
6147 sub email_search {
6148   my %options = @_;
6149
6150   local($DEBUG) = 1;
6151
6152   my $email = delete $options{'email'};
6153
6154   #we're only being used by RT at the moment... no agent virtualization yet
6155   #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
6156
6157   my @cust_main = ();
6158
6159   if ( $email =~ /([^@]+)\@([^@]+)/ ) {
6160
6161     my ( $user, $domain ) = ( $1, $2 );
6162
6163     warn "$me smart_search: searching for $user in domain $domain"
6164       if $DEBUG;
6165
6166     push @cust_main,
6167       map $_->cust_main,
6168           qsearch( {
6169                      'table'     => 'cust_main_invoice',
6170                      'hashref'   => { 'dest' => $email },
6171                    }
6172                  );
6173
6174     push @cust_main,
6175       map  $_->cust_main,
6176       grep $_,
6177       map  $_->cust_svc->cust_pkg,
6178           qsearch( {
6179                      'table'     => 'svc_acct',
6180                      'hashref'   => { 'username' => $user, },
6181                      'extra_sql' =>
6182                        'AND ( SELECT domain FROM svc_domain
6183                                 WHERE svc_acct.domsvc = svc_domain.svcnum
6184                             ) = '. dbh->quote($domain),
6185                    }
6186                  );
6187   }
6188
6189   my %saw = ();
6190   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
6191
6192   warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
6193     if $DEBUG;
6194
6195   @cust_main;
6196
6197 }
6198
6199 =item check_and_rebuild_fuzzyfiles
6200
6201 =cut
6202
6203 use vars qw(@fuzzyfields);
6204 @fuzzyfields = ( 'last', 'first', 'company' );
6205
6206 sub check_and_rebuild_fuzzyfiles {
6207   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6208   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
6209 }
6210
6211 =item rebuild_fuzzyfiles
6212
6213 =cut
6214
6215 sub rebuild_fuzzyfiles {
6216
6217   use Fcntl qw(:flock);
6218
6219   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6220   mkdir $dir, 0700 unless -d $dir;
6221
6222   foreach my $fuzzy ( @fuzzyfields ) {
6223
6224     open(LOCK,">>$dir/cust_main.$fuzzy")
6225       or die "can't open $dir/cust_main.$fuzzy: $!";
6226     flock(LOCK,LOCK_EX)
6227       or die "can't lock $dir/cust_main.$fuzzy: $!";
6228
6229     open (CACHE,">$dir/cust_main.$fuzzy.tmp")
6230       or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
6231
6232     foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
6233       my $sth = dbh->prepare("SELECT $field FROM cust_main".
6234                              " WHERE $field != '' AND $field IS NOT NULL");
6235       $sth->execute or die $sth->errstr;
6236
6237       while ( my $row = $sth->fetchrow_arrayref ) {
6238         print CACHE $row->[0]. "\n";
6239       }
6240
6241     }
6242
6243     close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
6244
6245     rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
6246     close LOCK;
6247   }
6248
6249 }
6250
6251 =item all_X
6252
6253 =cut
6254
6255 sub all_X {
6256   my( $self, $field ) = @_;
6257   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6258   open(CACHE,"<$dir/cust_main.$field")
6259     or die "can't open $dir/cust_main.$field: $!";
6260   my @array = map { chomp; $_; } <CACHE>;
6261   close CACHE;
6262   \@array;
6263 }
6264
6265 =item append_fuzzyfiles LASTNAME COMPANY
6266
6267 =cut
6268
6269 sub append_fuzzyfiles {
6270   #my( $first, $last, $company ) = @_;
6271
6272   &check_and_rebuild_fuzzyfiles;
6273
6274   use Fcntl qw(:flock);
6275
6276   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6277
6278   foreach my $field (qw( first last company )) {
6279     my $value = shift;
6280
6281     if ( $value ) {
6282
6283       open(CACHE,">>$dir/cust_main.$field")
6284         or die "can't open $dir/cust_main.$field: $!";
6285       flock(CACHE,LOCK_EX)
6286         or die "can't lock $dir/cust_main.$field: $!";
6287
6288       print CACHE "$value\n";
6289
6290       flock(CACHE,LOCK_UN)
6291         or die "can't unlock $dir/cust_main.$field: $!";
6292       close CACHE;
6293     }
6294
6295   }
6296
6297   1;
6298 }
6299
6300 =item process_batch_import
6301
6302 Load a batch import as a queued JSRPC job
6303
6304 =cut
6305
6306 use Storable qw(thaw);
6307 use Data::Dumper;
6308 use MIME::Base64;
6309 sub process_batch_import {
6310   my $job = shift;
6311
6312   my $param = thaw(decode_base64(shift));
6313   warn Dumper($param) if $DEBUG;
6314
6315   my $files = $param->{'uploaded_files'}
6316     or die "No files provided.\n";
6317
6318   my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files;
6319
6320   my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
6321   my $file = $dir. $files{'file'};
6322
6323   my $type;
6324   if ( $file =~ /\.(\w+)$/i ) {
6325     $type = lc($1);
6326   } else {
6327     #or error out???
6328     warn "can't parse file type from filename $file; defaulting to CSV";
6329     $type = 'csv';
6330   }
6331
6332   my $error =
6333     FS::cust_main::batch_import( {
6334       job       => $job,
6335       file      => $file,
6336       type      => $type,
6337       custbatch => $param->{custbatch},
6338       agentnum  => $param->{'agentnum'},
6339       refnum    => $param->{'refnum'},
6340       pkgpart   => $param->{'pkgpart'},
6341       #'fields'  => [qw( cust_pkg.setup dayphone first last address1 address2
6342       #                 city state zip comments                          )],
6343       'format'  => $param->{'format'},
6344     } );
6345
6346   unlink $file;
6347
6348   die "$error\n" if $error;
6349
6350 }
6351
6352 =item batch_import
6353
6354 =cut
6355
6356 #some false laziness w/cdr.pm now
6357 sub batch_import {
6358   my $param = shift;
6359
6360   my $job       = $param->{job};
6361
6362   my $filename  = $param->{file};
6363   my $type      = $param->{type} || 'csv';
6364
6365   my $custbatch = $param->{custbatch};
6366
6367   my $agentnum  = $param->{agentnum};
6368   my $refnum    = $param->{refnum};
6369   my $pkgpart   = $param->{pkgpart};
6370
6371   my $format    = $param->{'format'};
6372
6373   my @fields;
6374   my $payby;
6375   if ( $format eq 'simple' ) {
6376     @fields = qw( cust_pkg.setup dayphone first last
6377                   address1 address2 city state zip comments );
6378     $payby = 'BILL';
6379   } elsif ( $format eq 'extended' ) {
6380     @fields = qw( agent_custid refnum
6381                   last first address1 address2 city state zip country
6382                   daytime night
6383                   ship_last ship_first ship_address1 ship_address2
6384                   ship_city ship_state ship_zip ship_country
6385                   payinfo paycvv paydate
6386                   invoicing_list
6387                   cust_pkg.pkgpart
6388                   svc_acct.username svc_acct._password
6389                 );
6390     $payby = 'BILL';
6391  } elsif ( $format eq 'extended-plus_company' ) {
6392     @fields = qw( agent_custid refnum
6393                   last first company address1 address2 city state zip country
6394                   daytime night
6395                   ship_last ship_first ship_company ship_address1 ship_address2
6396                   ship_city ship_state ship_zip ship_country
6397                   payinfo paycvv paydate
6398                   invoicing_list
6399                   cust_pkg.pkgpart
6400                   svc_acct.username svc_acct._password
6401                 );
6402     $payby = 'BILL';
6403   } else {
6404     die "unknown format $format";
6405   }
6406
6407   my $count;
6408   my $parser;
6409   my @buffer = ();
6410   if ( $type eq 'csv' ) {
6411
6412     eval "use Text::CSV_XS;";
6413     die $@ if $@;
6414
6415     $parser = new Text::CSV_XS;
6416
6417     @buffer = split(/\r?\n/, slurp($filename) );
6418     $count = scalar(@buffer);
6419
6420   } elsif ( $type eq 'xls' ) {
6421
6422     eval "use Spreadsheet::ParseExcel;";
6423     die $@ if $@;
6424
6425     my $excel = new Spreadsheet::ParseExcel::Workbook->Parse($filename);
6426     $parser = $excel->{Worksheet}[0]; #first sheet
6427
6428     $count = $parser->{MaxRow} || $parser->{MinRow};
6429     $count++;
6430
6431   } else {
6432     die "Unknown file type $type\n";
6433   }
6434
6435   #my $columns;
6436
6437   local $SIG{HUP} = 'IGNORE';
6438   local $SIG{INT} = 'IGNORE';
6439   local $SIG{QUIT} = 'IGNORE';
6440   local $SIG{TERM} = 'IGNORE';
6441   local $SIG{TSTP} = 'IGNORE';
6442   local $SIG{PIPE} = 'IGNORE';
6443
6444   my $oldAutoCommit = $FS::UID::AutoCommit;
6445   local $FS::UID::AutoCommit = 0;
6446   my $dbh = dbh;
6447
6448   my $line;
6449   my $row = 0;
6450   my( $last, $min_sec ) = ( time, 5 ); #progressbar foo
6451   while (1) {
6452
6453     my @columns = ();
6454     if ( $type eq 'csv' ) {
6455
6456       last unless scalar(@buffer);
6457       $line = shift(@buffer);
6458
6459       $parser->parse($line) or do {
6460         $dbh->rollback if $oldAutoCommit;
6461         return "can't parse: ". $parser->error_input();
6462       };
6463       @columns = $parser->fields();
6464
6465     } elsif ( $type eq 'xls' ) {
6466
6467       last if $row > ($parser->{MaxRow} || $parser->{MinRow});
6468
6469       my @row = @{ $parser->{Cells}[$row] };
6470       @columns = map $_->{Val}, @row;
6471
6472       #my $z = 'A';
6473       #warn $z++. ": $_\n" for @columns;
6474
6475     } else {
6476       die "Unknown file type $type\n";
6477     }
6478
6479     #warn join('-',@columns);
6480
6481     my %cust_main = (
6482       custbatch => $custbatch,
6483       agentnum  => $agentnum,
6484       refnum    => $refnum,
6485       country   => $conf->config('countrydefault') || 'US',
6486       payby     => $payby, #default
6487       paydate   => '12/2037', #default
6488     );
6489     my $billtime = time;
6490     my %cust_pkg = ( pkgpart => $pkgpart );
6491     my %svc_acct = ();
6492     foreach my $field ( @fields ) {
6493
6494       if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|adjourn|expire|cancel)$/ ) {
6495
6496         #$cust_pkg{$1} = str2time( shift @$columns );
6497         if ( $1 eq 'pkgpart' ) {
6498           $cust_pkg{$1} = shift @columns;
6499         } elsif ( $1 eq 'setup' ) {
6500           $billtime = str2time(shift @columns);
6501         } else {
6502           $cust_pkg{$1} = str2time( shift @columns );
6503         }
6504
6505       } elsif ( $field =~ /^svc_acct\.(username|_password)$/ ) {
6506
6507         $svc_acct{$1} = shift @columns;
6508
6509       } else {
6510
6511         #refnum interception
6512         if ( $field eq 'refnum' && $columns[0] !~ /^\s*(\d+)\s*$/ ) {
6513
6514           my $referral = $columns[0];
6515           my %hash = ( 'referral' => $referral,
6516                        'agentnum' => $agentnum,
6517                        'disabled' => '',
6518                      );
6519
6520           my $part_referral = qsearchs('part_referral', \%hash )
6521                               || new FS::part_referral \%hash;
6522
6523           unless ( $part_referral->refnum ) {
6524             my $error = $part_referral->insert;
6525             if ( $error ) {
6526               $dbh->rollback if $oldAutoCommit;
6527               return "can't auto-insert advertising source: $referral: $error";
6528             }
6529           }
6530
6531           $columns[0] = $part_referral->refnum;
6532         }
6533
6534         my $value = shift @columns;
6535         $cust_main{$field} = $value if length($value);
6536       }
6537     }
6538
6539     $cust_main{'payby'} = 'CARD'
6540       if defined $cust_main{'payinfo'}
6541       && length  $cust_main{'payinfo'};
6542
6543     my $invoicing_list = $cust_main{'invoicing_list'}
6544                            ? [ delete $cust_main{'invoicing_list'} ]
6545                            : [];
6546
6547     my $cust_main = new FS::cust_main ( \%cust_main );
6548
6549     use Tie::RefHash;
6550     tie my %hash, 'Tie::RefHash'; #this part is important
6551
6552     if ( $cust_pkg{'pkgpart'} ) {
6553       my $cust_pkg = new FS::cust_pkg ( \%cust_pkg );
6554
6555       my @svc_acct = ();
6556       if ( $svc_acct{'username'} ) {
6557         my $part_pkg = $cust_pkg->part_pkg;
6558         unless ( $part_pkg ) {
6559           $dbh->rollback if $oldAutoCommit;
6560           return "unknown pkgpart: ". $cust_pkg{'pkgpart'};
6561         }
6562         $svc_acct{svcpart} = $part_pkg->svcpart( 'svc_acct' );
6563         push @svc_acct, new FS::svc_acct ( \%svc_acct )
6564       }
6565
6566       $hash{$cust_pkg} = \@svc_acct;
6567     }
6568
6569     my $error = $cust_main->insert( \%hash, $invoicing_list );
6570
6571     if ( $error ) {
6572       $dbh->rollback if $oldAutoCommit;
6573       return "can't insert customer". ( $line ? " for $line" : '' ). ": $error";
6574     }
6575
6576     if ( $format eq 'simple' ) {
6577
6578       #false laziness w/bill.cgi
6579       $error = $cust_main->bill( 'time' => $billtime );
6580       if ( $error ) {
6581         $dbh->rollback if $oldAutoCommit;
6582         return "can't bill customer for $line: $error";
6583       }
6584
6585       $error = $cust_main->apply_payments_and_credits;
6586       if ( $error ) {
6587         $dbh->rollback if $oldAutoCommit;
6588         return "can't bill customer for $line: $error";
6589       }
6590
6591       $error = $cust_main->collect();
6592       if ( $error ) {
6593         $dbh->rollback if $oldAutoCommit;
6594         return "can't collect customer for $line: $error";
6595       }
6596
6597     }
6598
6599     $row++;
6600
6601     if ( $job && time - $min_sec > $last ) { #progress bar
6602       $job->update_statustext( int(100 * $row / $count) );
6603       $last = time;
6604     }
6605
6606   }
6607
6608   $dbh->commit or die $dbh->errstr if $oldAutoCommit;;
6609
6610   return "Empty file!" unless $row;
6611
6612   ''; #no error
6613
6614 }
6615
6616 =item batch_charge
6617
6618 =cut
6619
6620 sub batch_charge {
6621   my $param = shift;
6622   #warn join('-',keys %$param);
6623   my $fh = $param->{filehandle};
6624   my @fields = @{$param->{fields}};
6625
6626   eval "use Text::CSV_XS;";
6627   die $@ if $@;
6628
6629   my $csv = new Text::CSV_XS;
6630   #warn $csv;
6631   #warn $fh;
6632
6633   my $imported = 0;
6634   #my $columns;
6635
6636   local $SIG{HUP} = 'IGNORE';
6637   local $SIG{INT} = 'IGNORE';
6638   local $SIG{QUIT} = 'IGNORE';
6639   local $SIG{TERM} = 'IGNORE';
6640   local $SIG{TSTP} = 'IGNORE';
6641   local $SIG{PIPE} = 'IGNORE';
6642
6643   my $oldAutoCommit = $FS::UID::AutoCommit;
6644   local $FS::UID::AutoCommit = 0;
6645   my $dbh = dbh;
6646
6647   #while ( $columns = $csv->getline($fh) ) {
6648   my $line;
6649   while ( defined($line=<$fh>) ) {
6650
6651     $csv->parse($line) or do {
6652       $dbh->rollback if $oldAutoCommit;
6653       return "can't parse: ". $csv->error_input();
6654     };
6655
6656     my @columns = $csv->fields();
6657     #warn join('-',@columns);
6658
6659     my %row = ();
6660     foreach my $field ( @fields ) {
6661       $row{$field} = shift @columns;
6662     }
6663
6664     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
6665     unless ( $cust_main ) {
6666       $dbh->rollback if $oldAutoCommit;
6667       return "unknown custnum $row{'custnum'}";
6668     }
6669
6670     if ( $row{'amount'} > 0 ) {
6671       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
6672       if ( $error ) {
6673         $dbh->rollback if $oldAutoCommit;
6674         return $error;
6675       }
6676       $imported++;
6677     } elsif ( $row{'amount'} < 0 ) {
6678       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
6679                                       $row{'pkg'}                         );
6680       if ( $error ) {
6681         $dbh->rollback if $oldAutoCommit;
6682         return $error;
6683       }
6684       $imported++;
6685     } else {
6686       #hmm?
6687     }
6688
6689   }
6690
6691   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6692
6693   return "Empty file!" unless $imported;
6694
6695   ''; #no error
6696
6697 }
6698
6699 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
6700
6701 Sends a templated email notification to the customer (see L<Text::Template>).
6702
6703 OPTIONS is a hash and may include
6704
6705 I<from> - the email sender (default is invoice_from)
6706
6707 I<to> - comma-separated scalar or arrayref of recipients
6708    (default is invoicing_list)
6709
6710 I<subject> - The subject line of the sent email notification
6711    (default is "Notice from company_name")
6712
6713 I<extra_fields> - a hashref of name/value pairs which will be substituted
6714    into the template
6715
6716 The following variables are vavailable in the template.
6717
6718 I<$first> - the customer first name
6719 I<$last> - the customer last name
6720 I<$company> - the customer company
6721 I<$payby> - a description of the method of payment for the customer
6722             # would be nice to use FS::payby::shortname
6723 I<$payinfo> - the account information used to collect for this customer
6724 I<$expdate> - the expiration of the customer payment in seconds from epoch
6725
6726 =cut
6727
6728 sub notify {
6729   my ($customer, $template, %options) = @_;
6730
6731   return unless $conf->exists($template);
6732
6733   my $from = $conf->config('invoice_from') if $conf->exists('invoice_from');
6734   $from = $options{from} if exists($options{from});
6735
6736   my $to = join(',', $customer->invoicing_list_emailonly);
6737   $to = $options{to} if exists($options{to});
6738
6739   my $subject = "Notice from " . $conf->config('company_name')
6740     if $conf->exists('company_name');
6741   $subject = $options{subject} if exists($options{subject});
6742
6743   my $notify_template = new Text::Template (TYPE => 'ARRAY',
6744                                             SOURCE => [ map "$_\n",
6745                                               $conf->config($template)]
6746                                            )
6747     or die "can't create new Text::Template object: Text::Template::ERROR";
6748   $notify_template->compile()
6749     or die "can't compile template: Text::Template::ERROR";
6750
6751   $FS::notify_template::_template::company_name = $conf->config('company_name');
6752   $FS::notify_template::_template::company_address =
6753     join("\n", $conf->config('company_address') ). "\n";
6754
6755   my $paydate = $customer->paydate || '2037-12-31';
6756   $FS::notify_template::_template::first = $customer->first;
6757   $FS::notify_template::_template::last = $customer->last;
6758   $FS::notify_template::_template::company = $customer->company;
6759   $FS::notify_template::_template::payinfo = $customer->mask_payinfo;
6760   my $payby = $customer->payby;
6761   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6762   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6763
6764   #credit cards expire at the end of the month/year of their exp date
6765   if ($payby eq 'CARD' || $payby eq 'DCRD') {
6766     $FS::notify_template::_template::payby = 'credit card';
6767     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6768     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6769     $expire_time--;
6770   }elsif ($payby eq 'COMP') {
6771     $FS::notify_template::_template::payby = 'complimentary account';
6772   }else{
6773     $FS::notify_template::_template::payby = 'current method';
6774   }
6775   $FS::notify_template::_template::expdate = $expire_time;
6776
6777   for (keys %{$options{extra_fields}}){
6778     no strict "refs";
6779     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
6780   }
6781
6782   send_email(from => $from,
6783              to => $to,
6784              subject => $subject,
6785              body => $notify_template->fill_in( PACKAGE =>
6786                                                 'FS::notify_template::_template'                                              ),
6787             );
6788
6789 }
6790
6791 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
6792
6793 Generates a templated notification to the customer (see L<Text::Template>).
6794
6795 OPTIONS is a hash and may include
6796
6797 I<extra_fields> - a hashref of name/value pairs which will be substituted
6798    into the template.  These values may override values mentioned below
6799    and those from the customer record.
6800
6801 The following variables are available in the template instead of or in addition
6802 to the fields of the customer record.
6803
6804 I<$payby> - a description of the method of payment for the customer
6805             # would be nice to use FS::payby::shortname
6806 I<$payinfo> - the masked account information used to collect for this customer
6807 I<$expdate> - the expiration of the customer payment method in seconds from epoch
6808 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
6809
6810 =cut
6811
6812 sub generate_letter {
6813   my ($self, $template, %options) = @_;
6814
6815   return unless $conf->exists($template);
6816
6817   my $letter_template = new Text::Template
6818                         ( TYPE       => 'ARRAY',
6819                           SOURCE     => [ map "$_\n", $conf->config($template)],
6820                           DELIMITERS => [ '[@--', '--@]' ],
6821                         )
6822     or die "can't create new Text::Template object: Text::Template::ERROR";
6823
6824   $letter_template->compile()
6825     or die "can't compile template: Text::Template::ERROR";
6826
6827   my %letter_data = map { $_ => $self->$_ } $self->fields;
6828   $letter_data{payinfo} = $self->mask_payinfo;
6829
6830   #my $paydate = $self->paydate || '2037-12-31';
6831   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
6832
6833   my $payby = $self->payby;
6834   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6835   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6836
6837   #credit cards expire at the end of the month/year of their exp date
6838   if ($payby eq 'CARD' || $payby eq 'DCRD') {
6839     $letter_data{payby} = 'credit card';
6840     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6841     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6842     $expire_time--;
6843   }elsif ($payby eq 'COMP') {
6844     $letter_data{payby} = 'complimentary account';
6845   }else{
6846     $letter_data{payby} = 'current method';
6847   }
6848   $letter_data{expdate} = $expire_time;
6849
6850   for (keys %{$options{extra_fields}}){
6851     $letter_data{$_} = $options{extra_fields}->{$_};
6852   }
6853
6854   unless(exists($letter_data{returnaddress})){
6855     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
6856                                                   $self->agent_template)
6857                      );
6858     if ( length($retadd) ) {
6859       $letter_data{returnaddress} = $retadd;
6860     } elsif ( grep /\S/, $conf->config('company_address') ) {
6861       $letter_data{returnaddress} =
6862         join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
6863                           $conf->config('company_address')
6864         );
6865     } else {
6866       $letter_data{returnaddress} = '~';
6867     }
6868   }
6869
6870   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
6871
6872   $letter_data{company_name} = $conf->config('company_name');
6873
6874   my $dir = $FS::UID::conf_dir."cache.". $FS::UID::datasrc;
6875   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
6876                            DIR      => $dir,
6877                            SUFFIX   => '.tex',
6878                            UNLINK   => 0,
6879                          ) or die "can't open temp file: $!\n";
6880
6881   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
6882   close $fh;
6883   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
6884   return $1;
6885 }
6886
6887 =item print_ps TEMPLATE
6888
6889 Returns an postscript letter filled in from TEMPLATE, as a scalar.
6890
6891 =cut
6892
6893 sub print_ps {
6894   my $self = shift;
6895   my $file = $self->generate_letter(@_);
6896   FS::Misc::generate_ps($file);
6897 }
6898
6899 =item print TEMPLATE
6900
6901 Prints the filled in template.
6902
6903 TEMPLATE is the name of a L<Text::Template> to fill in and print.
6904
6905 =cut
6906
6907 sub queueable_print {
6908   my %opt = @_;
6909
6910   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
6911     or die "invalid customer number: " . $opt{custvnum};
6912
6913   my $error = $self->print( $opt{template} );
6914   die $error if $error;
6915 }
6916
6917 sub print {
6918   my ($self, $template) = (shift, shift);
6919   do_print [ $self->print_ps($template) ];
6920 }
6921
6922 sub agent_template {
6923   my $self = shift;
6924   $self->_agent_plandata('agent_templatename');
6925 }
6926
6927 sub agent_invoice_from {
6928   my $self = shift;
6929   $self->_agent_plandata('agent_invoice_from');
6930 }
6931
6932 sub _agent_plandata {
6933   my( $self, $option ) = @_;
6934
6935   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
6936   #agent-specific Conf
6937
6938   use FS::part_event::Condition;
6939
6940   my $agentnum = $self->agentnum;
6941
6942   my $regexp = '';
6943   if ( driver_name =~ /^Pg/i ) {
6944     $regexp = '~';
6945   } elsif ( driver_name =~ /^mysql/i ) {
6946     $regexp = 'REGEXP';
6947   } else {
6948     die "don't know how to use regular expressions in ". driver_name. " databases";
6949   }
6950
6951   my $part_event_option =
6952     qsearchs({
6953       'select'    => 'part_event_option.*',
6954       'table'     => 'part_event_option',
6955       'addl_from' => q{
6956         LEFT JOIN part_event USING ( eventpart )
6957         LEFT JOIN part_event_option AS peo_agentnum
6958           ON ( part_event.eventpart = peo_agentnum.eventpart
6959                AND peo_agentnum.optionname = 'agentnum'
6960                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
6961              )
6962         LEFT JOIN part_event_option AS peo_cust_bill_age
6963           ON ( part_event.eventpart = peo_cust_bill_age.eventpart
6964                AND peo_cust_bill_age.optionname = 'cust_bill_age'
6965              )
6966       },
6967       #'hashref'   => { 'optionname' => $option },
6968       #'hashref'   => { 'part_event_option.optionname' => $option },
6969       'extra_sql' =>
6970         " WHERE part_event_option.optionname = ". dbh->quote($option).
6971         " AND action = 'cust_bill_send_agent' ".
6972         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
6973         " AND peo_agentnum.optionname = 'agentnum' ".
6974         " AND agentnum IS NULL OR agentnum = $agentnum ".
6975         " ORDER BY
6976            CASE WHEN peo_cust_bill_age.optionname != 'cust_bill_age'
6977            THEN -1
6978            ELSE ". FS::part_event::Condition->age2seconds_sql('peo_cust_bill_age.optionvalue').
6979         " END
6980           , part_event.weight".
6981         " LIMIT 1"
6982     });
6983
6984   unless ( $part_event_option ) {
6985     return $self->agent->invoice_template || ''
6986       if $option eq 'agent_templatename';
6987     return '';
6988   }
6989
6990   $part_event_option->optionvalue;
6991
6992 }
6993
6994 sub queued_bill {
6995   ## actual sub, not a method, designed to be called from the queue.
6996   ## sets up the customer, and calls the bill_and_collect
6997   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
6998   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
6999       $cust_main->bill_and_collect(
7000         %args,
7001       );
7002 }
7003
7004 =back
7005
7006 =head1 BUGS
7007
7008 The delete method.
7009
7010 The delete method should possibly take an FS::cust_main object reference
7011 instead of a scalar customer number.
7012
7013 Bill and collect options should probably be passed as references instead of a
7014 list.
7015
7016 There should probably be a configuration file with a list of allowed credit
7017 card types.
7018
7019 No multiple currency support (probably a larger project than just this module).
7020
7021 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
7022
7023 Birthdates rely on negative epoch values.
7024
7025 The payby for card/check batches is broken.  With mixed batching, bad
7026 things will happen.
7027
7028 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
7029
7030 =head1 SEE ALSO
7031
7032 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
7033 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
7034 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
7035
7036 =cut
7037
7038 1;
7039