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     qsearchs( {
5193                 'table'     => 'cust_tax_location',
5194                 'hashref'   => { 'zip' => $zip, 'data_vendor' => $data_vendor },
5195                 'extra_sql' => $extra_sql,
5196               }
5197             );
5198   $geocode = $cust_tax_location->geocode
5199     if $cust_tax_location;
5200
5201   $geocode;
5202 }
5203
5204 =item cust_status
5205
5206 =item status
5207
5208 Returns a status string for this customer, currently:
5209
5210 =over 4
5211
5212 =item prospect - No packages have ever been ordered
5213
5214 =item active - One or more recurring packages is active
5215
5216 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
5217
5218 =item suspended - All non-cancelled recurring packages are suspended
5219
5220 =item cancelled - All recurring packages are cancelled
5221
5222 =back
5223
5224 =cut
5225
5226 sub status { shift->cust_status(@_); }
5227
5228 sub cust_status {
5229   my $self = shift;
5230   for my $status (qw( prospect active inactive suspended cancelled )) {
5231     my $method = $status.'_sql';
5232     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
5233     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
5234     $sth->execute( ($self->custnum) x $numnum )
5235       or die "Error executing 'SELECT $sql': ". $sth->errstr;
5236     return $status if $sth->fetchrow_arrayref->[0];
5237   }
5238 }
5239
5240 =item ucfirst_cust_status
5241
5242 =item ucfirst_status
5243
5244 Returns the status with the first character capitalized.
5245
5246 =cut
5247
5248 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
5249
5250 sub ucfirst_cust_status {
5251   my $self = shift;
5252   ucfirst($self->cust_status);
5253 }
5254
5255 =item statuscolor
5256
5257 Returns a hex triplet color string for this customer's status.
5258
5259 =cut
5260
5261 use vars qw(%statuscolor);
5262 tie %statuscolor, 'Tie::IxHash',
5263   'prospect'  => '7e0079', #'000000', #black?  naw, purple
5264   'active'    => '00CC00', #green
5265   'inactive'  => '0000CC', #blue
5266   'suspended' => 'FF9900', #yellow
5267   'cancelled' => 'FF0000', #red
5268 ;
5269
5270 sub statuscolor { shift->cust_statuscolor(@_); }
5271
5272 sub cust_statuscolor {
5273   my $self = shift;
5274   $statuscolor{$self->cust_status};
5275 }
5276
5277 =item tickets
5278
5279 Returns an array of hashes representing the customer's RT tickets.
5280
5281 =cut
5282
5283 sub tickets {
5284   my $self = shift;
5285
5286   my $num = $conf->config('cust_main-max_tickets') || 10;
5287   my @tickets = ();
5288
5289   unless ( $conf->config('ticket_system-custom_priority_field') ) {
5290
5291     @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
5292
5293   } else {
5294
5295     foreach my $priority (
5296       $conf->config('ticket_system-custom_priority_field-values'), ''
5297     ) {
5298       last if scalar(@tickets) >= $num;
5299       push @tickets,
5300         @{ FS::TicketSystem->customer_tickets( $self->custnum,
5301                                                $num - scalar(@tickets),
5302                                                $priority,
5303                                              )
5304          };
5305     }
5306   }
5307   (@tickets);
5308 }
5309
5310 # Return services representing svc_accts in customer support packages
5311 sub support_services {
5312   my $self = shift;
5313   my %packages = map { $_ => 1 } $conf->config('support_packages');
5314
5315   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
5316     grep { $_->part_svc->svcdb eq 'svc_acct' }
5317     map { $_->cust_svc }
5318     grep { exists $packages{ $_->pkgpart } }
5319     $self->ncancelled_pkgs;
5320
5321 }
5322
5323 =back
5324
5325 =head1 CLASS METHODS
5326
5327 =over 4
5328
5329 =item statuses
5330
5331 Class method that returns the list of possible status strings for customers
5332 (see L<the status method|/status>).  For example:
5333
5334   @statuses = FS::cust_main->statuses();
5335
5336 =cut
5337
5338 sub statuses {
5339   #my $self = shift; #could be class...
5340   keys %statuscolor;
5341 }
5342
5343 =item prospect_sql
5344
5345 Returns an SQL expression identifying prospective cust_main records (customers
5346 with no packages ever ordered)
5347
5348 =cut
5349
5350 use vars qw($select_count_pkgs);
5351 $select_count_pkgs =
5352   "SELECT COUNT(*) FROM cust_pkg
5353     WHERE cust_pkg.custnum = cust_main.custnum";
5354
5355 sub select_count_pkgs_sql {
5356   $select_count_pkgs;
5357 }
5358
5359 sub prospect_sql { "
5360   0 = ( $select_count_pkgs )
5361 "; }
5362
5363 =item active_sql
5364
5365 Returns an SQL expression identifying active cust_main records (customers with
5366 active recurring packages).
5367
5368 =cut
5369
5370 sub active_sql { "
5371   0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
5372       )
5373 "; }
5374
5375 =item inactive_sql
5376
5377 Returns an SQL expression identifying inactive cust_main records (customers with
5378 no active recurring packages, but otherwise unsuspended/uncancelled).
5379
5380 =cut
5381
5382 sub inactive_sql { "
5383   0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
5384   AND
5385   0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
5386 "; }
5387
5388 =item susp_sql
5389 =item suspended_sql
5390
5391 Returns an SQL expression identifying suspended cust_main records.
5392
5393 =cut
5394
5395
5396 sub suspended_sql { susp_sql(@_); }
5397 sub susp_sql { "
5398     0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
5399     AND
5400     0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
5401 "; }
5402
5403 =item cancel_sql
5404 =item cancelled_sql
5405
5406 Returns an SQL expression identifying cancelled cust_main records.
5407
5408 =cut
5409
5410 sub cancelled_sql { cancel_sql(@_); }
5411 sub cancel_sql {
5412
5413   my $recurring_sql = FS::cust_pkg->recurring_sql;
5414   my $cancelled_sql = FS::cust_pkg->cancelled_sql;
5415
5416   "
5417         0 < ( $select_count_pkgs )
5418     AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql   )
5419     AND 0 = ( $select_count_pkgs AND $recurring_sql
5420                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
5421             )
5422     AND 0 = (  $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
5423   ";
5424
5425 }
5426
5427 =item uncancel_sql
5428 =item uncancelled_sql
5429
5430 Returns an SQL expression identifying un-cancelled cust_main records.
5431
5432 =cut
5433
5434 sub uncancelled_sql { uncancel_sql(@_); }
5435 sub uncancel_sql { "
5436   ( 0 < ( $select_count_pkgs
5437                    AND ( cust_pkg.cancel IS NULL
5438                          OR cust_pkg.cancel = 0
5439                        )
5440         )
5441     OR 0 = ( $select_count_pkgs )
5442   )
5443 "; }
5444
5445 =item balance_sql
5446
5447 Returns an SQL fragment to retreive the balance.
5448
5449 =cut
5450
5451 sub balance_sql { "
5452     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
5453         WHERE cust_bill.custnum   = cust_main.custnum     )
5454   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
5455         WHERE cust_pay.custnum    = cust_main.custnum     )
5456   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
5457         WHERE cust_credit.custnum = cust_main.custnum     )
5458   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
5459         WHERE cust_refund.custnum = cust_main.custnum     )
5460 "; }
5461
5462 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5463
5464 Returns an SQL fragment to retreive the balance for this customer, only
5465 considering invoices with date earlier than START_TIME, and optionally not
5466 later than END_TIME (total_owed_date minus total_credited minus
5467 total_unapplied_payments).
5468
5469 Times are specified as SQL fragments or numeric
5470 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
5471 L<Date::Parse> for conversion functions.  The empty string can be passed
5472 to disable that time constraint completely.
5473
5474 Available options are:
5475
5476 =over 4
5477
5478 =item unapplied_date
5479
5480 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)
5481
5482 =item total
5483
5484 (unused.  obsolete?)
5485 set to true to remove all customer comparison clauses, for totals
5486
5487 =item where
5488
5489 (unused.  obsolete?)
5490 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
5491
5492 =item join
5493
5494 (unused.  obsolete?)
5495 JOIN clause (typically used with the total option)
5496
5497 =back
5498
5499 =cut
5500
5501 sub balance_date_sql {
5502   my( $class, $start, $end, %opt ) = @_;
5503
5504   my $owed         = FS::cust_bill->owed_sql;
5505   my $unapp_refund = FS::cust_refund->unapplied_sql;
5506   my $unapp_credit = FS::cust_credit->unapplied_sql;
5507   my $unapp_pay    = FS::cust_pay->unapplied_sql;
5508
5509   my $j = $opt{'join'} || '';
5510
5511   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
5512   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
5513   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
5514   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
5515
5516   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
5517     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
5518     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
5519     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
5520   ";
5521
5522 }
5523
5524 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5525
5526 Helper method for balance_date_sql; name (and usage) subject to change
5527 (suggestions welcome).
5528
5529 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
5530 cust_refund, cust_credit or cust_pay).
5531
5532 If TABLE is "cust_bill" or the unapplied_date option is true, only
5533 considers records with date earlier than START_TIME, and optionally not
5534 later than END_TIME .
5535
5536 =cut
5537
5538 sub _money_table_where {
5539   my( $class, $table, $start, $end, %opt ) = @_;
5540
5541   my @where = ();
5542   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
5543   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
5544     push @where, "$table._date <= $start" if defined($start) && length($start);
5545     push @where, "$table._date >  $end"   if defined($end)   && length($end);
5546   }
5547   push @where, @{$opt{'where'}} if $opt{'where'};
5548   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5549
5550   $where;
5551
5552 }
5553
5554 =item search_sql HASHREF
5555
5556 (Class method)
5557
5558 Returns a qsearch hash expression to search for parameters specified in HREF.
5559 Valid parameters are
5560
5561 =over 4
5562
5563 =item agentnum
5564
5565 =item status
5566
5567 =item cancelled_pkgs
5568
5569 bool
5570
5571 =item signupdate
5572
5573 listref of start date, end date
5574
5575 =item payby
5576
5577 listref
5578
5579 =item current_balance
5580
5581 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
5582
5583 =item cust_fields
5584
5585 =item flattened_pkgs
5586
5587 bool
5588
5589 =back
5590
5591 =cut
5592
5593 sub search_sql {
5594   my ($class, $params) = @_;
5595
5596   my $dbh = dbh;
5597
5598   my @where = ();
5599   my $orderby;
5600
5601   ##
5602   # parse agent
5603   ##
5604
5605   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
5606     push @where,
5607       "cust_main.agentnum = $1";
5608   }
5609
5610   ##
5611   # parse status
5612   ##
5613
5614   #prospect active inactive suspended cancelled
5615   if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
5616     my $method = $params->{'status'}. '_sql';
5617     #push @where, $class->$method();
5618     push @where, FS::cust_main->$method();
5619   }
5620
5621   ##
5622   # parse cancelled package checkbox
5623   ##
5624
5625   my $pkgwhere = "";
5626
5627   $pkgwhere .= "AND (cancel = 0 or cancel is null)"
5628     unless $params->{'cancelled_pkgs'};
5629
5630   ##
5631   # dates
5632   ##
5633
5634   foreach my $field (qw( signupdate )) {
5635
5636     next unless exists($params->{$field});
5637
5638     my($beginning, $ending) = @{$params->{$field}};
5639
5640     push @where,
5641       "cust_main.$field IS NOT NULL",
5642       "cust_main.$field >= $beginning",
5643       "cust_main.$field <= $ending";
5644
5645     $orderby ||= "ORDER BY cust_main.$field";
5646
5647   }
5648
5649   ###
5650   # payby
5651   ###
5652
5653   my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
5654   if ( @payby ) {
5655     push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
5656   }
5657
5658   ##
5659   # amounts
5660   ##
5661
5662   #my $balance_sql = $class->balance_sql();
5663   my $balance_sql = FS::cust_main->balance_sql();
5664
5665   push @where, map { s/current_balance/$balance_sql/; $_ }
5666                    @{ $params->{'current_balance'} };
5667
5668   ##
5669   # custbatch
5670   ##
5671
5672   if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
5673     push @where,
5674       "cust_main.custbatch = '$1'";
5675   }
5676
5677   ##
5678   # setup queries, subs, etc. for the search
5679   ##
5680
5681   $orderby ||= 'ORDER BY custnum';
5682
5683   # here is the agent virtualization
5684   push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
5685
5686   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
5687
5688   my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum  ) ';
5689
5690   my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
5691
5692   my $select = join(', ',
5693                  'cust_main.custnum',
5694                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
5695                );
5696
5697   my(@extra_headers) = ();
5698   my(@extra_fields)  = ();
5699
5700   if ($params->{'flattened_pkgs'}) {
5701
5702     if ($dbh->{Driver}->{Name} eq 'Pg') {
5703
5704       $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";
5705
5706     }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
5707       $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
5708       $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
5709     }else{
5710       warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
5711            "omitting packing information from report.";
5712     }
5713
5714     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";
5715
5716     my $sth = dbh->prepare($header_query) or die dbh->errstr;
5717     $sth->execute() or die $sth->errstr;
5718     my $headerrow = $sth->fetchrow_arrayref;
5719     my $headercount = $headerrow ? $headerrow->[0] : 0;
5720     while($headercount) {
5721       unshift @extra_headers, "Package ". $headercount;
5722       unshift @extra_fields, eval q!sub {my $c = shift;
5723                                          my @a = split '\|', $c->magic;
5724                                          my $p = $a[!.--$headercount. q!];
5725                                          $p;
5726                                         };!;
5727     }
5728
5729   }
5730
5731   my $sql_query = {
5732     'table'         => 'cust_main',
5733     'select'        => $select,
5734     'hashref'       => {},
5735     'extra_sql'     => $extra_sql,
5736     'order_by'      => $orderby,
5737     'count_query'   => $count_query,
5738     'extra_headers' => \@extra_headers,
5739     'extra_fields'  => \@extra_fields,
5740   };
5741
5742 }
5743
5744 =item email_search_sql HASHREF
5745
5746 (Class method)
5747
5748 Emails a notice to the specified customers.
5749
5750 Valid parameters are those of the L<search_sql> method, plus the following:
5751
5752 =over 4
5753
5754 =item from
5755
5756 From: address
5757
5758 =item subject
5759
5760 Email Subject:
5761
5762 =item html_body
5763
5764 HTML body
5765
5766 =item text_body
5767
5768 Text body
5769
5770 =item job
5771
5772 Optional job queue job for status updates.
5773
5774 =back
5775
5776 Returns an error message, or false for success.
5777
5778 If an error occurs during any email, stops the enture send and returns that
5779 error.  Presumably if you're getting SMTP errors aborting is better than
5780 retrying everything.
5781
5782 =cut
5783
5784 sub email_search_sql {
5785   my($class, $params) = @_;
5786
5787   my $from = delete $params->{from};
5788   my $subject = delete $params->{subject};
5789   my $html_body = delete $params->{html_body};
5790   my $text_body = delete $params->{text_body};
5791
5792   my $job = delete $params->{'job'};
5793
5794   my $sql_query = $class->search_sql($params);
5795
5796   my $count_query   = delete($sql_query->{'count_query'});
5797   my $count_sth = dbh->prepare($count_query)
5798     or die "Error preparing $count_query: ". dbh->errstr;
5799   $count_sth->execute
5800     or die "Error executing $count_query: ". $count_sth->errstr;
5801   my $count_arrayref = $count_sth->fetchrow_arrayref;
5802   my $num_cust = $count_arrayref->[0];
5803
5804   #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
5805   #my @extra_fields  = @{ delete($sql_query->{'extra_fields'})  };
5806
5807
5808   my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
5809
5810   #eventually order+limit magic to reduce memory use?
5811   foreach my $cust_main ( qsearch($sql_query) ) {
5812
5813     my $to = $cust_main->invoicing_list_emailonly_scalar;
5814     next unless $to;
5815
5816     my $error = send_email(
5817       generate_email(
5818         'from'      => $from,
5819         'to'        => $to,
5820         'subject'   => $subject,
5821         'html_body' => $html_body,
5822         'text_body' => $text_body,
5823       )
5824     );
5825     return $error if $error;
5826
5827     if ( $job ) { #progressbar foo
5828       $num++;
5829       if ( time - $min_sec > $last ) {
5830         my $error = $job->update_statustext(
5831           int( 100 * $num / $num_cust )
5832         );
5833         die $error if $error;
5834         $last = time;
5835       }
5836     }
5837
5838   }
5839
5840   return '';
5841 }
5842
5843 use Storable qw(thaw);
5844 use Data::Dumper;
5845 use MIME::Base64;
5846 sub process_email_search_sql {
5847   my $job = shift;
5848   #warn "$me process_re_X $method for job $job\n" if $DEBUG;
5849
5850   my $param = thaw(decode_base64(shift));
5851   warn Dumper($param) if $DEBUG;
5852
5853   $param->{'job'} = $job;
5854
5855   my $error = FS::cust_main->email_search_sql( $param );
5856   die $error if $error;
5857
5858 }
5859
5860 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
5861
5862 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
5863 records.  Currently, I<first>, I<last> and/or I<company> may be specified (the
5864 appropriate ship_ field is also searched).
5865
5866 Additional options are the same as FS::Record::qsearch
5867
5868 =cut
5869
5870 sub fuzzy_search {
5871   my( $self, $fuzzy, $hash, @opt) = @_;
5872   #$self
5873   $hash ||= {};
5874   my @cust_main = ();
5875
5876   check_and_rebuild_fuzzyfiles();
5877   foreach my $field ( keys %$fuzzy ) {
5878
5879     my $all = $self->all_X($field);
5880     next unless scalar(@$all);
5881
5882     my %match = ();
5883     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
5884
5885     my @fcust = ();
5886     foreach ( keys %match ) {
5887       push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
5888       push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
5889     }
5890     my %fsaw = ();
5891     push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
5892   }
5893
5894   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
5895   my %saw = ();
5896   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
5897
5898   @cust_main;
5899
5900 }
5901
5902 =item masked FIELD
5903
5904 Returns a masked version of the named field
5905
5906 =cut
5907
5908 sub masked {
5909 my ($self,$field) = @_;
5910
5911 # Show last four
5912
5913 'x'x(length($self->getfield($field))-4).
5914   substr($self->getfield($field), (length($self->getfield($field))-4));
5915
5916 }
5917
5918 =back
5919
5920 =head1 SUBROUTINES
5921
5922 =over 4
5923
5924 =item smart_search OPTION => VALUE ...
5925
5926 Accepts the following options: I<search>, the string to search for.  The string
5927 will be searched for as a customer number, phone number, name or company name,
5928 as an exact, or, in some cases, a substring or fuzzy match (see the source code
5929 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
5930 skip fuzzy matching when an exact match is found.
5931
5932 Any additional options are treated as an additional qualifier on the search
5933 (i.e. I<agentnum>).
5934
5935 Returns a (possibly empty) array of FS::cust_main objects.
5936
5937 =cut
5938
5939 sub smart_search {
5940   my %options = @_;
5941
5942   #here is the agent virtualization
5943   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
5944
5945   my @cust_main = ();
5946
5947   my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
5948   my $search = delete $options{'search'};
5949   ( my $alphanum_search = $search ) =~ s/\W//g;
5950
5951   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
5952
5953     #false laziness w/Record::ut_phone
5954     my $phonen = "$1-$2-$3";
5955     $phonen .= " x$4" if $4;
5956
5957     push @cust_main, qsearch( {
5958       'table'   => 'cust_main',
5959       'hashref' => { %options },
5960       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
5961                      ' ( '.
5962                          join(' OR ', map "$_ = '$phonen'",
5963                                           qw( daytime night fax
5964                                               ship_daytime ship_night ship_fax )
5965                              ).
5966                      ' ) '.
5967                      " AND $agentnums_sql", #agent virtualization
5968     } );
5969
5970     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
5971       #try looking for matches with extensions unless one was specified
5972
5973       push @cust_main, qsearch( {
5974         'table'   => 'cust_main',
5975         'hashref' => { %options },
5976         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
5977                        ' ( '.
5978                            join(' OR ', map "$_ LIKE '$phonen\%'",
5979                                             qw( daytime night
5980                                                 ship_daytime ship_night )
5981                                ).
5982                        ' ) '.
5983                        " AND $agentnums_sql", #agent virtualization
5984       } );
5985
5986     }
5987
5988   # custnum search (also try agent_custid), with some tweaking options if your
5989   # legacy cust "numbers" have letters
5990   } elsif ( $search =~ /^\s*(\d+)\s*$/
5991             || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
5992                  && $search =~ /^\s*(\w\w?\d+)\s*$/
5993                )
5994           )
5995   {
5996
5997     push @cust_main, qsearch( {
5998       'table'     => 'cust_main',
5999       'hashref'   => { 'custnum' => $1, %options },
6000       'extra_sql' => " AND $agentnums_sql", #agent virtualization
6001     } );
6002
6003     push @cust_main, qsearch( {
6004       'table'     => 'cust_main',
6005       'hashref'   => { 'agent_custid' => $1, %options },
6006       'extra_sql' => " AND $agentnums_sql", #agent virtualization
6007     } );
6008
6009   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
6010
6011     my($company, $last, $first) = ( $1, $2, $3 );
6012
6013     # "Company (Last, First)"
6014     #this is probably something a browser remembered,
6015     #so just do an exact search
6016
6017     foreach my $prefix ( '', 'ship_' ) {
6018       push @cust_main, qsearch( {
6019         'table'     => 'cust_main',
6020         'hashref'   => { $prefix.'first'   => $first,
6021                          $prefix.'last'    => $last,
6022                          $prefix.'company' => $company,
6023                          %options,
6024                        },
6025         'extra_sql' => " AND $agentnums_sql",
6026       } );
6027     }
6028
6029   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
6030                                               # try (ship_){last,company}
6031
6032     my $value = lc($1);
6033
6034     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
6035     # # full strings the browser remembers won't work
6036     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
6037
6038     use Lingua::EN::NameParse;
6039     my $NameParse = new Lingua::EN::NameParse(
6040              auto_clean     => 1,
6041              allow_reversed => 1,
6042     );
6043
6044     my($last, $first) = ( '', '' );
6045     #maybe disable this too and just rely on NameParse?
6046     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
6047
6048       ($last, $first) = ( $1, $2 );
6049
6050     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
6051     } elsif ( ! $NameParse->parse($value) ) {
6052
6053       my %name = $NameParse->components;
6054       $first = $name{'given_name_1'};
6055       $last  = $name{'surname_1'};
6056
6057     }
6058
6059     if ( $first && $last ) {
6060
6061       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
6062
6063       #exact
6064       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
6065       $sql .= "
6066         (     ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
6067            OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
6068         )";
6069
6070       push @cust_main, qsearch( {
6071         'table'     => 'cust_main',
6072         'hashref'   => \%options,
6073         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
6074       } );
6075
6076       # or it just be something that was typed in... (try that in a sec)
6077
6078     }
6079
6080     my $q_value = dbh->quote($value);
6081
6082     #exact
6083     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
6084     $sql .= " (    LOWER(last)         = $q_value
6085                 OR LOWER(company)      = $q_value
6086                 OR LOWER(ship_last)    = $q_value
6087                 OR LOWER(ship_company) = $q_value
6088               )";
6089
6090     push @cust_main, qsearch( {
6091       'table'     => 'cust_main',
6092       'hashref'   => \%options,
6093       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
6094     } );
6095
6096     #no exact match, trying substring/fuzzy
6097     #always do substring & fuzzy (unless they're explicity config'ed off)
6098     #getting complaints searches are not returning enough
6099     unless ( @cust_main  && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
6100
6101       #still some false laziness w/search_sql (was search/cust_main.cgi)
6102
6103       #substring
6104
6105       my @hashrefs = (
6106         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
6107         { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
6108       );
6109
6110       if ( $first && $last ) {
6111
6112         push @hashrefs,
6113           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
6114             'last'         => { op=>'ILIKE', value=>"%$last%" },
6115           },
6116           { 'ship_first'   => { op=>'ILIKE', value=>"%$first%" },
6117             'ship_last'    => { op=>'ILIKE', value=>"%$last%" },
6118           },
6119         ;
6120
6121       } else {
6122
6123         push @hashrefs,
6124           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
6125           { 'ship_last'    => { op=>'ILIKE', value=>"%$value%" }, },
6126         ;
6127       }
6128
6129       foreach my $hashref ( @hashrefs ) {
6130
6131         push @cust_main, qsearch( {
6132           'table'     => 'cust_main',
6133           'hashref'   => { %$hashref,
6134                            %options,
6135                          },
6136           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
6137         } );
6138
6139       }
6140
6141       #fuzzy
6142       my @fuzopts = (
6143         \%options,                #hashref
6144         '',                       #select
6145         " AND $agentnums_sql",    #extra_sql  #agent virtualization
6146       );
6147
6148       if ( $first && $last ) {
6149         push @cust_main, FS::cust_main->fuzzy_search(
6150           { 'last'   => $last,    #fuzzy hashref
6151             'first'  => $first }, #
6152           @fuzopts
6153         );
6154       }
6155       foreach my $field ( 'last', 'company' ) {
6156         push @cust_main,
6157           FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
6158       }
6159
6160     }
6161
6162     #eliminate duplicates
6163     my %saw = ();
6164     @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
6165
6166   }
6167
6168   @cust_main;
6169
6170 }
6171
6172 =item email_search
6173
6174 Accepts the following options: I<email>, the email address to search for.  The
6175 email address will be searched for as an email invoice destination and as an
6176 svc_acct account.
6177
6178 #Any additional options are treated as an additional qualifier on the search
6179 #(i.e. I<agentnum>).
6180
6181 Returns a (possibly empty) array of FS::cust_main objects (but usually just
6182 none or one).
6183
6184 =cut
6185
6186 sub email_search {
6187   my %options = @_;
6188
6189   local($DEBUG) = 1;
6190
6191   my $email = delete $options{'email'};
6192
6193   #we're only being used by RT at the moment... no agent virtualization yet
6194   #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
6195
6196   my @cust_main = ();
6197
6198   if ( $email =~ /([^@]+)\@([^@]+)/ ) {
6199
6200     my ( $user, $domain ) = ( $1, $2 );
6201
6202     warn "$me smart_search: searching for $user in domain $domain"
6203       if $DEBUG;
6204
6205     push @cust_main,
6206       map $_->cust_main,
6207           qsearch( {
6208                      'table'     => 'cust_main_invoice',
6209                      'hashref'   => { 'dest' => $email },
6210                    }
6211                  );
6212
6213     push @cust_main,
6214       map  $_->cust_main,
6215       grep $_,
6216       map  $_->cust_svc->cust_pkg,
6217           qsearch( {
6218                      'table'     => 'svc_acct',
6219                      'hashref'   => { 'username' => $user, },
6220                      'extra_sql' =>
6221                        'AND ( SELECT domain FROM svc_domain
6222                                 WHERE svc_acct.domsvc = svc_domain.svcnum
6223                             ) = '. dbh->quote($domain),
6224                    }
6225                  );
6226   }
6227
6228   my %saw = ();
6229   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
6230
6231   warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
6232     if $DEBUG;
6233
6234   @cust_main;
6235
6236 }
6237
6238 =item check_and_rebuild_fuzzyfiles
6239
6240 =cut
6241
6242 use vars qw(@fuzzyfields);
6243 @fuzzyfields = ( 'last', 'first', 'company' );
6244
6245 sub check_and_rebuild_fuzzyfiles {
6246   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6247   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
6248 }
6249
6250 =item rebuild_fuzzyfiles
6251
6252 =cut
6253
6254 sub rebuild_fuzzyfiles {
6255
6256   use Fcntl qw(:flock);
6257
6258   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6259   mkdir $dir, 0700 unless -d $dir;
6260
6261   foreach my $fuzzy ( @fuzzyfields ) {
6262
6263     open(LOCK,">>$dir/cust_main.$fuzzy")
6264       or die "can't open $dir/cust_main.$fuzzy: $!";
6265     flock(LOCK,LOCK_EX)
6266       or die "can't lock $dir/cust_main.$fuzzy: $!";
6267
6268     open (CACHE,">$dir/cust_main.$fuzzy.tmp")
6269       or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
6270
6271     foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
6272       my $sth = dbh->prepare("SELECT $field FROM cust_main".
6273                              " WHERE $field != '' AND $field IS NOT NULL");
6274       $sth->execute or die $sth->errstr;
6275
6276       while ( my $row = $sth->fetchrow_arrayref ) {
6277         print CACHE $row->[0]. "\n";
6278       }
6279
6280     }
6281
6282     close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
6283
6284     rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
6285     close LOCK;
6286   }
6287
6288 }
6289
6290 =item all_X
6291
6292 =cut
6293
6294 sub all_X {
6295   my( $self, $field ) = @_;
6296   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6297   open(CACHE,"<$dir/cust_main.$field")
6298     or die "can't open $dir/cust_main.$field: $!";
6299   my @array = map { chomp; $_; } <CACHE>;
6300   close CACHE;
6301   \@array;
6302 }
6303
6304 =item append_fuzzyfiles LASTNAME COMPANY
6305
6306 =cut
6307
6308 sub append_fuzzyfiles {
6309   #my( $first, $last, $company ) = @_;
6310
6311   &check_and_rebuild_fuzzyfiles;
6312
6313   use Fcntl qw(:flock);
6314
6315   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6316
6317   foreach my $field (qw( first last company )) {
6318     my $value = shift;
6319
6320     if ( $value ) {
6321
6322       open(CACHE,">>$dir/cust_main.$field")
6323         or die "can't open $dir/cust_main.$field: $!";
6324       flock(CACHE,LOCK_EX)
6325         or die "can't lock $dir/cust_main.$field: $!";
6326
6327       print CACHE "$value\n";
6328
6329       flock(CACHE,LOCK_UN)
6330         or die "can't unlock $dir/cust_main.$field: $!";
6331       close CACHE;
6332     }
6333
6334   }
6335
6336   1;
6337 }
6338
6339 =item process_batch_import
6340
6341 Load a batch import as a queued JSRPC job
6342
6343 =cut
6344
6345 use Storable qw(thaw);
6346 use Data::Dumper;
6347 use MIME::Base64;
6348 sub process_batch_import {
6349   my $job = shift;
6350
6351   my $param = thaw(decode_base64(shift));
6352   warn Dumper($param) if $DEBUG;
6353
6354   my $files = $param->{'uploaded_files'}
6355     or die "No files provided.\n";
6356
6357   my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files;
6358
6359   my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
6360   my $file = $dir. $files{'file'};
6361
6362   my $type;
6363   if ( $file =~ /\.(\w+)$/i ) {
6364     $type = lc($1);
6365   } else {
6366     #or error out???
6367     warn "can't parse file type from filename $file; defaulting to CSV";
6368     $type = 'csv';
6369   }
6370
6371   my $error =
6372     FS::cust_main::batch_import( {
6373       job       => $job,
6374       file      => $file,
6375       type      => $type,
6376       custbatch => $param->{custbatch},
6377       agentnum  => $param->{'agentnum'},
6378       refnum    => $param->{'refnum'},
6379       pkgpart   => $param->{'pkgpart'},
6380       #'fields'  => [qw( cust_pkg.setup dayphone first last address1 address2
6381       #                 city state zip comments                          )],
6382       'format'  => $param->{'format'},
6383     } );
6384
6385   unlink $file;
6386
6387   die "$error\n" if $error;
6388
6389 }
6390
6391 =item batch_import
6392
6393 =cut
6394
6395 #some false laziness w/cdr.pm now
6396 sub batch_import {
6397   my $param = shift;
6398
6399   my $job       = $param->{job};
6400
6401   my $filename  = $param->{file};
6402   my $type      = $param->{type} || 'csv';
6403
6404   my $custbatch = $param->{custbatch};
6405
6406   my $agentnum  = $param->{agentnum};
6407   my $refnum    = $param->{refnum};
6408   my $pkgpart   = $param->{pkgpart};
6409
6410   my $format    = $param->{'format'};
6411
6412   my @fields;
6413   my $payby;
6414   if ( $format eq 'simple' ) {
6415     @fields = qw( cust_pkg.setup dayphone first last
6416                   address1 address2 city state zip comments );
6417     $payby = 'BILL';
6418   } elsif ( $format eq 'extended' ) {
6419     @fields = qw( agent_custid refnum
6420                   last first address1 address2 city state zip country
6421                   daytime night
6422                   ship_last ship_first ship_address1 ship_address2
6423                   ship_city ship_state ship_zip ship_country
6424                   payinfo paycvv paydate
6425                   invoicing_list
6426                   cust_pkg.pkgpart
6427                   svc_acct.username svc_acct._password
6428                 );
6429     $payby = 'BILL';
6430  } elsif ( $format eq 'extended-plus_company' ) {
6431     @fields = qw( agent_custid refnum
6432                   last first company address1 address2 city state zip country
6433                   daytime night
6434                   ship_last ship_first ship_company ship_address1 ship_address2
6435                   ship_city ship_state ship_zip ship_country
6436                   payinfo paycvv paydate
6437                   invoicing_list
6438                   cust_pkg.pkgpart
6439                   svc_acct.username svc_acct._password
6440                 );
6441     $payby = 'BILL';
6442   } else {
6443     die "unknown format $format";
6444   }
6445
6446   my $count;
6447   my $parser;
6448   my @buffer = ();
6449   if ( $type eq 'csv' ) {
6450
6451     eval "use Text::CSV_XS;";
6452     die $@ if $@;
6453
6454     $parser = new Text::CSV_XS;
6455
6456     @buffer = split(/\r?\n/, slurp($filename) );
6457     $count = scalar(@buffer);
6458
6459   } elsif ( $type eq 'xls' ) {
6460
6461     eval "use Spreadsheet::ParseExcel;";
6462     die $@ if $@;
6463
6464     my $excel = new Spreadsheet::ParseExcel::Workbook->Parse($filename);
6465     $parser = $excel->{Worksheet}[0]; #first sheet
6466
6467     $count = $parser->{MaxRow} || $parser->{MinRow};
6468     $count++;
6469
6470   } else {
6471     die "Unknown file type $type\n";
6472   }
6473
6474   #my $columns;
6475
6476   local $SIG{HUP} = 'IGNORE';
6477   local $SIG{INT} = 'IGNORE';
6478   local $SIG{QUIT} = 'IGNORE';
6479   local $SIG{TERM} = 'IGNORE';
6480   local $SIG{TSTP} = 'IGNORE';
6481   local $SIG{PIPE} = 'IGNORE';
6482
6483   my $oldAutoCommit = $FS::UID::AutoCommit;
6484   local $FS::UID::AutoCommit = 0;
6485   my $dbh = dbh;
6486
6487   my $line;
6488   my $row = 0;
6489   my( $last, $min_sec ) = ( time, 5 ); #progressbar foo
6490   while (1) {
6491
6492     my @columns = ();
6493     if ( $type eq 'csv' ) {
6494
6495       last unless scalar(@buffer);
6496       $line = shift(@buffer);
6497
6498       $parser->parse($line) or do {
6499         $dbh->rollback if $oldAutoCommit;
6500         return "can't parse: ". $parser->error_input();
6501       };
6502       @columns = $parser->fields();
6503
6504     } elsif ( $type eq 'xls' ) {
6505
6506       last if $row > ($parser->{MaxRow} || $parser->{MinRow});
6507
6508       my @row = @{ $parser->{Cells}[$row] };
6509       @columns = map $_->{Val}, @row;
6510
6511       #my $z = 'A';
6512       #warn $z++. ": $_\n" for @columns;
6513
6514     } else {
6515       die "Unknown file type $type\n";
6516     }
6517
6518     #warn join('-',@columns);
6519
6520     my %cust_main = (
6521       custbatch => $custbatch,
6522       agentnum  => $agentnum,
6523       refnum    => $refnum,
6524       country   => $conf->config('countrydefault') || 'US',
6525       payby     => $payby, #default
6526       paydate   => '12/2037', #default
6527     );
6528     my $billtime = time;
6529     my %cust_pkg = ( pkgpart => $pkgpart );
6530     my %svc_acct = ();
6531     foreach my $field ( @fields ) {
6532
6533       if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|adjourn|expire|cancel)$/ ) {
6534
6535         #$cust_pkg{$1} = str2time( shift @$columns );
6536         if ( $1 eq 'pkgpart' ) {
6537           $cust_pkg{$1} = shift @columns;
6538         } elsif ( $1 eq 'setup' ) {
6539           $billtime = str2time(shift @columns);
6540         } else {
6541           $cust_pkg{$1} = str2time( shift @columns );
6542         }
6543
6544       } elsif ( $field =~ /^svc_acct\.(username|_password)$/ ) {
6545
6546         $svc_acct{$1} = shift @columns;
6547
6548       } else {
6549
6550         #refnum interception
6551         if ( $field eq 'refnum' && $columns[0] !~ /^\s*(\d+)\s*$/ ) {
6552
6553           my $referral = $columns[0];
6554           my %hash = ( 'referral' => $referral,
6555                        'agentnum' => $agentnum,
6556                        'disabled' => '',
6557                      );
6558
6559           my $part_referral = qsearchs('part_referral', \%hash )
6560                               || new FS::part_referral \%hash;
6561
6562           unless ( $part_referral->refnum ) {
6563             my $error = $part_referral->insert;
6564             if ( $error ) {
6565               $dbh->rollback if $oldAutoCommit;
6566               return "can't auto-insert advertising source: $referral: $error";
6567             }
6568           }
6569
6570           $columns[0] = $part_referral->refnum;
6571         }
6572
6573         my $value = shift @columns;
6574         $cust_main{$field} = $value if length($value);
6575       }
6576     }
6577
6578     $cust_main{'payby'} = 'CARD'
6579       if defined $cust_main{'payinfo'}
6580       && length  $cust_main{'payinfo'};
6581
6582     my $invoicing_list = $cust_main{'invoicing_list'}
6583                            ? [ delete $cust_main{'invoicing_list'} ]
6584                            : [];
6585
6586     my $cust_main = new FS::cust_main ( \%cust_main );
6587
6588     use Tie::RefHash;
6589     tie my %hash, 'Tie::RefHash'; #this part is important
6590
6591     if ( $cust_pkg{'pkgpart'} ) {
6592       my $cust_pkg = new FS::cust_pkg ( \%cust_pkg );
6593
6594       my @svc_acct = ();
6595       if ( $svc_acct{'username'} ) {
6596         my $part_pkg = $cust_pkg->part_pkg;
6597         unless ( $part_pkg ) {
6598           $dbh->rollback if $oldAutoCommit;
6599           return "unknown pkgpart: ". $cust_pkg{'pkgpart'};
6600         }
6601         $svc_acct{svcpart} = $part_pkg->svcpart( 'svc_acct' );
6602         push @svc_acct, new FS::svc_acct ( \%svc_acct )
6603       }
6604
6605       $hash{$cust_pkg} = \@svc_acct;
6606     }
6607
6608     my $error = $cust_main->insert( \%hash, $invoicing_list );
6609
6610     if ( $error ) {
6611       $dbh->rollback if $oldAutoCommit;
6612       return "can't insert customer". ( $line ? " for $line" : '' ). ": $error";
6613     }
6614
6615     if ( $format eq 'simple' ) {
6616
6617       #false laziness w/bill.cgi
6618       $error = $cust_main->bill( 'time' => $billtime );
6619       if ( $error ) {
6620         $dbh->rollback if $oldAutoCommit;
6621         return "can't bill customer for $line: $error";
6622       }
6623
6624       $error = $cust_main->apply_payments_and_credits;
6625       if ( $error ) {
6626         $dbh->rollback if $oldAutoCommit;
6627         return "can't bill customer for $line: $error";
6628       }
6629
6630       $error = $cust_main->collect();
6631       if ( $error ) {
6632         $dbh->rollback if $oldAutoCommit;
6633         return "can't collect customer for $line: $error";
6634       }
6635
6636     }
6637
6638     $row++;
6639
6640     if ( $job && time - $min_sec > $last ) { #progress bar
6641       $job->update_statustext( int(100 * $row / $count) );
6642       $last = time;
6643     }
6644
6645   }
6646
6647   $dbh->commit or die $dbh->errstr if $oldAutoCommit;;
6648
6649   return "Empty file!" unless $row;
6650
6651   ''; #no error
6652
6653 }
6654
6655 =item batch_charge
6656
6657 =cut
6658
6659 sub batch_charge {
6660   my $param = shift;
6661   #warn join('-',keys %$param);
6662   my $fh = $param->{filehandle};
6663   my @fields = @{$param->{fields}};
6664
6665   eval "use Text::CSV_XS;";
6666   die $@ if $@;
6667
6668   my $csv = new Text::CSV_XS;
6669   #warn $csv;
6670   #warn $fh;
6671
6672   my $imported = 0;
6673   #my $columns;
6674
6675   local $SIG{HUP} = 'IGNORE';
6676   local $SIG{INT} = 'IGNORE';
6677   local $SIG{QUIT} = 'IGNORE';
6678   local $SIG{TERM} = 'IGNORE';
6679   local $SIG{TSTP} = 'IGNORE';
6680   local $SIG{PIPE} = 'IGNORE';
6681
6682   my $oldAutoCommit = $FS::UID::AutoCommit;
6683   local $FS::UID::AutoCommit = 0;
6684   my $dbh = dbh;
6685
6686   #while ( $columns = $csv->getline($fh) ) {
6687   my $line;
6688   while ( defined($line=<$fh>) ) {
6689
6690     $csv->parse($line) or do {
6691       $dbh->rollback if $oldAutoCommit;
6692       return "can't parse: ". $csv->error_input();
6693     };
6694
6695     my @columns = $csv->fields();
6696     #warn join('-',@columns);
6697
6698     my %row = ();
6699     foreach my $field ( @fields ) {
6700       $row{$field} = shift @columns;
6701     }
6702
6703     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
6704     unless ( $cust_main ) {
6705       $dbh->rollback if $oldAutoCommit;
6706       return "unknown custnum $row{'custnum'}";
6707     }
6708
6709     if ( $row{'amount'} > 0 ) {
6710       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
6711       if ( $error ) {
6712         $dbh->rollback if $oldAutoCommit;
6713         return $error;
6714       }
6715       $imported++;
6716     } elsif ( $row{'amount'} < 0 ) {
6717       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
6718                                       $row{'pkg'}                         );
6719       if ( $error ) {
6720         $dbh->rollback if $oldAutoCommit;
6721         return $error;
6722       }
6723       $imported++;
6724     } else {
6725       #hmm?
6726     }
6727
6728   }
6729
6730   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6731
6732   return "Empty file!" unless $imported;
6733
6734   ''; #no error
6735
6736 }
6737
6738 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
6739
6740 Sends a templated email notification to the customer (see L<Text::Template>).
6741
6742 OPTIONS is a hash and may include
6743
6744 I<from> - the email sender (default is invoice_from)
6745
6746 I<to> - comma-separated scalar or arrayref of recipients
6747    (default is invoicing_list)
6748
6749 I<subject> - The subject line of the sent email notification
6750    (default is "Notice from company_name")
6751
6752 I<extra_fields> - a hashref of name/value pairs which will be substituted
6753    into the template
6754
6755 The following variables are vavailable in the template.
6756
6757 I<$first> - the customer first name
6758 I<$last> - the customer last name
6759 I<$company> - the customer company
6760 I<$payby> - a description of the method of payment for the customer
6761             # would be nice to use FS::payby::shortname
6762 I<$payinfo> - the account information used to collect for this customer
6763 I<$expdate> - the expiration of the customer payment in seconds from epoch
6764
6765 =cut
6766
6767 sub notify {
6768   my ($customer, $template, %options) = @_;
6769
6770   return unless $conf->exists($template);
6771
6772   my $from = $conf->config('invoice_from') if $conf->exists('invoice_from');
6773   $from = $options{from} if exists($options{from});
6774
6775   my $to = join(',', $customer->invoicing_list_emailonly);
6776   $to = $options{to} if exists($options{to});
6777
6778   my $subject = "Notice from " . $conf->config('company_name')
6779     if $conf->exists('company_name');
6780   $subject = $options{subject} if exists($options{subject});
6781
6782   my $notify_template = new Text::Template (TYPE => 'ARRAY',
6783                                             SOURCE => [ map "$_\n",
6784                                               $conf->config($template)]
6785                                            )
6786     or die "can't create new Text::Template object: Text::Template::ERROR";
6787   $notify_template->compile()
6788     or die "can't compile template: Text::Template::ERROR";
6789
6790   $FS::notify_template::_template::company_name = $conf->config('company_name');
6791   $FS::notify_template::_template::company_address =
6792     join("\n", $conf->config('company_address') ). "\n";
6793
6794   my $paydate = $customer->paydate || '2037-12-31';
6795   $FS::notify_template::_template::first = $customer->first;
6796   $FS::notify_template::_template::last = $customer->last;
6797   $FS::notify_template::_template::company = $customer->company;
6798   $FS::notify_template::_template::payinfo = $customer->mask_payinfo;
6799   my $payby = $customer->payby;
6800   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6801   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6802
6803   #credit cards expire at the end of the month/year of their exp date
6804   if ($payby eq 'CARD' || $payby eq 'DCRD') {
6805     $FS::notify_template::_template::payby = 'credit card';
6806     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6807     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6808     $expire_time--;
6809   }elsif ($payby eq 'COMP') {
6810     $FS::notify_template::_template::payby = 'complimentary account';
6811   }else{
6812     $FS::notify_template::_template::payby = 'current method';
6813   }
6814   $FS::notify_template::_template::expdate = $expire_time;
6815
6816   for (keys %{$options{extra_fields}}){
6817     no strict "refs";
6818     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
6819   }
6820
6821   send_email(from => $from,
6822              to => $to,
6823              subject => $subject,
6824              body => $notify_template->fill_in( PACKAGE =>
6825                                                 'FS::notify_template::_template'                                              ),
6826             );
6827
6828 }
6829
6830 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
6831
6832 Generates a templated notification to the customer (see L<Text::Template>).
6833
6834 OPTIONS is a hash and may include
6835
6836 I<extra_fields> - a hashref of name/value pairs which will be substituted
6837    into the template.  These values may override values mentioned below
6838    and those from the customer record.
6839
6840 The following variables are available in the template instead of or in addition
6841 to the fields of the customer record.
6842
6843 I<$payby> - a description of the method of payment for the customer
6844             # would be nice to use FS::payby::shortname
6845 I<$payinfo> - the masked account information used to collect for this customer
6846 I<$expdate> - the expiration of the customer payment method in seconds from epoch
6847 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
6848
6849 =cut
6850
6851 sub generate_letter {
6852   my ($self, $template, %options) = @_;
6853
6854   return unless $conf->exists($template);
6855
6856   my $letter_template = new Text::Template
6857                         ( TYPE       => 'ARRAY',
6858                           SOURCE     => [ map "$_\n", $conf->config($template)],
6859                           DELIMITERS => [ '[@--', '--@]' ],
6860                         )
6861     or die "can't create new Text::Template object: Text::Template::ERROR";
6862
6863   $letter_template->compile()
6864     or die "can't compile template: Text::Template::ERROR";
6865
6866   my %letter_data = map { $_ => $self->$_ } $self->fields;
6867   $letter_data{payinfo} = $self->mask_payinfo;
6868
6869   #my $paydate = $self->paydate || '2037-12-31';
6870   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
6871
6872   my $payby = $self->payby;
6873   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6874   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6875
6876   #credit cards expire at the end of the month/year of their exp date
6877   if ($payby eq 'CARD' || $payby eq 'DCRD') {
6878     $letter_data{payby} = 'credit card';
6879     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6880     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6881     $expire_time--;
6882   }elsif ($payby eq 'COMP') {
6883     $letter_data{payby} = 'complimentary account';
6884   }else{
6885     $letter_data{payby} = 'current method';
6886   }
6887   $letter_data{expdate} = $expire_time;
6888
6889   for (keys %{$options{extra_fields}}){
6890     $letter_data{$_} = $options{extra_fields}->{$_};
6891   }
6892
6893   unless(exists($letter_data{returnaddress})){
6894     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
6895                                                   $self->agent_template)
6896                      );
6897     if ( length($retadd) ) {
6898       $letter_data{returnaddress} = $retadd;
6899     } elsif ( grep /\S/, $conf->config('company_address') ) {
6900       $letter_data{returnaddress} =
6901         join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
6902                           $conf->config('company_address')
6903         );
6904     } else {
6905       $letter_data{returnaddress} = '~';
6906     }
6907   }
6908
6909   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
6910
6911   $letter_data{company_name} = $conf->config('company_name');
6912
6913   my $dir = $FS::UID::conf_dir."cache.". $FS::UID::datasrc;
6914   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
6915                            DIR      => $dir,
6916                            SUFFIX   => '.tex',
6917                            UNLINK   => 0,
6918                          ) or die "can't open temp file: $!\n";
6919
6920   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
6921   close $fh;
6922   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
6923   return $1;
6924 }
6925
6926 =item print_ps TEMPLATE
6927
6928 Returns an postscript letter filled in from TEMPLATE, as a scalar.
6929
6930 =cut
6931
6932 sub print_ps {
6933   my $self = shift;
6934   my $file = $self->generate_letter(@_);
6935   FS::Misc::generate_ps($file);
6936 }
6937
6938 =item print TEMPLATE
6939
6940 Prints the filled in template.
6941
6942 TEMPLATE is the name of a L<Text::Template> to fill in and print.
6943
6944 =cut
6945
6946 sub queueable_print {
6947   my %opt = @_;
6948
6949   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
6950     or die "invalid customer number: " . $opt{custvnum};
6951
6952   my $error = $self->print( $opt{template} );
6953   die $error if $error;
6954 }
6955
6956 sub print {
6957   my ($self, $template) = (shift, shift);
6958   do_print [ $self->print_ps($template) ];
6959 }
6960
6961 sub agent_template {
6962   my $self = shift;
6963   $self->_agent_plandata('agent_templatename');
6964 }
6965
6966 sub agent_invoice_from {
6967   my $self = shift;
6968   $self->_agent_plandata('agent_invoice_from');
6969 }
6970
6971 sub _agent_plandata {
6972   my( $self, $option ) = @_;
6973
6974   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
6975   #agent-specific Conf
6976
6977   use FS::part_event::Condition;
6978
6979   my $agentnum = $self->agentnum;
6980
6981   my $regexp = '';
6982   if ( driver_name =~ /^Pg/i ) {
6983     $regexp = '~';
6984   } elsif ( driver_name =~ /^mysql/i ) {
6985     $regexp = 'REGEXP';
6986   } else {
6987     die "don't know how to use regular expressions in ". driver_name. " databases";
6988   }
6989
6990   my $part_event_option =
6991     qsearchs({
6992       'select'    => 'part_event_option.*',
6993       'table'     => 'part_event_option',
6994       'addl_from' => q{
6995         LEFT JOIN part_event USING ( eventpart )
6996         LEFT JOIN part_event_option AS peo_agentnum
6997           ON ( part_event.eventpart = peo_agentnum.eventpart
6998                AND peo_agentnum.optionname = 'agentnum'
6999                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
7000              )
7001         LEFT JOIN part_event_option AS peo_cust_bill_age
7002           ON ( part_event.eventpart = peo_cust_bill_age.eventpart
7003                AND peo_cust_bill_age.optionname = 'cust_bill_age'
7004              )
7005       },
7006       #'hashref'   => { 'optionname' => $option },
7007       #'hashref'   => { 'part_event_option.optionname' => $option },
7008       'extra_sql' =>
7009         " WHERE part_event_option.optionname = ". dbh->quote($option).
7010         " AND action = 'cust_bill_send_agent' ".
7011         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
7012         " AND peo_agentnum.optionname = 'agentnum' ".
7013         " AND agentnum IS NULL OR agentnum = $agentnum ".
7014         " ORDER BY
7015            CASE WHEN peo_cust_bill_age.optionname != 'cust_bill_age'
7016            THEN -1
7017            ELSE ". FS::part_event::Condition->age2seconds_sql('peo_cust_bill_age.optionvalue').
7018         " END
7019           , part_event.weight".
7020         " LIMIT 1"
7021     });
7022
7023   unless ( $part_event_option ) {
7024     return $self->agent->invoice_template || ''
7025       if $option eq 'agent_templatename';
7026     return '';
7027   }
7028
7029   $part_event_option->optionvalue;
7030
7031 }
7032
7033 sub queued_bill {
7034   ## actual sub, not a method, designed to be called from the queue.
7035   ## sets up the customer, and calls the bill_and_collect
7036   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
7037   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
7038       $cust_main->bill_and_collect(
7039         %args,
7040       );
7041 }
7042
7043 =back
7044
7045 =head1 BUGS
7046
7047 The delete method.
7048
7049 The delete method should possibly take an FS::cust_main object reference
7050 instead of a scalar customer number.
7051
7052 Bill and collect options should probably be passed as references instead of a
7053 list.
7054
7055 There should probably be a configuration file with a list of allowed credit
7056 card types.
7057
7058 No multiple currency support (probably a larger project than just this module).
7059
7060 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
7061
7062 Birthdates rely on negative epoch values.
7063
7064 The payby for card/check batches is broken.  With mixed batching, bad
7065 things will happen.
7066
7067 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
7068
7069 =head1 SEE ALSO
7070
7071 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
7072 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
7073 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
7074
7075 =cut
7076
7077 1;
7078