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