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