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 $cpr = $cust_pkg->last_cust_pkg_reason('expire');
1966     my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
1967                                            'reason_otaker' => $cpr->otaker
1968                                          )
1969                                        : ()
1970                                  );
1971     warn "Error cancelling expired pkg ". $cust_pkg->pkgnum.
1972          " for custnum ". $self->custnum. ": $error"
1973       if $error;
1974   }
1975
1976   ###
1977   # suspend packages
1978   ###
1979
1980   #$options{actual_time} not $options{time} because freeside-daily -d is for
1981   #pre-printing invoices
1982   my @susp_pkgs =
1983     grep { ! $_->susp
1984            && (    (    $_->part_pkg->is_prepaid
1985                      && $_->bill
1986                      && $_->bill < $options{actual_time}
1987                    )
1988                 || (    $_->adjourn
1989                     && $_->adjourn <= $options{actual_time}
1990                   )
1991               )
1992          }
1993          $self->ncancelled_pkgs;
1994
1995   foreach my $cust_pkg ( @susp_pkgs ) {
1996     my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
1997       if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
1998     my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
1999                                             'reason_otaker' => $cpr->otaker
2000                                           )
2001                                         : ()
2002                                   );
2003
2004     warn "Error suspending package ". $cust_pkg->pkgnum.
2005          " for custnum ". $self->custnum. ": $error"
2006       if $error;
2007   }
2008
2009   ###
2010   # bill and collect
2011   ###
2012
2013   my $error = $self->bill( %options );
2014   warn "Error billing, custnum ". $self->custnum. ": $error" if $error;
2015
2016   $self->apply_payments_and_credits;
2017
2018   $error = $self->collect( %options );
2019   warn "Error collecting, custnum". $self->custnum. ": $error" if $error;
2020
2021 }
2022
2023 =item bill OPTIONS
2024
2025 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
2026 conjunction with the collect method by calling B<bill_and_collect>.
2027
2028 If there is an error, returns the error, otherwise returns false.
2029
2030 Options are passed as name-value pairs.  Currently available options are:
2031
2032 =over 4
2033
2034 =item resetup
2035
2036 If set true, re-charges setup fees.
2037
2038 =item time
2039
2040 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:
2041
2042  use Date::Parse;
2043  ...
2044  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2045
2046 =item pkg_list
2047
2048 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
2049
2050  $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2051
2052 =item invoice_time
2053
2054 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.
2055
2056 =back
2057
2058 =cut
2059
2060 sub bill {
2061   my( $self, %options ) = @_;
2062   return '' if $self->payby eq 'COMP';
2063   warn "$me bill customer ". $self->custnum. "\n"
2064     if $DEBUG;
2065
2066   my $time = $options{'time'} || time;
2067
2068   #put below somehow?
2069   local $SIG{HUP} = 'IGNORE';
2070   local $SIG{INT} = 'IGNORE';
2071   local $SIG{QUIT} = 'IGNORE';
2072   local $SIG{TERM} = 'IGNORE';
2073   local $SIG{TSTP} = 'IGNORE';
2074   local $SIG{PIPE} = 'IGNORE';
2075
2076   my $oldAutoCommit = $FS::UID::AutoCommit;
2077   local $FS::UID::AutoCommit = 0;
2078   my $dbh = dbh;
2079
2080   $self->select_for_update; #mutex
2081
2082   my @cust_bill_pkg = ();
2083
2084   ###
2085   # find the packages which are due for billing, find out how much they are
2086   # & generate invoice database.
2087   ###
2088
2089   my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 );
2090   my %tax;
2091   my %taxlisthash;
2092   my %taxname;
2093   my @precommit_hooks = ();
2094
2095   my @cust_pkgs = qsearch('cust_pkg', { 'custnum' => $self->custnum } );
2096   foreach my $cust_pkg (@cust_pkgs) {
2097
2098     #NO!! next if $cust_pkg->cancel;
2099     next if $cust_pkg->getfield('cancel');
2100
2101     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2102
2103     #? to avoid use of uninitialized value errors... ?
2104     $cust_pkg->setfield('bill', '')
2105       unless defined($cust_pkg->bill);
2106
2107     #my $part_pkg = $cust_pkg->part_pkg;
2108
2109     my $real_pkgpart = $cust_pkg->pkgpart;
2110     my %hash = $cust_pkg->hash;
2111
2112     foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
2113
2114       $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
2115
2116       my $error =
2117         $self->_make_lines( 'part_pkg'            => $part_pkg,
2118                             'cust_pkg'            => $cust_pkg,
2119                             'precommit_hooks'     => \@precommit_hooks,
2120                             'line_items'          => \@cust_bill_pkg,
2121                             'setup'               => \$total_setup,
2122                             'recur'               => \$total_recur,
2123                             'tax_matrix'          => \%taxlisthash,
2124                             'time'                => $time,
2125                             'options'             => \%options,
2126                           );
2127       if ($error) {
2128         $dbh->rollback if $oldAutoCommit;
2129         return $error;
2130       }
2131
2132     } #foreach my $part_pkg
2133
2134   } #foreach my $cust_pkg
2135
2136   unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items
2137     #but do commit any package date cycling that happened
2138     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2139     return '';
2140   }
2141
2142   my $postal_pkg = $self->charge_postal_fee();
2143   if ( $postal_pkg && !ref( $postal_pkg ) ) {
2144     $dbh->rollback if $oldAutoCommit;
2145     return "can't charge postal invoice fee for customer ".
2146       $self->custnum. ": $postal_pkg";
2147   }
2148   if ( $postal_pkg ) {
2149     foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
2150       my $error =
2151         $self->_make_lines( 'part_pkg'            => $part_pkg,
2152                             'cust_pkg'            => $postal_pkg,
2153                             'precommit_hooks'     => \@precommit_hooks,
2154                             'line_items'          => \@cust_bill_pkg,
2155                             'setup'               => \$total_setup,
2156                             'recur'               => \$total_recur,
2157                             'tax_matrix'          => \%taxlisthash,
2158                             'time'                => $time,
2159                             'options'             => \%options,
2160                           );
2161       if ($error) {
2162         $dbh->rollback if $oldAutoCommit;
2163         return $error;
2164       }
2165     }
2166   }
2167
2168   warn "having a look at the taxes we found...\n" if $DEBUG > 2;
2169   foreach my $tax ( keys %taxlisthash ) {
2170     my $tax_object = shift @{ $taxlisthash{$tax} };
2171     warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
2172     my $listref_or_error = $tax_object->taxline( @{ $taxlisthash{$tax} } );
2173     unless (ref($listref_or_error)) {
2174       $dbh->rollback if $oldAutoCommit;
2175       return $listref_or_error;
2176     }
2177     unshift @{ $taxlisthash{$tax} }, $tax_object;
2178
2179     warn "adding ". $listref_or_error->[1].
2180          " as ". $listref_or_error->[0]. "\n"
2181       if $DEBUG > 2;
2182     $tax{ $tax_object->taxname } += $listref_or_error->[1];
2183     if ( $taxname{ $listref_or_error->[0] } ) {
2184       push @{ $taxname{ $listref_or_error->[0] } }, $tax_object->taxname;
2185     }else{
2186       $taxname{ $listref_or_error->[0] } = [ $tax_object->taxname ];
2187     }
2188
2189   }
2190
2191   #some taxes are taxed
2192   my %totlisthash;
2193
2194   warn "finding taxed taxes...\n" if $DEBUG > 2;
2195   foreach my $tax ( keys %taxlisthash ) {
2196     my $tax_object = shift @{ $taxlisthash{$tax} };
2197     warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
2198       if $DEBUG > 2;
2199     next unless $tax_object->can('tax_on_tax');
2200
2201     foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
2202       my $totname = ref( $tot ). ' '. $tot->taxnum;
2203
2204       warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
2205         if $DEBUG > 2;
2206       next unless exists( $taxlisthash{ $totname } ); # only increase
2207                                                       # existing taxes
2208       warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
2209       if ( exists( $totlisthash{ $totname } ) ) {
2210         push @{ $totlisthash{ $totname  } }, $tax{ $tax_object->taxname };
2211       }else{
2212         $totlisthash{ $totname } = [ $tot, $tax{ $tax_object->taxname } ];
2213       }
2214     }
2215   }
2216
2217   warn "having a look at taxed taxes...\n" if $DEBUG > 2;
2218   foreach my $tax ( keys %totlisthash ) {
2219     my $tax_object = shift @{ $totlisthash{$tax} };
2220     warn "found previously found taxed tax ". $tax_object->taxname. "\n"
2221       if $DEBUG > 2;
2222     my $listref_or_error = $tax_object->taxline( @{ $totlisthash{$tax} } );
2223     unless (ref($listref_or_error)) {
2224       $dbh->rollback if $oldAutoCommit;
2225       return $listref_or_error;
2226     }
2227
2228     warn "adding taxed tax amount ". $listref_or_error->[1].
2229          " as ". $tax_object->taxname. "\n"
2230       if $DEBUG;
2231     $tax{ $tax_object->taxname } += $listref_or_error->[1];
2232   }
2233
2234   #consolidate and create tax line items
2235   warn "consolidating and generating...\n" if $DEBUG > 2;
2236   foreach my $taxname ( keys %taxname ) {
2237     my $tax = 0;
2238     my %seen = ();
2239     warn "adding $taxname\n" if $DEBUG > 1;
2240     foreach my $taxitem ( @{ $taxname{$taxname} } ) {
2241       $tax += $tax{$taxitem} unless $seen{$taxitem};
2242       warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
2243     }
2244     next unless $tax;
2245
2246     $tax = sprintf('%.2f', $tax );
2247     $total_setup = sprintf('%.2f', $total_setup+$tax );
2248
2249     push @cust_bill_pkg, new FS::cust_bill_pkg {
2250       'pkgnum'   => 0,
2251       'setup'    => $tax,
2252       'recur'    => 0,
2253       'sdate'    => '',
2254       'edate'    => '',
2255       'itemdesc' => $taxname,
2256     };
2257
2258   }
2259
2260   my $charged = sprintf('%.2f', $total_setup + $total_recur );
2261
2262   #create the new invoice
2263   my $cust_bill = new FS::cust_bill ( {
2264     'custnum' => $self->custnum,
2265     '_date'   => ( $options{'invoice_time'} || $time ),
2266     'charged' => $charged,
2267   } );
2268   my $error = $cust_bill->insert;
2269   if ( $error ) {
2270     $dbh->rollback if $oldAutoCommit;
2271     return "can't create invoice for customer #". $self->custnum. ": $error";
2272   }
2273
2274   foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
2275     $cust_bill_pkg->invnum($cust_bill->invnum);
2276     my $error = $cust_bill_pkg->insert;
2277     if ( $error ) {
2278       $dbh->rollback if $oldAutoCommit;
2279       return "can't create invoice line item: $error";
2280     }
2281   }
2282
2283
2284   foreach my $hook ( @precommit_hooks ) {
2285     eval {
2286       &{$hook}; #($self) ?
2287     };
2288     if ( $@ ) {
2289       $dbh->rollback if $oldAutoCommit;
2290       return "$@ running precommit hook $hook\n";
2291     }
2292   }
2293
2294   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2295   ''; #no error
2296 }
2297
2298
2299 sub _make_lines {
2300   my ($self, %params) = @_;
2301
2302   my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
2303   my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
2304   my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
2305   my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
2306   my $total_setup = $params{setup} or die "no setup accumulator specified";
2307   my $total_recur = $params{recur} or die "no recur accumulator specified";
2308   my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
2309   my $time = $params{'time'} or die "no time specified";
2310   my (%options) = %{$params{options}};  #hmmm  only for 'resetup'
2311
2312   my $dbh = dbh;
2313   my $real_pkgpart = $cust_pkg->pkgpart;
2314   my %hash = $cust_pkg->hash;
2315   my $old_cust_pkg = new FS::cust_pkg \%hash;
2316
2317   my @details = ();
2318
2319   my $lineitems = 0;
2320
2321   $cust_pkg->pkgpart($part_pkg->pkgpart);
2322
2323   ###
2324   # bill setup
2325   ###
2326
2327   my $setup = 0;
2328   my $unitsetup = 0;
2329   if ( ! $cust_pkg->setup &&
2330        (
2331          ( $conf->exists('disable_setup_suspended_pkgs') &&
2332           ! $cust_pkg->getfield('susp')
2333         ) || ! $conf->exists('disable_setup_suspended_pkgs')
2334        )
2335     || $options{'resetup'}
2336   ) {
2337
2338     warn "    bill setup\n" if $DEBUG > 1;
2339     $lineitems++;
2340
2341     $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
2342     return "$@ running calc_setup for $cust_pkg\n"
2343       if $@;
2344
2345     $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
2346
2347     $cust_pkg->setfield('setup', $time)
2348       unless $cust_pkg->setup;
2349           #do need it, but it won't get written to the db
2350           #|| $cust_pkg->pkgpart != $real_pkgpart;
2351
2352   }
2353
2354   ###
2355   # bill recurring fee
2356   ###
2357
2358   #XXX unit stuff here too
2359   my $recur = 0;
2360   my $unitrecur = 0;
2361   my $sdate;
2362   if ( $part_pkg->getfield('freq') ne '0' &&
2363        ! $cust_pkg->getfield('susp') &&
2364        ( $cust_pkg->getfield('bill') || 0 ) <= $time
2365   ) {
2366
2367     # XXX should this be a package event?  probably.  events are called
2368     # at collection time at the moment, though...
2369     $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
2370       if $part_pkg->can('reset_usage');
2371       #don't want to reset usage just cause we want a line item??
2372       #&& $part_pkg->pkgpart == $real_pkgpart;
2373
2374     warn "    bill recur\n" if $DEBUG > 1;
2375     $lineitems++;
2376
2377     # XXX shared with $recur_prog
2378     $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2379
2380     #over two params!  lets at least switch to a hashref for the rest...
2381     my %param = ( 'precommit_hooks' => $precommit_hooks, );
2382
2383     $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
2384     return "$@ running calc_recur for $cust_pkg\n"
2385       if ( $@ );
2386
2387
2388     #change this bit to use Date::Manip? CAREFUL with timezones (see
2389     # mailing list archive)
2390     my ($sec,$min,$hour,$mday,$mon,$year) =
2391       (localtime($sdate) )[0,1,2,3,4,5];
2392
2393     #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
2394     # only for figuring next bill date, nothing else, so, reset $sdate again
2395     # here
2396     $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2397     #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
2398     $cust_pkg->last_bill($sdate);
2399
2400     if ( $part_pkg->freq =~ /^\d+$/ ) {
2401       $mon += $part_pkg->freq;
2402       until ( $mon < 12 ) { $mon -= 12; $year++; }
2403     } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
2404       my $weeks = $1;
2405       $mday += $weeks * 7;
2406     } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
2407       my $days = $1;
2408       $mday += $days;
2409     } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
2410       my $hours = $1;
2411       $hour += $hours;
2412     } else {
2413       return "unparsable frequency: ". $part_pkg->freq;
2414     }
2415     $cust_pkg->setfield('bill',
2416       timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
2417
2418   }
2419
2420   warn "\$setup is undefined" unless defined($setup);
2421   warn "\$recur is undefined" unless defined($recur);
2422   warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
2423
2424   ###
2425   # If there's line items, create em cust_bill_pkg records
2426   # If $cust_pkg has been modified, update it (if we're a real pkgpart)
2427   ###
2428
2429   if ( $lineitems ) {
2430
2431     if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
2432       # hmm.. and if just the options are modified in some weird price plan?
2433
2434       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
2435         if $DEBUG >1;
2436
2437       my $error = $cust_pkg->replace( $old_cust_pkg,
2438                                       'options' => { $cust_pkg->options },
2439                                     );
2440       return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
2441         if $error; #just in case
2442     }
2443
2444     $setup = sprintf( "%.2f", $setup );
2445     $recur = sprintf( "%.2f", $recur );
2446     if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
2447       return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
2448     }
2449     if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
2450       return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
2451     }
2452
2453     if ( $setup != 0 || $recur != 0 ) {
2454
2455       warn "    charges (setup=$setup, recur=$recur); adding line items\n"
2456         if $DEBUG > 1;
2457
2458       my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
2459       if ( $DEBUG > 1 ) {
2460         warn "      adding customer package invoice detail: $_\n"
2461           foreach @cust_pkg_detail;
2462       }
2463       push @details, @cust_pkg_detail;
2464
2465       my $cust_bill_pkg = new FS::cust_bill_pkg {
2466         'pkgnum'    => $cust_pkg->pkgnum,
2467         'setup'     => $setup,
2468         'unitsetup' => $unitsetup,
2469         'recur'     => $recur,
2470         'unitrecur' => $unitrecur,
2471         'quantity'  => $cust_pkg->quantity,
2472         'details'   => \@details,
2473       };
2474
2475       if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
2476         $cust_bill_pkg->sdate( $hash{last_bill} );
2477         $cust_bill_pkg->edate( $sdate - 86399   ); #60s*60m*24h-1
2478       } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
2479         $cust_bill_pkg->sdate( $sdate );
2480         $cust_bill_pkg->edate( $cust_pkg->bill );
2481       }
2482
2483       $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
2484         unless $part_pkg->pkgpart == $real_pkgpart;
2485
2486       $$total_setup += $setup;
2487       $$total_recur += $recur;
2488
2489       ###
2490       # handle taxes
2491       ###
2492
2493       my $error =
2494         $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg);
2495       return $error if $error;
2496
2497       push @$cust_bill_pkgs, $cust_bill_pkg;
2498
2499     } #if $setup != 0 || $recur != 0
2500
2501   } #if $line_items
2502
2503   '';
2504
2505 }
2506
2507 sub _handle_taxes {
2508   my $self = shift;
2509   my $part_pkg = shift;
2510   my $taxlisthash = shift;
2511   my $cust_bill_pkg = shift;
2512   my $cust_pkg = shift;
2513
2514   my %cust_bill_pkg = ();
2515   my %taxes = ();
2516
2517   my $prefix =
2518     ( $conf->exists('tax-ship_address') && length($self->ship_last) )
2519     ? 'ship_'
2520     : '';
2521
2522   my @classes;
2523   #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
2524   push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
2525   push @classes, 'setup' if $cust_bill_pkg->setup;
2526   push @classes, 'recur' if $cust_bill_pkg->recur;
2527
2528   if ( $conf->exists('enable_taxproducts')
2529        && (scalar($part_pkg->part_pkg_taxoverride) || $part_pkg->has_taxproduct)
2530        && ( $self->tax !~ /Y/i && $self->payby ne 'COMP' )
2531      )
2532   {
2533
2534     foreach my $class (@classes) {
2535       my $err_or_ref = $self->_gather_taxes( $part_pkg, $class, $prefix );
2536       return $err_or_ref unless ref($err_or_ref);
2537       $taxes{$class} = $err_or_ref;
2538     }
2539
2540     unless (exists $taxes{''}) {
2541       my $err_or_ref = $self->_gather_taxes( $part_pkg, '', $prefix );
2542       return $err_or_ref unless ref($err_or_ref);
2543       $taxes{''} = $err_or_ref;
2544     }
2545
2546   } elsif ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
2547
2548     my %taxhash = map { $_ => $self->get("$prefix$_") }
2549                       qw( state county country );
2550
2551     $taxhash{'taxclass'} = $part_pkg->taxclass;
2552
2553     my @taxes = qsearch( 'cust_main_county', \%taxhash );
2554
2555     unless ( @taxes ) {
2556       $taxhash{'taxclass'} = '';
2557       @taxes =  qsearch( 'cust_main_county', \%taxhash );
2558     }
2559
2560     #one more try at a whole-country tax rate
2561     unless ( @taxes ) {
2562       $taxhash{$_} = '' foreach qw( state county );
2563       @taxes =  qsearch( 'cust_main_county', \%taxhash );
2564     }
2565
2566     $taxes{''} = [ @taxes ];
2567     $taxes{'setup'} = [ @taxes ];
2568     $taxes{'recur'} = [ @taxes ];
2569     $taxes{$_} = [ @taxes ] foreach (@classes);
2570
2571     # maybe eliminate this entirely, along with all the 0% records
2572     unless ( @taxes ) {
2573       return
2574         "fatal: can't find tax rate for state/county/country/taxclass ".
2575         join('/', ( map $self->get("$prefix$_"),
2576                         qw(state county country)
2577                   ),
2578                   $part_pkg->taxclass ). "\n";
2579     }
2580
2581   } #if $conf->exists('enable_taxproducts') ...
2582
2583   my @display = ();
2584   if ( $conf->exists('separate_usage') ) {
2585     my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!');
2586     my $summary = $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
2587     push @display, new FS::cust_bill_pkg_display { type    => 'S' };
2588     push @display, new FS::cust_bill_pkg_display { type    => 'R' };
2589     push @display, new FS::cust_bill_pkg_display { type    => 'U',
2590                                                    section => $section
2591                                                  };
2592     if ($section && $summary) {
2593       $display[2]->post_total('Y');
2594       push @display, new FS::cust_bill_pkg_display { type    => 'U',
2595                                                      summary => 'Y',
2596                                                    }
2597     }
2598   }
2599   $cust_bill_pkg->set('display', \@display);
2600
2601   my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
2602   foreach my $key (keys %tax_cust_bill_pkg) {
2603     my @taxes = @{ $taxes{$key} };
2604     my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
2605
2606     foreach my $tax ( @taxes ) {
2607       my $taxname = ref( $tax ). ' '. $tax->taxnum;
2608       if ( exists( $taxlisthash->{ $taxname } ) ) {
2609         push @{ $taxlisthash->{ $taxname  } }, $tax_cust_bill_pkg;
2610       }else{
2611         $taxlisthash->{ $taxname } = [ $tax, $tax_cust_bill_pkg ];
2612       }
2613     }
2614   }
2615
2616   '';
2617 }
2618
2619 sub _gather_taxes {
2620   my $self = shift;
2621   my $part_pkg = shift;
2622   my $class = shift;
2623   my $prefix = shift;
2624
2625   my @taxes = ();
2626   my $geocode = $self->geocode('cch');
2627
2628   my @taxclassnums = map { $_->taxclassnum }
2629                      $part_pkg->part_pkg_taxoverride($class);
2630
2631   unless (@taxclassnums) {
2632     @taxclassnums = map { $_->taxclassnum }
2633                     $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
2634   }
2635   warn "Found taxclassnum values of ". join(',', @taxclassnums)
2636     if $DEBUG;
2637
2638   my $extra_sql =
2639     "AND (".
2640     join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
2641
2642   @taxes = qsearch({ 'table' => 'tax_rate',
2643                      'hashref' => { 'geocode' => $geocode, },
2644                      'extra_sql' => $extra_sql,
2645                   })
2646     if scalar(@taxclassnums);
2647
2648   # maybe eliminate this entirely, along with all the 0% records
2649   unless ( @taxes ) {
2650     return
2651       "fatal: can't find tax rate for zip/taxproduct/pkgpart ".
2652       join('/', ( map $self->get("$prefix$_"),
2653                       qw(zip)
2654                 ),
2655                 $part_pkg->taxproduct_description,
2656                 $part_pkg->pkgpart ). "\n";
2657   }
2658
2659   warn "Found taxes ".
2660        join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
2661    if $DEBUG;
2662
2663   [ @taxes ];
2664
2665 }
2666
2667 =item collect OPTIONS
2668
2669 (Attempt to) collect money for this customer's outstanding invoices (see
2670 L<FS::cust_bill>).  Usually used after the bill method.
2671
2672 Actions are now triggered by billing events; see L<FS::part_event> and the
2673 billing events web interface.  Old-style invoice events (see
2674 L<FS::part_bill_event>) have been deprecated.
2675
2676 If there is an error, returns the error, otherwise returns false.
2677
2678 Options are passed as name-value pairs.
2679
2680 Currently available options are:
2681
2682 =over 4
2683
2684 =item invoice_time
2685
2686 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.
2687
2688 =item retry
2689
2690 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
2691
2692 =item quiet
2693
2694 set true to surpress email card/ACH decline notices.
2695
2696 =item check_freq
2697
2698 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2699
2700 =item payby
2701
2702 allows for one time override of normal customer billing method
2703
2704 =item debug
2705
2706 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)
2707
2708
2709 =back
2710
2711 =cut
2712
2713 sub collect {
2714   my( $self, %options ) = @_;
2715   my $invoice_time = $options{'invoice_time'} || time;
2716
2717   #put below somehow?
2718   local $SIG{HUP} = 'IGNORE';
2719   local $SIG{INT} = 'IGNORE';
2720   local $SIG{QUIT} = 'IGNORE';
2721   local $SIG{TERM} = 'IGNORE';
2722   local $SIG{TSTP} = 'IGNORE';
2723   local $SIG{PIPE} = 'IGNORE';
2724
2725   my $oldAutoCommit = $FS::UID::AutoCommit;
2726   local $FS::UID::AutoCommit = 0;
2727   my $dbh = dbh;
2728
2729   $self->select_for_update; #mutex
2730
2731   if ( $DEBUG ) {
2732     my $balance = $self->balance;
2733     warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2734   }
2735
2736   if ( exists($options{'retry_card'}) ) {
2737     carp 'retry_card option passed to collect is deprecated; use retry';
2738     $options{'retry'} ||= $options{'retry_card'};
2739   }
2740   if ( exists($options{'retry'}) && $options{'retry'} ) {
2741     my $error = $self->retry_realtime;
2742     if ( $error ) {
2743       $dbh->rollback if $oldAutoCommit;
2744       return $error;
2745     }
2746   }
2747
2748   # false laziness w/pay_batch::import_results
2749
2750   my $due_cust_event = $self->due_cust_event(
2751     'debug'      => ( $options{'debug'} || 0 ),
2752     'time'       => $invoice_time,
2753     'check_freq' => $options{'check_freq'},
2754   );
2755   unless( ref($due_cust_event) ) {
2756     $dbh->rollback if $oldAutoCommit;
2757     return $due_cust_event;
2758   }
2759
2760   foreach my $cust_event ( @$due_cust_event ) {
2761
2762     #XXX lock event
2763
2764     #re-eval event conditions (a previous event could have changed things)
2765     unless ( $cust_event->test_conditions( 'time' => $invoice_time ) ) {
2766       #don't leave stray "new/locked" records around
2767       my $error = $cust_event->delete;
2768       if ( $error ) {
2769         #gah, even with transactions
2770         $dbh->commit if $oldAutoCommit; #well.
2771         return $error;
2772       }
2773       next;
2774     }
2775
2776     {
2777       local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2778       warn "  running cust_event ". $cust_event->eventnum. "\n"
2779         if $DEBUG > 1;
2780
2781
2782       #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
2783       if ( my $error = $cust_event->do_event() ) {
2784         #XXX wtf is this?  figure out a proper dealio with return value
2785         #from do_event
2786           # gah, even with transactions.
2787           $dbh->commit if $oldAutoCommit; #well.
2788           return $error;
2789         }
2790     }
2791
2792   }
2793
2794   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2795   '';
2796
2797 }
2798
2799 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
2800
2801 Inserts database records for and returns an ordered listref of new events due
2802 for this customer, as FS::cust_event objects (see L<FS::cust_event>).  If no
2803 events are due, an empty listref is returned.  If there is an error, returns a
2804 scalar error message.
2805
2806 To actually run the events, call each event's test_condition method, and if
2807 still true, call the event's do_event method.
2808
2809 Options are passed as a hashref or as a list of name-value pairs.  Available
2810 options are:
2811
2812 =over 4
2813
2814 =item check_freq
2815
2816 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.
2817
2818 =item time
2819
2820 "Current time" for the events.
2821
2822 =item debug
2823
2824 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)
2825
2826 =item eventtable
2827
2828 Only return events for the specified eventtable (by default, events of all eventtables are returned)
2829
2830 =item objects
2831
2832 Explicitly pass the objects to be tested (typically used with eventtable).
2833
2834 =back
2835
2836 =cut
2837
2838 sub due_cust_event {
2839   my $self = shift;
2840   my %opt = ref($_[0]) ? %{ $_[0] } : @_;
2841
2842   #???
2843   #my $DEBUG = $opt{'debug'}
2844   local($DEBUG) = $opt{'debug'}
2845     if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
2846
2847   warn "$me due_cust_event called with options ".
2848        join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
2849     if $DEBUG;
2850
2851   $opt{'time'} ||= time;
2852
2853   local $SIG{HUP} = 'IGNORE';
2854   local $SIG{INT} = 'IGNORE';
2855   local $SIG{QUIT} = 'IGNORE';
2856   local $SIG{TERM} = 'IGNORE';
2857   local $SIG{TSTP} = 'IGNORE';
2858   local $SIG{PIPE} = 'IGNORE';
2859
2860   my $oldAutoCommit = $FS::UID::AutoCommit;
2861   local $FS::UID::AutoCommit = 0;
2862   my $dbh = dbh;
2863
2864   $self->select_for_update; #mutex
2865
2866   ###
2867   # 1: find possible events (initial search)
2868   ###
2869
2870   my @cust_event = ();
2871
2872   my @eventtable = $opt{'eventtable'}
2873                      ? ( $opt{'eventtable'} )
2874                      : FS::part_event->eventtables_runorder;
2875
2876   foreach my $eventtable ( @eventtable ) {
2877
2878     my @objects;
2879     if ( $opt{'objects'} ) {
2880
2881       @objects = @{ $opt{'objects'} };
2882
2883     } else {
2884
2885       #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
2886       @objects = ( $eventtable eq 'cust_main' )
2887                    ? ( $self )
2888                    : ( $self->$eventtable() );
2889
2890     }
2891
2892     my @e_cust_event = ();
2893
2894     my $cross = "CROSS JOIN $eventtable";
2895     $cross .= ' LEFT JOIN cust_main USING ( custnum )'
2896       unless $eventtable eq 'cust_main';
2897
2898     foreach my $object ( @objects ) {
2899
2900       #this first search uses the condition_sql magic for optimization.
2901       #the more possible events we can eliminate in this step the better
2902
2903       my $cross_where = '';
2904       my $pkey = $object->primary_key;
2905       $cross_where = "$eventtable.$pkey = ". $object->$pkey();
2906
2907       my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
2908       my $extra_sql =
2909         FS::part_event_condition->where_conditions_sql( $eventtable,
2910                                                         'time'=>$opt{'time'}
2911                                                       );
2912       my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
2913
2914       $extra_sql = "AND $extra_sql" if $extra_sql;
2915
2916       #here is the agent virtualization
2917       $extra_sql .= " AND (    part_event.agentnum IS NULL
2918                             OR part_event.agentnum = ". $self->agentnum. ' )';
2919
2920       $extra_sql .= " $order";
2921
2922       warn "searching for events for $eventtable ". $object->$pkey. "\n"
2923         if $opt{'debug'} > 2;
2924       my @part_event = qsearch( {
2925         'debug'     => ( $opt{'debug'} > 3 ? 1 : 0 ),
2926         'select'    => 'part_event.*',
2927         'table'     => 'part_event',
2928         'addl_from' => "$cross $join",
2929         'hashref'   => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
2930                          'eventtable' => $eventtable,
2931                          'disabled'   => '',
2932                        },
2933         'extra_sql' => "AND $cross_where $extra_sql",
2934       } );
2935
2936       if ( $DEBUG > 2 ) {
2937         my $pkey = $object->primary_key;
2938         warn "      ". scalar(@part_event).
2939              " possible events found for $eventtable ". $object->$pkey(). "\n";
2940       }
2941
2942       push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
2943
2944     }
2945
2946     warn "    ". scalar(@e_cust_event).
2947          " subtotal possible cust events found for $eventtable\n"
2948       if $DEBUG > 1;
2949
2950     push @cust_event, @e_cust_event;
2951
2952   }
2953
2954   warn "  ". scalar(@cust_event).
2955        " total possible cust events found in initial search\n"
2956     if $DEBUG; # > 1;
2957
2958   ##
2959   # 2: test conditions
2960   ##
2961
2962   my %unsat = ();
2963
2964   @cust_event = grep $_->test_conditions( 'time'          => $opt{'time'},
2965                                           'stats_hashref' => \%unsat ),
2966                      @cust_event;
2967
2968   warn "  ". scalar(@cust_event). " cust events left satisfying conditions\n"
2969     if $DEBUG; # > 1;
2970
2971   warn "    invalid conditions not eliminated with condition_sql:\n".
2972        join('', map "      $_: ".$unsat{$_}."\n", keys %unsat )
2973     if $DEBUG; # > 1;
2974
2975   ##
2976   # 3: insert
2977   ##
2978
2979   foreach my $cust_event ( @cust_event ) {
2980
2981     my $error = $cust_event->insert();
2982     if ( $error ) {
2983       $dbh->rollback if $oldAutoCommit;
2984       return $error;
2985     }
2986
2987   }
2988
2989   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2990
2991   ##
2992   # 4: return
2993   ##
2994
2995   warn "  returning events: ". Dumper(@cust_event). "\n"
2996     if $DEBUG > 2;
2997
2998   \@cust_event;
2999
3000 }
3001
3002 =item retry_realtime
3003
3004 Schedules realtime / batch  credit card / electronic check / LEC billing
3005 events for for retry.  Useful if card information has changed or manual
3006 retry is desired.  The 'collect' method must be called to actually retry
3007 the transaction.
3008
3009 Implementation details: For either this customer, or for each of this
3010 customer's open invoices, changes the status of the first "done" (with
3011 statustext error) realtime processing event to "failed".
3012
3013 =cut
3014
3015 sub retry_realtime {
3016   my $self = shift;
3017
3018   local $SIG{HUP} = 'IGNORE';
3019   local $SIG{INT} = 'IGNORE';
3020   local $SIG{QUIT} = 'IGNORE';
3021   local $SIG{TERM} = 'IGNORE';
3022   local $SIG{TSTP} = 'IGNORE';
3023   local $SIG{PIPE} = 'IGNORE';
3024
3025   my $oldAutoCommit = $FS::UID::AutoCommit;
3026   local $FS::UID::AutoCommit = 0;
3027   my $dbh = dbh;
3028
3029   #a little false laziness w/due_cust_event (not too bad, really)
3030
3031   my $join = FS::part_event_condition->join_conditions_sql;
3032   my $order = FS::part_event_condition->order_conditions_sql;
3033   my $mine =
3034   '( '
3035    . join ( ' OR ' , map {
3036     "( part_event.eventtable = " . dbh->quote($_)
3037     . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3038    } FS::part_event->eventtables)
3039    . ') ';
3040
3041   #here is the agent virtualization
3042   my $agent_virt = " (    part_event.agentnum IS NULL
3043                        OR part_event.agentnum = ". $self->agentnum. ' )';
3044
3045   #XXX this shouldn't be hardcoded, actions should declare it...
3046   my @realtime_events = qw(
3047     cust_bill_realtime_card
3048     cust_bill_realtime_check
3049     cust_bill_realtime_lec
3050     cust_bill_batch
3051   );
3052
3053   my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3054                                                   @realtime_events
3055                                      ).
3056                           ' ) ';
3057
3058   my @cust_event = qsearchs({
3059     'table'     => 'cust_event',
3060     'select'    => 'cust_event.*',
3061     'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3062     'hashref'   => { 'status' => 'done' },
3063     'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3064                    " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3065   });
3066
3067   my %seen_invnum = ();
3068   foreach my $cust_event (@cust_event) {
3069
3070     #max one for the customer, one for each open invoice
3071     my $cust_X = $cust_event->cust_X;
3072     next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3073                           ? $cust_X->invnum
3074                           : 0
3075                         }++
3076          or $cust_event->part_event->eventtable eq 'cust_bill'
3077             && ! $cust_X->owed;
3078
3079     my $error = $cust_event->retry;
3080     if ( $error ) {
3081       $dbh->rollback if $oldAutoCommit;
3082       return "error scheduling event for retry: $error";
3083     }
3084
3085   }
3086
3087   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3088   '';
3089
3090 }
3091
3092 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
3093
3094 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
3095 via a Business::OnlinePayment realtime gateway.  See
3096 L<http://420.am/business-onlinepayment> for supported gateways.
3097
3098 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3099
3100 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
3101
3102 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3103 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
3104 if set, will override the value from the customer record.
3105
3106 I<description> is a free-text field passed to the gateway.  It defaults to
3107 "Internet services".
3108
3109 If an I<invnum> is specified, this payment (if successful) is applied to the
3110 specified invoice.  If you don't specify an I<invnum> you might want to
3111 call the B<apply_payments> method.
3112
3113 I<quiet> can be set true to surpress email decline notices.
3114
3115 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
3116 resulting paynum, if any.
3117
3118 I<payunique> is a unique identifier for this payment.
3119
3120 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
3121
3122 =cut
3123
3124 sub realtime_bop {
3125   my( $self, $method, $amount, %options ) = @_;
3126   if ( $DEBUG ) {
3127     warn "$me realtime_bop: $method $amount\n";
3128     warn "  $_ => $options{$_}\n" foreach keys %options;
3129   }
3130
3131   $options{'description'} ||= 'Internet services';
3132
3133   return $self->fake_bop($method, $amount, %options) if $options{'fake'};
3134
3135   eval "use Business::OnlinePayment";
3136   die $@ if $@;
3137
3138   my $payinfo = exists($options{'payinfo'})
3139                   ? $options{'payinfo'}
3140                   : $self->payinfo;
3141
3142   my %method2payby = (
3143     'CC'     => 'CARD',
3144     'ECHECK' => 'CHEK',
3145     'LEC'    => 'LECB',
3146   );
3147
3148   ###
3149   # check for banned credit card/ACH
3150   ###
3151
3152   my $ban = qsearchs('banned_pay', {
3153     'payby'   => $method2payby{$method},
3154     'payinfo' => md5_base64($payinfo),
3155   } );
3156   return "Banned credit card" if $ban;
3157
3158   ###
3159   # select a gateway
3160   ###
3161
3162   my $taxclass = '';
3163   if ( $options{'invnum'} ) {
3164     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
3165     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
3166     my @taxclasses =
3167       map  { $_->part_pkg->taxclass }
3168       grep { $_ }
3169       map  { $_->cust_pkg }
3170       $cust_bill->cust_bill_pkg;
3171     unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
3172                                                            #different taxclasses
3173       $taxclass = $taxclasses[0];
3174     }
3175   }
3176
3177   #look for an agent gateway override first
3178   my $cardtype;
3179   if ( $method eq 'CC' ) {
3180     $cardtype = cardtype($payinfo);
3181   } elsif ( $method eq 'ECHECK' ) {
3182     $cardtype = 'ACH';
3183   } else {
3184     $cardtype = $method;
3185   }
3186
3187   my $override =
3188        qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3189                                            cardtype => $cardtype,
3190                                            taxclass => $taxclass,       } )
3191     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3192                                            cardtype => '',
3193                                            taxclass => $taxclass,       } )
3194     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3195                                            cardtype => $cardtype,
3196                                            taxclass => '',              } )
3197     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3198                                            cardtype => '',
3199                                            taxclass => '',              } );
3200
3201   my $payment_gateway = '';
3202   my( $processor, $login, $password, $action, @bop_options );
3203   if ( $override ) { #use a payment gateway override
3204
3205     $payment_gateway = $override->payment_gateway;
3206
3207     $processor   = $payment_gateway->gateway_module;
3208     $login       = $payment_gateway->gateway_username;
3209     $password    = $payment_gateway->gateway_password;
3210     $action      = $payment_gateway->gateway_action;
3211     @bop_options = $payment_gateway->options;
3212
3213   } else { #use the standard settings from the config
3214
3215     ( $processor, $login, $password, $action, @bop_options ) =
3216       $self->default_payment_gateway($method);
3217
3218   }
3219
3220   ###
3221   # massage data
3222   ###
3223
3224   my $address = exists($options{'address1'})
3225                     ? $options{'address1'}
3226                     : $self->address1;
3227   my $address2 = exists($options{'address2'})
3228                     ? $options{'address2'}
3229                     : $self->address2;
3230   $address .= ", ". $address2 if length($address2);
3231
3232   my $o_payname = exists($options{'payname'})
3233                     ? $options{'payname'}
3234                     : $self->payname;
3235   my($payname, $payfirst, $paylast);
3236   if ( $o_payname && $method ne 'ECHECK' ) {
3237     ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3238       or return "Illegal payname $payname";
3239     ($payfirst, $paylast) = ($1, $2);
3240   } else {
3241     $payfirst = $self->getfield('first');
3242     $paylast = $self->getfield('last');
3243     $payname =  "$payfirst $paylast";
3244   }
3245
3246   my @invoicing_list = $self->invoicing_list_emailonly;
3247   if ( $conf->exists('emailinvoiceautoalways')
3248        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3249        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3250     push @invoicing_list, $self->all_emails;
3251   }
3252
3253   my $email = ($conf->exists('business-onlinepayment-email-override'))
3254               ? $conf->config('business-onlinepayment-email-override')
3255               : $invoicing_list[0];
3256
3257   my %content = ();
3258
3259   my $payip = exists($options{'payip'})
3260                 ? $options{'payip'}
3261                 : $self->payip;
3262   $content{customer_ip} = $payip
3263     if length($payip);
3264
3265   $content{invoice_number} = $options{'invnum'}
3266     if exists($options{'invnum'}) && length($options{'invnum'});
3267
3268   $content{email_customer} =
3269     (    $conf->exists('business-onlinepayment-email_customer')
3270       || $conf->exists('business-onlinepayment-email-override') );
3271
3272   my $paydate = '';
3273   if ( $method eq 'CC' ) {
3274
3275     $content{card_number} = $payinfo;
3276     $paydate = exists($options{'paydate'})
3277                     ? $options{'paydate'}
3278                     : $self->paydate;
3279     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3280     $content{expiration} = "$2/$1";
3281
3282     my $paycvv = exists($options{'paycvv'})
3283                    ? $options{'paycvv'}
3284                    : $self->paycvv;
3285     $content{cvv2} = $paycvv
3286       if length($paycvv);
3287
3288     my $paystart_month = exists($options{'paystart_month'})
3289                            ? $options{'paystart_month'}
3290                            : $self->paystart_month;
3291
3292     my $paystart_year  = exists($options{'paystart_year'})
3293                            ? $options{'paystart_year'}
3294                            : $self->paystart_year;
3295
3296     $content{card_start} = "$paystart_month/$paystart_year"
3297       if $paystart_month && $paystart_year;
3298
3299     my $payissue       = exists($options{'payissue'})
3300                            ? $options{'payissue'}
3301                            : $self->payissue;
3302     $content{issue_number} = $payissue if $payissue;
3303
3304     $content{recurring_billing} = 'YES'
3305       if qsearch('cust_pay', { 'custnum' => $self->custnum,
3306                                'payby'   => 'CARD',
3307                                'payinfo' => $payinfo,
3308                              } )
3309       || qsearch('cust_pay', { 'custnum' => $self->custnum,
3310                                'payby'   => 'CARD',
3311                                'paymask' => $self->mask_payinfo('CARD', $payinfo),
3312                              } );
3313
3314
3315   } elsif ( $method eq 'ECHECK' ) {
3316     ( $content{account_number}, $content{routing_code} ) =
3317       split('@', $payinfo);
3318     $content{bank_name} = $o_payname;
3319     $content{bank_state} = exists($options{'paystate'})
3320                              ? $options{'paystate'}
3321                              : $self->getfield('paystate');
3322     $content{account_type} = exists($options{'paytype'})
3323                                ? uc($options{'paytype'}) || 'CHECKING'
3324                                : uc($self->getfield('paytype')) || 'CHECKING';
3325     $content{account_name} = $payname;
3326     $content{customer_org} = $self->company ? 'B' : 'I';
3327     $content{state_id}       = exists($options{'stateid'})
3328                                  ? $options{'stateid'}
3329                                  : $self->getfield('stateid');
3330     $content{state_id_state} = exists($options{'stateid_state'})
3331                                  ? $options{'stateid_state'}
3332                                  : $self->getfield('stateid_state');
3333     $content{customer_ssn} = exists($options{'ss'})
3334                                ? $options{'ss'}
3335                                : $self->ss;
3336   } elsif ( $method eq 'LEC' ) {
3337     $content{phone} = $payinfo;
3338   }
3339
3340   ###
3341   # run transaction(s)
3342   ###
3343
3344   my $balance = exists( $options{'balance'} )
3345                   ? $options{'balance'}
3346                   : $self->balance;
3347
3348   $self->select_for_update; #mutex ... just until we get our pending record in
3349
3350   #the checks here are intended to catch concurrent payments
3351   #double-form-submission prevention is taken care of in cust_pay_pending::check
3352
3353   #check the balance
3354   return "The customer's balance has changed; $method transaction aborted."
3355     if $self->balance < $balance;
3356     #&& $self->balance < $amount; #might as well anyway?
3357
3358   #also check and make sure there aren't *other* pending payments for this cust
3359
3360   my @pending = qsearch('cust_pay_pending', {
3361     'custnum' => $self->custnum,
3362     'status'  => { op=>'!=', value=>'done' }
3363   });
3364   return "A payment is already being processed for this customer (".
3365          join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
3366          "); $method transaction aborted."
3367     if scalar(@pending);
3368
3369   #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
3370
3371   my $cust_pay_pending = new FS::cust_pay_pending {
3372     'custnum'    => $self->custnum,
3373     #'invnum'     => $options{'invnum'},
3374     'paid'       => $amount,
3375     '_date'      => '',
3376     'payby'      => $method2payby{$method},
3377     'payinfo'    => $payinfo,
3378     'paydate'    => $paydate,
3379     'status'     => 'new',
3380     'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
3381   };
3382   $cust_pay_pending->payunique( $options{payunique} )
3383     if defined($options{payunique}) && length($options{payunique});
3384   my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
3385   return $cpp_new_err if $cpp_new_err;
3386
3387   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
3388
3389   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
3390   $transaction->content(
3391     'type'           => $method,
3392     'login'          => $login,
3393     'password'       => $password,
3394     'action'         => $action1,
3395     'description'    => $options{'description'},
3396     'amount'         => $amount,
3397     #'invoice_number' => $options{'invnum'},
3398     'customer_id'    => $self->custnum,
3399     'last_name'      => $paylast,
3400     'first_name'     => $payfirst,
3401     'name'           => $payname,
3402     'address'        => $address,
3403     'city'           => ( exists($options{'city'})
3404                             ? $options{'city'}
3405                             : $self->city          ),
3406     'state'          => ( exists($options{'state'})
3407                             ? $options{'state'}
3408                             : $self->state          ),
3409     'zip'            => ( exists($options{'zip'})
3410                             ? $options{'zip'}
3411                             : $self->zip          ),
3412     'country'        => ( exists($options{'country'})
3413                             ? $options{'country'}
3414                             : $self->country          ),
3415     'referer'        => 'http://cleanwhisker.420.am/',
3416     'email'          => $email,
3417     'phone'          => $self->daytime || $self->night,
3418     %content, #after
3419   );
3420
3421   $cust_pay_pending->status('pending');
3422   my $cpp_pending_err = $cust_pay_pending->replace;
3423   return $cpp_pending_err if $cpp_pending_err;
3424
3425   #config?
3426   my $BOP_TESTING = 0;
3427   my $BOP_TESTING_SUCCESS = 1;
3428
3429   unless ( $BOP_TESTING ) {
3430     $transaction->submit();
3431   } else {
3432     if ( $BOP_TESTING_SUCCESS ) {
3433       $transaction->is_success(1);
3434       $transaction->authorization('fake auth');
3435     } else {
3436       $transaction->is_success(0);
3437       $transaction->error_message('fake failure');
3438     }
3439   }
3440
3441   if ( $transaction->is_success() && $action2 ) {
3442
3443     $cust_pay_pending->status('authorized');
3444     my $cpp_authorized_err = $cust_pay_pending->replace;
3445     return $cpp_authorized_err if $cpp_authorized_err;
3446
3447     my $auth = $transaction->authorization;
3448     my $ordernum = $transaction->can('order_number')
3449                    ? $transaction->order_number
3450                    : '';
3451
3452     my $capture =
3453       new Business::OnlinePayment( $processor, @bop_options );
3454
3455     my %capture = (
3456       %content,
3457       type           => $method,
3458       action         => $action2,
3459       login          => $login,
3460       password       => $password,
3461       order_number   => $ordernum,
3462       amount         => $amount,
3463       authorization  => $auth,
3464       description    => $options{'description'},
3465     );
3466
3467     foreach my $field (qw( authorization_source_code returned_ACI
3468                            transaction_identifier validation_code
3469                            transaction_sequence_num local_transaction_date
3470                            local_transaction_time AVS_result_code          )) {
3471       $capture{$field} = $transaction->$field() if $transaction->can($field);
3472     }
3473
3474     $capture->content( %capture );
3475
3476     $capture->submit();
3477
3478     unless ( $capture->is_success ) {
3479       my $e = "Authorization successful but capture failed, custnum #".
3480               $self->custnum. ': '.  $capture->result_code.
3481               ": ". $capture->error_message;
3482       warn $e;
3483       return $e;
3484     }
3485
3486   }
3487
3488   $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
3489   my $cpp_captured_err = $cust_pay_pending->replace;
3490   return $cpp_captured_err if $cpp_captured_err;
3491
3492   ###
3493   # remove paycvv after initial transaction
3494   ###
3495
3496   #false laziness w/misc/process/payment.cgi - check both to make sure working
3497   # correctly
3498   if ( defined $self->dbdef_table->column('paycvv')
3499        && length($self->paycvv)
3500        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
3501   ) {
3502     my $error = $self->remove_cvv;
3503     if ( $error ) {
3504       warn "WARNING: error removing cvv: $error\n";
3505     }
3506   }
3507
3508   ###
3509   # result handling
3510   ###
3511
3512   if ( $transaction->is_success() ) {
3513
3514     my $paybatch = '';
3515     if ( $payment_gateway ) { # agent override
3516       $paybatch = $payment_gateway->gatewaynum. '-';
3517     }
3518
3519     $paybatch .= "$processor:". $transaction->authorization;
3520
3521     $paybatch .= ':'. $transaction->order_number
3522       if $transaction->can('order_number')
3523       && length($transaction->order_number);
3524
3525     my $cust_pay = new FS::cust_pay ( {
3526        'custnum'  => $self->custnum,
3527        'invnum'   => $options{'invnum'},
3528        'paid'     => $amount,
3529        '_date'    => '',
3530        'payby'    => $method2payby{$method},
3531        'payinfo'  => $payinfo,
3532        'paybatch' => $paybatch,
3533        'paydate'  => $paydate,
3534     } );
3535     #doesn't hurt to know, even though the dup check is in cust_pay_pending now
3536     $cust_pay->payunique( $options{payunique} )
3537       if defined($options{payunique}) && length($options{payunique});
3538
3539     my $oldAutoCommit = $FS::UID::AutoCommit;
3540     local $FS::UID::AutoCommit = 0;
3541     my $dbh = dbh;
3542
3543     #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
3544
3545     my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3546
3547     if ( $error ) {
3548       $cust_pay->invnum(''); #try again with no specific invnum
3549       my $error2 = $cust_pay->insert( $options{'manual'} ?
3550                                       ( 'manual' => 1 ) : ()
3551                                     );
3552       if ( $error2 ) {
3553         # gah.  but at least we have a record of the state we had to abort in
3554         # from cust_pay_pending now.
3555         my $e = "WARNING: $method captured but payment not recorded - ".
3556                 "error inserting payment ($processor): $error2".
3557                 " (previously tried insert with invnum #$options{'invnum'}" .
3558                 ": $error ) - pending payment saved as paypendingnum ".
3559                 $cust_pay_pending->paypendingnum. "\n";
3560         warn $e;
3561         return $e;
3562       }
3563     }
3564
3565     if ( $options{'paynum_ref'} ) {
3566       ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3567     }
3568
3569     $cust_pay_pending->status('done');
3570     $cust_pay_pending->statustext('captured');
3571     my $cpp_done_err = $cust_pay_pending->replace;
3572
3573     if ( $cpp_done_err ) {
3574
3575       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
3576       my $e = "WARNING: $method captured but payment not recorded - ".
3577               "error updating status for paypendingnum ".
3578               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3579       warn $e;
3580       return $e;
3581
3582     } else {
3583
3584       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3585       return ''; #no error
3586
3587     }
3588
3589   } else {
3590
3591     my $perror = "$processor error: ". $transaction->error_message;
3592
3593     unless ( $transaction->error_message ) {
3594
3595       my $t_response;
3596       if ( $transaction->can('response_page') ) {
3597         $t_response = {
3598                         'page'    => ( $transaction->can('response_page')
3599                                          ? $transaction->response_page
3600                                          : ''
3601                                      ),
3602                         'code'    => ( $transaction->can('response_code')
3603                                          ? $transaction->response_code
3604                                          : ''
3605                                      ),
3606                         'headers' => ( $transaction->can('response_headers')
3607                                          ? $transaction->response_headers
3608                                          : ''
3609                                      ),
3610                       };
3611       } else {
3612         $t_response .=
3613           "No additional debugging information available for $processor";
3614       }
3615
3616       $perror .= "No error_message returned from $processor -- ".
3617                  ( ref($t_response) ? Dumper($t_response) : $t_response );
3618
3619     }
3620
3621     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
3622          && $conf->exists('emaildecline')
3623          && grep { $_ ne 'POST' } $self->invoicing_list
3624          && ! grep { $transaction->error_message =~ /$_/ }
3625                    $conf->config('emaildecline-exclude')
3626     ) {
3627       my @templ = $conf->config('declinetemplate');
3628       my $template = new Text::Template (
3629         TYPE   => 'ARRAY',
3630         SOURCE => [ map "$_\n", @templ ],
3631       ) or return "($perror) can't create template: $Text::Template::ERROR";
3632       $template->compile()
3633         or return "($perror) can't compile template: $Text::Template::ERROR";
3634
3635       my $templ_hash = { error => $transaction->error_message };
3636
3637       my $error = send_email(
3638         'from'    => $conf->config('invoice_from'),
3639         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
3640         'subject' => 'Your payment could not be processed',
3641         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
3642       );
3643
3644       $perror .= " (also received error sending decline notification: $error)"
3645         if $error;
3646
3647     }
3648
3649     $cust_pay_pending->status('done');
3650     $cust_pay_pending->statustext("declined: $perror");
3651     my $cpp_done_err = $cust_pay_pending->replace;
3652     if ( $cpp_done_err ) {
3653       my $e = "WARNING: $method declined but pending payment not resolved - ".
3654               "error updating status for paypendingnum ".
3655               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3656       warn $e;
3657       $perror = "$e ($perror)";
3658     }
3659
3660     return $perror;
3661   }
3662
3663 }
3664
3665 =item fake_bop
3666
3667 =cut
3668
3669 sub fake_bop {
3670   my( $self, $method, $amount, %options ) = @_;
3671
3672   if ( $options{'fake_failure'} ) {
3673      return "Error: No error; test failure requested with fake_failure";
3674   }
3675
3676   my %method2payby = (
3677     'CC'     => 'CARD',
3678     'ECHECK' => 'CHEK',
3679     'LEC'    => 'LECB',
3680   );
3681
3682   #my $paybatch = '';
3683   #if ( $payment_gateway ) { # agent override
3684   #  $paybatch = $payment_gateway->gatewaynum. '-';
3685   #}
3686   #
3687   #$paybatch .= "$processor:". $transaction->authorization;
3688   #
3689   #$paybatch .= ':'. $transaction->order_number
3690   #  if $transaction->can('order_number')
3691   #  && length($transaction->order_number);
3692
3693   my $paybatch = 'FakeProcessor:54:32';
3694
3695   my $cust_pay = new FS::cust_pay ( {
3696      'custnum'  => $self->custnum,
3697      'invnum'   => $options{'invnum'},
3698      'paid'     => $amount,
3699      '_date'    => '',
3700      'payby'    => $method2payby{$method},
3701      #'payinfo'  => $payinfo,
3702      'payinfo'  => '4111111111111111',
3703      'paybatch' => $paybatch,
3704      #'paydate'  => $paydate,
3705      'paydate'  => '2012-05-01',
3706   } );
3707   $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
3708
3709   my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3710
3711   if ( $error ) {
3712     $cust_pay->invnum(''); #try again with no specific invnum
3713     my $error2 = $cust_pay->insert( $options{'manual'} ?
3714                                     ( 'manual' => 1 ) : ()
3715                                   );
3716     if ( $error2 ) {
3717       # gah, even with transactions.
3718       my $e = 'WARNING: Card/ACH debited but database not updated - '.
3719               "error inserting (fake!) payment: $error2".
3720               " (previously tried insert with invnum #$options{'invnum'}" .
3721               ": $error )";
3722       warn $e;
3723       return $e;
3724     }
3725   }
3726
3727   if ( $options{'paynum_ref'} ) {
3728     ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3729   }
3730
3731   return ''; #no error
3732
3733 }
3734
3735 =item default_payment_gateway
3736
3737 =cut
3738
3739 sub default_payment_gateway {
3740   my( $self, $method ) = @_;
3741
3742   die "Real-time processing not enabled\n"
3743     unless $conf->exists('business-onlinepayment');
3744
3745   #load up config
3746   my $bop_config = 'business-onlinepayment';
3747   $bop_config .= '-ach'
3748     if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
3749   my ( $processor, $login, $password, $action, @bop_options ) =
3750     $conf->config($bop_config);
3751   $action ||= 'normal authorization';
3752   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
3753   die "No real-time processor is enabled - ".
3754       "did you set the business-onlinepayment configuration value?\n"
3755     unless $processor;
3756
3757   ( $processor, $login, $password, $action, @bop_options )
3758 }
3759
3760 =item remove_cvv
3761
3762 Removes the I<paycvv> field from the database directly.
3763
3764 If there is an error, returns the error, otherwise returns false.
3765
3766 =cut
3767
3768 sub remove_cvv {
3769   my $self = shift;
3770   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
3771     or return dbh->errstr;
3772   $sth->execute($self->custnum)
3773     or return $sth->errstr;
3774   $self->paycvv('');
3775   '';
3776 }
3777
3778 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
3779
3780 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
3781 via a Business::OnlinePayment realtime gateway.  See
3782 L<http://420.am/business-onlinepayment> for supported gateways.
3783
3784 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3785
3786 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
3787
3788 Most gateways require a reference to an original payment transaction to refund,
3789 so you probably need to specify a I<paynum>.
3790
3791 I<amount> defaults to the original amount of the payment if not specified.
3792
3793 I<reason> specifies a reason for the refund.
3794
3795 I<paydate> specifies the expiration date for a credit card overriding the
3796 value from the customer record or the payment record. Specified as yyyy-mm-dd
3797
3798 Implementation note: If I<amount> is unspecified or equal to the amount of the
3799 orignal payment, first an attempt is made to "void" the transaction via
3800 the gateway (to cancel a not-yet settled transaction) and then if that fails,
3801 the normal attempt is made to "refund" ("credit") the transaction via the
3802 gateway is attempted.
3803
3804 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3805 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
3806 #if set, will override the value from the customer record.
3807
3808 #If an I<invnum> is specified, this payment (if successful) is applied to the
3809 #specified invoice.  If you don't specify an I<invnum> you might want to
3810 #call the B<apply_payments> method.
3811
3812 =cut
3813
3814 #some false laziness w/realtime_bop, not enough to make it worth merging
3815 #but some useful small subs should be pulled out
3816 sub realtime_refund_bop {
3817   my( $self, $method, %options ) = @_;
3818   if ( $DEBUG ) {
3819     warn "$me realtime_refund_bop: $method refund\n";
3820     warn "  $_ => $options{$_}\n" foreach keys %options;
3821   }
3822
3823   eval "use Business::OnlinePayment";
3824   die $@ if $@;
3825
3826   ###
3827   # look up the original payment and optionally a gateway for that payment
3828   ###
3829
3830   my $cust_pay = '';
3831   my $amount = $options{'amount'};
3832
3833   my( $processor, $login, $password, @bop_options ) ;
3834   my( $auth, $order_number ) = ( '', '', '' );
3835
3836   if ( $options{'paynum'} ) {
3837
3838     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
3839     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
3840       or return "Unknown paynum $options{'paynum'}";
3841     $amount ||= $cust_pay->paid;
3842
3843     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
3844       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
3845                 $cust_pay->paybatch;
3846     my $gatewaynum = '';
3847     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
3848
3849     if ( $gatewaynum ) { #gateway for the payment to be refunded
3850
3851       my $payment_gateway =
3852         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
3853       die "payment gateway $gatewaynum not found"
3854         unless $payment_gateway;
3855
3856       $processor   = $payment_gateway->gateway_module;
3857       $login       = $payment_gateway->gateway_username;
3858       $password    = $payment_gateway->gateway_password;
3859       @bop_options = $payment_gateway->options;
3860
3861     } else { #try the default gateway
3862
3863       my( $conf_processor, $unused_action );
3864       ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
3865         $self->default_payment_gateway($method);
3866
3867       return "processor of payment $options{'paynum'} $processor does not".
3868              " match default processor $conf_processor"
3869         unless $processor eq $conf_processor;
3870
3871     }
3872
3873
3874   } else { # didn't specify a paynum, so look for agent gateway overrides
3875            # like a normal transaction
3876
3877     my $cardtype;
3878     if ( $method eq 'CC' ) {
3879       $cardtype = cardtype($self->payinfo);
3880     } elsif ( $method eq 'ECHECK' ) {
3881       $cardtype = 'ACH';
3882     } else {
3883       $cardtype = $method;
3884     }
3885     my $override =
3886            qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3887                                                cardtype => $cardtype,
3888                                                taxclass => '',              } )
3889         || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3890                                                cardtype => '',
3891                                                taxclass => '',              } );
3892
3893     if ( $override ) { #use a payment gateway override
3894
3895       my $payment_gateway = $override->payment_gateway;
3896
3897       $processor   = $payment_gateway->gateway_module;
3898       $login       = $payment_gateway->gateway_username;
3899       $password    = $payment_gateway->gateway_password;
3900       #$action      = $payment_gateway->gateway_action;
3901       @bop_options = $payment_gateway->options;
3902
3903     } else { #use the standard settings from the config
3904
3905       my $unused_action;
3906       ( $processor, $login, $password, $unused_action, @bop_options ) =
3907         $self->default_payment_gateway($method);
3908
3909     }
3910
3911   }
3912   return "neither amount nor paynum specified" unless $amount;
3913
3914   my %content = (
3915     'type'           => $method,
3916     'login'          => $login,
3917     'password'       => $password,
3918     'order_number'   => $order_number,
3919     'amount'         => $amount,
3920     'referer'        => 'http://cleanwhisker.420.am/',
3921   );
3922   $content{authorization} = $auth
3923     if length($auth); #echeck/ACH transactions have an order # but no auth
3924                       #(at least with authorize.net)
3925
3926   my $disable_void_after;
3927   if ($conf->exists('disable_void_after')
3928       && $conf->config('disable_void_after') =~ /^(\d+)$/) {
3929     $disable_void_after = $1;
3930   }
3931
3932   #first try void if applicable
3933   if ( $cust_pay && $cust_pay->paid == $amount
3934     && (
3935       ( not defined($disable_void_after) )
3936       || ( time < ($cust_pay->_date + $disable_void_after ) )
3937     )
3938   ) {
3939     warn "  attempting void\n" if $DEBUG > 1;
3940     my $void = new Business::OnlinePayment( $processor, @bop_options );
3941     $void->content( 'action' => 'void', %content );
3942     $void->submit();
3943     if ( $void->is_success ) {
3944       my $error = $cust_pay->void($options{'reason'});
3945       if ( $error ) {
3946         # gah, even with transactions.
3947         my $e = 'WARNING: Card/ACH voided but database not updated - '.
3948                 "error voiding payment: $error";
3949         warn $e;
3950         return $e;
3951       }
3952       warn "  void successful\n" if $DEBUG > 1;
3953       return '';
3954     }
3955   }
3956
3957   warn "  void unsuccessful, trying refund\n"
3958     if $DEBUG > 1;
3959
3960   #massage data
3961   my $address = $self->address1;
3962   $address .= ", ". $self->address2 if $self->address2;
3963
3964   my($payname, $payfirst, $paylast);
3965   if ( $self->payname && $method ne 'ECHECK' ) {
3966     $payname = $self->payname;
3967     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3968       or return "Illegal payname $payname";
3969     ($payfirst, $paylast) = ($1, $2);
3970   } else {
3971     $payfirst = $self->getfield('first');
3972     $paylast = $self->getfield('last');
3973     $payname =  "$payfirst $paylast";
3974   }
3975
3976   my @invoicing_list = $self->invoicing_list_emailonly;
3977   if ( $conf->exists('emailinvoiceautoalways')
3978        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3979        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3980     push @invoicing_list, $self->all_emails;
3981   }
3982
3983   my $email = ($conf->exists('business-onlinepayment-email-override'))
3984               ? $conf->config('business-onlinepayment-email-override')
3985               : $invoicing_list[0];
3986
3987   my $payip = exists($options{'payip'})
3988                 ? $options{'payip'}
3989                 : $self->payip;
3990   $content{customer_ip} = $payip
3991     if length($payip);
3992
3993   my $payinfo = '';
3994   if ( $method eq 'CC' ) {
3995
3996     if ( $cust_pay ) {
3997       $content{card_number} = $payinfo = $cust_pay->payinfo;
3998       (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
3999         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4000         ($content{expiration} = "$2/$1");  # where available
4001     } else {
4002       $content{card_number} = $payinfo = $self->payinfo;
4003       (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4004         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4005       $content{expiration} = "$2/$1";
4006     }
4007
4008   } elsif ( $method eq 'ECHECK' ) {
4009
4010     if ( $cust_pay ) {
4011       $payinfo = $cust_pay->payinfo;
4012     } else {
4013       $payinfo = $self->payinfo;
4014     }
4015     ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4016     $content{bank_name} = $self->payname;
4017     $content{account_type} = 'CHECKING';
4018     $content{account_name} = $payname;
4019     $content{customer_org} = $self->company ? 'B' : 'I';
4020     $content{customer_ssn} = $self->ss;
4021   } elsif ( $method eq 'LEC' ) {
4022     $content{phone} = $payinfo = $self->payinfo;
4023   }
4024
4025   #then try refund
4026   my $refund = new Business::OnlinePayment( $processor, @bop_options );
4027   my %sub_content = $refund->content(
4028     'action'         => 'credit',
4029     'customer_id'    => $self->custnum,
4030     'last_name'      => $paylast,
4031     'first_name'     => $payfirst,
4032     'name'           => $payname,
4033     'address'        => $address,
4034     'city'           => $self->city,
4035     'state'          => $self->state,
4036     'zip'            => $self->zip,
4037     'country'        => $self->country,
4038     'email'          => $email,
4039     'phone'          => $self->daytime || $self->night,
4040     %content, #after
4041   );
4042   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
4043     if $DEBUG > 1;
4044   $refund->submit();
4045
4046   return "$processor error: ". $refund->error_message
4047     unless $refund->is_success();
4048
4049   my %method2payby = (
4050     'CC'     => 'CARD',
4051     'ECHECK' => 'CHEK',
4052     'LEC'    => 'LECB',
4053   );
4054
4055   my $paybatch = "$processor:". $refund->authorization;
4056   $paybatch .= ':'. $refund->order_number
4057     if $refund->can('order_number') && $refund->order_number;
4058
4059   while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4060     my @cust_bill_pay = $cust_pay->cust_bill_pay;
4061     last unless @cust_bill_pay;
4062     my $cust_bill_pay = pop @cust_bill_pay;
4063     my $error = $cust_bill_pay->delete;
4064     last if $error;
4065   }
4066
4067   my $cust_refund = new FS::cust_refund ( {
4068     'custnum'  => $self->custnum,
4069     'paynum'   => $options{'paynum'},
4070     'refund'   => $amount,
4071     '_date'    => '',
4072     'payby'    => $method2payby{$method},
4073     'payinfo'  => $payinfo,
4074     'paybatch' => $paybatch,
4075     'reason'   => $options{'reason'} || 'card or ACH refund',
4076   } );
4077   my $error = $cust_refund->insert;
4078   if ( $error ) {
4079     $cust_refund->paynum(''); #try again with no specific paynum
4080     my $error2 = $cust_refund->insert;
4081     if ( $error2 ) {
4082       # gah, even with transactions.
4083       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4084               "error inserting refund ($processor): $error2".
4085               " (previously tried insert with paynum #$options{'paynum'}" .
4086               ": $error )";
4087       warn $e;
4088       return $e;
4089     }
4090   }
4091
4092   ''; #no error
4093
4094 }
4095
4096 =item batch_card OPTION => VALUE...
4097
4098 Adds a payment for this invoice to the pending credit card batch (see
4099 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
4100 runs the payment using a realtime gateway.
4101
4102 =cut
4103
4104 sub batch_card {
4105   my ($self, %options) = @_;
4106
4107   my $amount;
4108   if (exists($options{amount})) {
4109     $amount = $options{amount};
4110   }else{
4111     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
4112   }
4113   return '' unless $amount > 0;
4114
4115   my $invnum = delete $options{invnum};
4116   my $payby = $options{invnum} || $self->payby;  #dubious
4117
4118   if ($options{'realtime'}) {
4119     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
4120                                 $amount,
4121                                 %options,
4122                               );
4123   }
4124
4125   my $oldAutoCommit = $FS::UID::AutoCommit;
4126   local $FS::UID::AutoCommit = 0;
4127   my $dbh = dbh;
4128
4129   #this needs to handle mysql as well as Pg, like svc_acct.pm
4130   #(make it into a common function if folks need to do batching with mysql)
4131   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
4132     or return "Cannot lock pay_batch: " . $dbh->errstr;
4133
4134   my %pay_batch = (
4135     'status' => 'O',
4136     'payby'  => FS::payby->payby2payment($payby),
4137   );
4138
4139   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
4140
4141   unless ( $pay_batch ) {
4142     $pay_batch = new FS::pay_batch \%pay_batch;
4143     my $error = $pay_batch->insert;
4144     if ( $error ) {
4145       $dbh->rollback if $oldAutoCommit;
4146       die "error creating new batch: $error\n";
4147     }
4148   }
4149
4150   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
4151       'batchnum' => $pay_batch->batchnum,
4152       'custnum'  => $self->custnum,
4153   } );
4154
4155   foreach (qw( address1 address2 city state zip country payby payinfo paydate
4156                payname )) {
4157     $options{$_} = '' unless exists($options{$_});
4158   }
4159
4160   my $cust_pay_batch = new FS::cust_pay_batch ( {
4161     'batchnum' => $pay_batch->batchnum,
4162     'invnum'   => $invnum || 0,                    # is there a better value?
4163                                                    # this field should be
4164                                                    # removed...
4165                                                    # cust_bill_pay_batch now
4166     'custnum'  => $self->custnum,
4167     'last'     => $self->getfield('last'),
4168     'first'    => $self->getfield('first'),
4169     'address1' => $options{address1} || $self->address1,
4170     'address2' => $options{address2} || $self->address2,
4171     'city'     => $options{city}     || $self->city,
4172     'state'    => $options{state}    || $self->state,
4173     'zip'      => $options{zip}      || $self->zip,
4174     'country'  => $options{country}  || $self->country,
4175     'payby'    => $options{payby}    || $self->payby,
4176     'payinfo'  => $options{payinfo}  || $self->payinfo,
4177     'exp'      => $options{paydate}  || $self->paydate,
4178     'payname'  => $options{payname}  || $self->payname,
4179     'amount'   => $amount,                         # consolidating
4180   } );
4181
4182   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
4183     if $old_cust_pay_batch;
4184
4185   my $error;
4186   if ($old_cust_pay_batch) {
4187     $error = $cust_pay_batch->replace($old_cust_pay_batch)
4188   } else {
4189     $error = $cust_pay_batch->insert;
4190   }
4191
4192   if ( $error ) {
4193     $dbh->rollback if $oldAutoCommit;
4194     die $error;
4195   }
4196
4197   my $unapplied = $self->total_credited + $self->total_unapplied_payments + $self->in_transit_payments;
4198   foreach my $cust_bill ($self->open_cust_bill) {
4199     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
4200     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
4201       'invnum' => $cust_bill->invnum,
4202       'paybatchnum' => $cust_pay_batch->paybatchnum,
4203       'amount' => $cust_bill->owed,
4204       '_date' => time,
4205     };
4206     if ($unapplied >= $cust_bill_pay_batch->amount){
4207       $unapplied -= $cust_bill_pay_batch->amount;
4208       next;
4209     }else{
4210       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
4211                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
4212     }
4213     $error = $cust_bill_pay_batch->insert;
4214     if ( $error ) {
4215       $dbh->rollback if $oldAutoCommit;
4216       die $error;
4217     }
4218   }
4219
4220   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4221   '';
4222 }
4223
4224 =item total_owed
4225
4226 Returns the total owed for this customer on all invoices
4227 (see L<FS::cust_bill/owed>).
4228
4229 =cut
4230
4231 sub total_owed {
4232   my $self = shift;
4233   $self->total_owed_date(2145859200); #12/31/2037
4234 }
4235
4236 =item total_owed_date TIME
4237
4238 Returns the total owed for this customer on all invoices with date earlier than
4239 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
4240 see L<Time::Local> and L<Date::Parse> for conversion functions.
4241
4242 =cut
4243
4244 sub total_owed_date {
4245   my $self = shift;
4246   my $time = shift;
4247   my $total_bill = 0;
4248   foreach my $cust_bill (
4249     grep { $_->_date <= $time }
4250       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4251   ) {
4252     $total_bill += $cust_bill->owed;
4253   }
4254   sprintf( "%.2f", $total_bill );
4255 }
4256
4257 =item apply_payments_and_credits
4258
4259 Applies unapplied payments and credits.
4260
4261 In most cases, this new method should be used in place of sequential
4262 apply_payments and apply_credits methods.
4263
4264 If there is an error, returns the error, otherwise returns false.
4265
4266 =cut
4267
4268 sub apply_payments_and_credits {
4269   my $self = shift;
4270
4271   local $SIG{HUP} = 'IGNORE';
4272   local $SIG{INT} = 'IGNORE';
4273   local $SIG{QUIT} = 'IGNORE';
4274   local $SIG{TERM} = 'IGNORE';
4275   local $SIG{TSTP} = 'IGNORE';
4276   local $SIG{PIPE} = 'IGNORE';
4277
4278   my $oldAutoCommit = $FS::UID::AutoCommit;
4279   local $FS::UID::AutoCommit = 0;
4280   my $dbh = dbh;
4281
4282   $self->select_for_update; #mutex
4283
4284   foreach my $cust_bill ( $self->open_cust_bill ) {
4285     my $error = $cust_bill->apply_payments_and_credits;
4286     if ( $error ) {
4287       $dbh->rollback if $oldAutoCommit;
4288       return "Error applying: $error";
4289     }
4290   }
4291
4292   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4293   ''; #no error
4294
4295 }
4296
4297 =item apply_credits OPTION => VALUE ...
4298
4299 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
4300 to outstanding invoice balances in chronological order (or reverse
4301 chronological order if the I<order> option is set to B<newest>) and returns the
4302 value of any remaining unapplied credits available for refund (see
4303 L<FS::cust_refund>).
4304
4305 Dies if there is an error.
4306
4307 =cut
4308
4309 sub apply_credits {
4310   my $self = shift;
4311   my %opt = @_;
4312
4313   local $SIG{HUP} = 'IGNORE';
4314   local $SIG{INT} = 'IGNORE';
4315   local $SIG{QUIT} = 'IGNORE';
4316   local $SIG{TERM} = 'IGNORE';
4317   local $SIG{TSTP} = 'IGNORE';
4318   local $SIG{PIPE} = 'IGNORE';
4319
4320   my $oldAutoCommit = $FS::UID::AutoCommit;
4321   local $FS::UID::AutoCommit = 0;
4322   my $dbh = dbh;
4323
4324   $self->select_for_update; #mutex
4325
4326   unless ( $self->total_credited ) {
4327     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4328     return 0;
4329   }
4330
4331   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
4332       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
4333
4334   my @invoices = $self->open_cust_bill;
4335   @invoices = sort { $b->_date <=> $a->_date } @invoices
4336     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
4337
4338   my $credit;
4339   foreach my $cust_bill ( @invoices ) {
4340     my $amount;
4341
4342     if ( !defined($credit) || $credit->credited == 0) {
4343       $credit = pop @credits or last;
4344     }
4345
4346     if ($cust_bill->owed >= $credit->credited) {
4347       $amount=$credit->credited;
4348     }else{
4349       $amount=$cust_bill->owed;
4350     }
4351
4352     my $cust_credit_bill = new FS::cust_credit_bill ( {
4353       'crednum' => $credit->crednum,
4354       'invnum'  => $cust_bill->invnum,
4355       'amount'  => $amount,
4356     } );
4357     my $error = $cust_credit_bill->insert;
4358     if ( $error ) {
4359       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4360       die $error;
4361     }
4362
4363     redo if ($cust_bill->owed > 0);
4364
4365   }
4366
4367   my $total_credited = $self->total_credited;
4368
4369   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4370
4371   return $total_credited;
4372 }
4373
4374 =item apply_payments
4375
4376 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
4377 to outstanding invoice balances in chronological order.
4378
4379  #and returns the value of any remaining unapplied payments.
4380
4381 Dies if there is an error.
4382
4383 =cut
4384
4385 sub apply_payments {
4386   my $self = shift;
4387
4388   local $SIG{HUP} = 'IGNORE';
4389   local $SIG{INT} = 'IGNORE';
4390   local $SIG{QUIT} = 'IGNORE';
4391   local $SIG{TERM} = 'IGNORE';
4392   local $SIG{TSTP} = 'IGNORE';
4393   local $SIG{PIPE} = 'IGNORE';
4394
4395   my $oldAutoCommit = $FS::UID::AutoCommit;
4396   local $FS::UID::AutoCommit = 0;
4397   my $dbh = dbh;
4398
4399   $self->select_for_update; #mutex
4400
4401   #return 0 unless
4402
4403   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
4404       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
4405
4406   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
4407       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
4408
4409   my $payment;
4410
4411   foreach my $cust_bill ( @invoices ) {
4412     my $amount;
4413
4414     if ( !defined($payment) || $payment->unapplied == 0 ) {
4415       $payment = pop @payments or last;
4416     }
4417
4418     if ( $cust_bill->owed >= $payment->unapplied ) {
4419       $amount = $payment->unapplied;
4420     } else {
4421       $amount = $cust_bill->owed;
4422     }
4423
4424     my $cust_bill_pay = new FS::cust_bill_pay ( {
4425       'paynum' => $payment->paynum,
4426       'invnum' => $cust_bill->invnum,
4427       'amount' => $amount,
4428     } );
4429     my $error = $cust_bill_pay->insert;
4430     if ( $error ) {
4431       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4432       die $error;
4433     }
4434
4435     redo if ( $cust_bill->owed > 0);
4436
4437   }
4438
4439   my $total_unapplied_payments = $self->total_unapplied_payments;
4440
4441   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4442
4443   return $total_unapplied_payments;
4444 }
4445
4446 =item total_credited
4447
4448 Returns the total outstanding credit (see L<FS::cust_credit>) for this
4449 customer.  See L<FS::cust_credit/credited>.
4450
4451 =cut
4452
4453 sub total_credited {
4454   my $self = shift;
4455   my $total_credit = 0;
4456   foreach my $cust_credit ( qsearch('cust_credit', {
4457     'custnum' => $self->custnum,
4458   } ) ) {
4459     $total_credit += $cust_credit->credited;
4460   }
4461   sprintf( "%.2f", $total_credit );
4462 }
4463
4464 =item total_unapplied_payments
4465
4466 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
4467 See L<FS::cust_pay/unapplied>.
4468
4469 =cut
4470
4471 sub total_unapplied_payments {
4472   my $self = shift;
4473   my $total_unapplied = 0;
4474   foreach my $cust_pay ( qsearch('cust_pay', {
4475     'custnum' => $self->custnum,
4476   } ) ) {
4477     $total_unapplied += $cust_pay->unapplied;
4478   }
4479   sprintf( "%.2f", $total_unapplied );
4480 }
4481
4482 =item total_unapplied_refunds
4483
4484 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
4485 customer.  See L<FS::cust_refund/unapplied>.
4486
4487 =cut
4488
4489 sub total_unapplied_refunds {
4490   my $self = shift;
4491   my $total_unapplied = 0;
4492   foreach my $cust_refund ( qsearch('cust_refund', {
4493     'custnum' => $self->custnum,
4494   } ) ) {
4495     $total_unapplied += $cust_refund->unapplied;
4496   }
4497   sprintf( "%.2f", $total_unapplied );
4498 }
4499
4500 =item balance
4501
4502 Returns the balance for this customer (total_owed plus total_unrefunded, minus
4503 total_credited minus total_unapplied_payments).
4504
4505 =cut
4506
4507 sub balance {
4508   my $self = shift;
4509   sprintf( "%.2f",
4510       $self->total_owed
4511     + $self->total_unapplied_refunds
4512     - $self->total_credited
4513     - $self->total_unapplied_payments
4514   );
4515 }
4516
4517 =item balance_date TIME
4518
4519 Returns the balance for this customer, only considering invoices with date
4520 earlier than TIME (total_owed_date minus total_credited minus
4521 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
4522 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
4523 functions.
4524
4525 =cut
4526
4527 sub balance_date {
4528   my $self = shift;
4529   my $time = shift;
4530   sprintf( "%.2f",
4531         $self->total_owed_date($time)
4532       + $self->total_unapplied_refunds
4533       - $self->total_credited
4534       - $self->total_unapplied_payments
4535   );
4536 }
4537
4538 =item in_transit_payments
4539
4540 Returns the total of requests for payments for this customer pending in
4541 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
4542
4543 =cut
4544
4545 sub in_transit_payments {
4546   my $self = shift;
4547   my $in_transit_payments = 0;
4548   foreach my $pay_batch ( qsearch('pay_batch', {
4549     'status' => 'I',
4550   } ) ) {
4551     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
4552       'batchnum' => $pay_batch->batchnum,
4553       'custnum' => $self->custnum,
4554     } ) ) {
4555       $in_transit_payments += $cust_pay_batch->amount;
4556     }
4557   }
4558   sprintf( "%.2f", $in_transit_payments );
4559 }
4560
4561 =item paydate_monthyear
4562
4563 Returns a two-element list consisting of the month and year of this customer's
4564 paydate (credit card expiration date for CARD customers)
4565
4566 =cut
4567
4568 sub paydate_monthyear {
4569   my $self = shift;
4570   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
4571     ( $2, $1 );
4572   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
4573     ( $1, $3 );
4574   } else {
4575     ('', '');
4576   }
4577 }
4578
4579 =item invoicing_list [ ARRAYREF ]
4580
4581 If an arguement is given, sets these email addresses as invoice recipients
4582 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
4583 (except as warnings), so use check_invoicing_list first.
4584
4585 Returns a list of email addresses (with svcnum entries expanded).
4586
4587 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
4588 check it without disturbing anything by passing nothing.
4589
4590 This interface may change in the future.
4591
4592 =cut
4593
4594 sub invoicing_list {
4595   my( $self, $arrayref ) = @_;
4596
4597   if ( $arrayref ) {
4598     my @cust_main_invoice;
4599     if ( $self->custnum ) {
4600       @cust_main_invoice =
4601         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4602     } else {
4603       @cust_main_invoice = ();
4604     }
4605     foreach my $cust_main_invoice ( @cust_main_invoice ) {
4606       #warn $cust_main_invoice->destnum;
4607       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
4608         #warn $cust_main_invoice->destnum;
4609         my $error = $cust_main_invoice->delete;
4610         warn $error if $error;
4611       }
4612     }
4613     if ( $self->custnum ) {
4614       @cust_main_invoice =
4615         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4616     } else {
4617       @cust_main_invoice = ();
4618     }
4619     my %seen = map { $_->address => 1 } @cust_main_invoice;
4620     foreach my $address ( @{$arrayref} ) {
4621       next if exists $seen{$address} && $seen{$address};
4622       $seen{$address} = 1;
4623       my $cust_main_invoice = new FS::cust_main_invoice ( {
4624         'custnum' => $self->custnum,
4625         'dest'    => $address,
4626       } );
4627       my $error = $cust_main_invoice->insert;
4628       warn $error if $error;
4629     }
4630   }
4631
4632   if ( $self->custnum ) {
4633     map { $_->address }
4634       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4635   } else {
4636     ();
4637   }
4638
4639 }
4640
4641 =item check_invoicing_list ARRAYREF
4642
4643 Checks these arguements as valid input for the invoicing_list method.  If there
4644 is an error, returns the error, otherwise returns false.
4645
4646 =cut
4647
4648 sub check_invoicing_list {
4649   my( $self, $arrayref ) = @_;
4650
4651   foreach my $address ( @$arrayref ) {
4652
4653     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
4654       return 'Can\'t add FAX invoice destination with a blank FAX number.';
4655     }
4656
4657     my $cust_main_invoice = new FS::cust_main_invoice ( {
4658       'custnum' => $self->custnum,
4659       'dest'    => $address,
4660     } );
4661     my $error = $self->custnum
4662                 ? $cust_main_invoice->check
4663                 : $cust_main_invoice->checkdest
4664     ;
4665     return $error if $error;
4666
4667   }
4668
4669   return "Email address required"
4670     if $conf->exists('cust_main-require_invoicing_list_email')
4671     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
4672
4673   '';
4674 }
4675
4676 =item set_default_invoicing_list
4677
4678 Sets the invoicing list to all accounts associated with this customer,
4679 overwriting any previous invoicing list.
4680
4681 =cut
4682
4683 sub set_default_invoicing_list {
4684   my $self = shift;
4685   $self->invoicing_list($self->all_emails);
4686 }
4687
4688 =item all_emails
4689
4690 Returns the email addresses of all accounts provisioned for this customer.
4691
4692 =cut
4693
4694 sub all_emails {
4695   my $self = shift;
4696   my %list;
4697   foreach my $cust_pkg ( $self->all_pkgs ) {
4698     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
4699     my @svc_acct =
4700       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
4701         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
4702           @cust_svc;
4703     $list{$_}=1 foreach map { $_->email } @svc_acct;
4704   }
4705   keys %list;
4706 }
4707
4708 =item invoicing_list_addpost
4709
4710 Adds postal invoicing to this customer.  If this customer is already configured
4711 to receive postal invoices, does nothing.
4712
4713 =cut
4714
4715 sub invoicing_list_addpost {
4716   my $self = shift;
4717   return if grep { $_ eq 'POST' } $self->invoicing_list;
4718   my @invoicing_list = $self->invoicing_list;
4719   push @invoicing_list, 'POST';
4720   $self->invoicing_list(\@invoicing_list);
4721 }
4722
4723 =item invoicing_list_emailonly
4724
4725 Returns the list of email invoice recipients (invoicing_list without non-email
4726 destinations such as POST and FAX).
4727
4728 =cut
4729
4730 sub invoicing_list_emailonly {
4731   my $self = shift;
4732   warn "$me invoicing_list_emailonly called"
4733     if $DEBUG;
4734   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
4735 }
4736
4737 =item invoicing_list_emailonly_scalar
4738
4739 Returns the list of email invoice recipients (invoicing_list without non-email
4740 destinations such as POST and FAX) as a comma-separated scalar.
4741
4742 =cut
4743
4744 sub invoicing_list_emailonly_scalar {
4745   my $self = shift;
4746   warn "$me invoicing_list_emailonly_scalar called"
4747     if $DEBUG;
4748   join(', ', $self->invoicing_list_emailonly);
4749 }
4750
4751 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
4752
4753 Returns an array of customers referred by this customer (referral_custnum set
4754 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
4755 customers referred by customers referred by this customer and so on, inclusive.
4756 The default behavior is DEPTH 1 (no recursion).
4757
4758 =cut
4759
4760 sub referral_cust_main {
4761   my $self = shift;
4762   my $depth = @_ ? shift : 1;
4763   my $exclude = @_ ? shift : {};
4764
4765   my @cust_main =
4766     map { $exclude->{$_->custnum}++; $_; }
4767       grep { ! $exclude->{ $_->custnum } }
4768         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
4769
4770   if ( $depth > 1 ) {
4771     push @cust_main,
4772       map { $_->referral_cust_main($depth-1, $exclude) }
4773         @cust_main;
4774   }
4775
4776   @cust_main;
4777 }
4778
4779 =item referral_cust_main_ncancelled
4780
4781 Same as referral_cust_main, except only returns customers with uncancelled
4782 packages.
4783
4784 =cut
4785
4786 sub referral_cust_main_ncancelled {
4787   my $self = shift;
4788   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
4789 }
4790
4791 =item referral_cust_pkg [ DEPTH ]
4792
4793 Like referral_cust_main, except returns a flat list of all unsuspended (and
4794 uncancelled) packages for each customer.  The number of items in this list may
4795 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
4796
4797 =cut
4798
4799 sub referral_cust_pkg {
4800   my $self = shift;
4801   my $depth = @_ ? shift : 1;
4802
4803   map { $_->unsuspended_pkgs }
4804     grep { $_->unsuspended_pkgs }
4805       $self->referral_cust_main($depth);
4806 }
4807
4808 =item referring_cust_main
4809
4810 Returns the single cust_main record for the customer who referred this customer
4811 (referral_custnum), or false.
4812
4813 =cut
4814
4815 sub referring_cust_main {
4816   my $self = shift;
4817   return '' unless $self->referral_custnum;
4818   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
4819 }
4820
4821 =item credit AMOUNT, REASON
4822
4823 Applies a credit to this customer.  If there is an error, returns the error,
4824 otherwise returns false.
4825
4826 =cut
4827
4828 sub credit {
4829   my( $self, $amount, $reason, %options ) = @_;
4830   my $cust_credit = new FS::cust_credit {
4831     'custnum' => $self->custnum,
4832     'amount'  => $amount,
4833     'reason'  => $reason,
4834   };
4835   $cust_credit->insert(%options);
4836 }
4837
4838 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
4839
4840 Creates a one-time charge for this customer.  If there is an error, returns
4841 the error, otherwise returns false.
4842
4843 =cut
4844
4845 sub charge {
4846   my $self = shift;
4847   my ( $amount, $quantity, $pkg, $comment, $taxclass, $additional, $classnum );
4848   my ( $taxproduct, $override );
4849   if ( ref( $_[0] ) ) {
4850     $amount     = $_[0]->{amount};
4851     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
4852     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
4853     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
4854                                            : '$'. sprintf("%.2f",$amount);
4855     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
4856     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
4857     $additional = $_[0]->{additional};
4858     $taxproduct = $_[0]->{taxproductnum};
4859     $override   = { '' => $_[0]->{tax_override} };
4860   }else{
4861     $amount     = shift;
4862     $quantity   = 1;
4863     $pkg        = @_ ? shift : 'One-time charge';
4864     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
4865     $taxclass   = @_ ? shift : '';
4866     $additional = [];
4867   }
4868
4869   local $SIG{HUP} = 'IGNORE';
4870   local $SIG{INT} = 'IGNORE';
4871   local $SIG{QUIT} = 'IGNORE';
4872   local $SIG{TERM} = 'IGNORE';
4873   local $SIG{TSTP} = 'IGNORE';
4874   local $SIG{PIPE} = 'IGNORE';
4875
4876   my $oldAutoCommit = $FS::UID::AutoCommit;
4877   local $FS::UID::AutoCommit = 0;
4878   my $dbh = dbh;
4879
4880   my $part_pkg = new FS::part_pkg ( {
4881     'pkg'           => $pkg,
4882     'comment'       => $comment,
4883     'plan'          => 'flat',
4884     'freq'          => 0,
4885     'disabled'      => 'Y',
4886     'classnum'      => $classnum ? $classnum : '',
4887     'taxclass'      => $taxclass,
4888     'taxproductnum' => $taxproduct,
4889   } );
4890
4891   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
4892                         ( 0 .. @$additional - 1 )
4893                   ),
4894                   'additional_count' => scalar(@$additional),
4895                   'setup_fee' => $amount,
4896                 );
4897
4898   my $error = $part_pkg->insert( options       => \%options,
4899                                  tax_overrides => $override,
4900                                );
4901   if ( $error ) {
4902     $dbh->rollback if $oldAutoCommit;
4903     return $error;
4904   }
4905
4906   my $pkgpart = $part_pkg->pkgpart;
4907   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
4908   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
4909     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
4910     $error = $type_pkgs->insert;
4911     if ( $error ) {
4912       $dbh->rollback if $oldAutoCommit;
4913       return $error;
4914     }
4915   }
4916
4917   my $cust_pkg = new FS::cust_pkg ( {
4918     'custnum'  => $self->custnum,
4919     'pkgpart'  => $pkgpart,
4920     'quantity' => $quantity,
4921   } );
4922
4923   $error = $cust_pkg->insert;
4924   if ( $error ) {
4925     $dbh->rollback if $oldAutoCommit;
4926     return $error;
4927   }
4928
4929   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4930   '';
4931
4932 }
4933
4934 #=item charge_postal_fee
4935 #
4936 #Applies a one time charge this customer.  If there is an error,
4937 #returns the error, returns the cust_pkg charge object or false
4938 #if there was no charge.
4939 #
4940 #=cut
4941 #
4942 # This should be a customer event.  For that to work requires that bill
4943 # also be a customer event.
4944
4945 sub charge_postal_fee {
4946   my $self = shift;
4947
4948   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
4949   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
4950
4951   my $cust_pkg = new FS::cust_pkg ( {
4952     'custnum'  => $self->custnum,
4953     'pkgpart'  => $pkgpart,
4954     'quantity' => 1,
4955   } );
4956
4957   my $error = $cust_pkg->insert;
4958   $error ? $error : $cust_pkg;
4959 }
4960
4961 =item cust_bill
4962
4963 Returns all the invoices (see L<FS::cust_bill>) for this customer.
4964
4965 =cut
4966
4967 sub cust_bill {
4968   my $self = shift;
4969   sort { $a->_date <=> $b->_date }
4970     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4971 }
4972
4973 =item open_cust_bill
4974
4975 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
4976 customer.
4977
4978 =cut
4979
4980 sub open_cust_bill {
4981   my $self = shift;
4982   grep { $_->owed > 0 } $self->cust_bill;
4983 }
4984
4985 =item cust_credit
4986
4987 Returns all the credits (see L<FS::cust_credit>) for this customer.
4988
4989 =cut
4990
4991 sub cust_credit {
4992   my $self = shift;
4993   sort { $a->_date <=> $b->_date }
4994     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
4995 }
4996
4997 =item cust_pay
4998
4999 Returns all the payments (see L<FS::cust_pay>) for this customer.
5000
5001 =cut
5002
5003 sub cust_pay {
5004   my $self = shift;
5005   sort { $a->_date <=> $b->_date }
5006     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
5007 }
5008
5009 =item cust_pay_void
5010
5011 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
5012
5013 =cut
5014
5015 sub cust_pay_void {
5016   my $self = shift;
5017   sort { $a->_date <=> $b->_date }
5018     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
5019 }
5020
5021 =item cust_pay_batch
5022
5023 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
5024
5025 =cut
5026
5027 sub cust_pay_batch {
5028   my $self = shift;
5029   sort { $a->_date <=> $b->_date }
5030     qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
5031 }
5032
5033 =item cust_refund
5034
5035 Returns all the refunds (see L<FS::cust_refund>) for this customer.
5036
5037 =cut
5038
5039 sub cust_refund {
5040   my $self = shift;
5041   sort { $a->_date <=> $b->_date }
5042     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
5043 }
5044
5045 =item name
5046
5047 Returns a name string for this customer, either "Company (Last, First)" or
5048 "Last, First".
5049
5050 =cut
5051
5052 sub name {
5053   my $self = shift;
5054   my $name = $self->contact;
5055   $name = $self->company. " ($name)" if $self->company;
5056   $name;
5057 }
5058
5059 =item ship_name
5060
5061 Returns a name string for this (service/shipping) contact, either
5062 "Company (Last, First)" or "Last, First".
5063
5064 =cut
5065
5066 sub ship_name {
5067   my $self = shift;
5068   if ( $self->get('ship_last') ) {
5069     my $name = $self->ship_contact;
5070     $name = $self->ship_company. " ($name)" if $self->ship_company;
5071     $name;
5072   } else {
5073     $self->name;
5074   }
5075 }
5076
5077 =item contact
5078
5079 Returns this customer's full (billing) contact name only, "Last, First"
5080
5081 =cut
5082
5083 sub contact {
5084   my $self = shift;
5085   $self->get('last'). ', '. $self->first;
5086 }
5087
5088 =item ship_contact
5089
5090 Returns this customer's full (shipping) contact name only, "Last, First"
5091
5092 =cut
5093
5094 sub ship_contact {
5095   my $self = shift;
5096   $self->get('ship_last')
5097     ? $self->get('ship_last'). ', '. $self->ship_first
5098     : $self->contact;
5099 }
5100
5101 =item country_full
5102
5103 Returns this customer's full country name
5104
5105 =cut
5106
5107 sub country_full {
5108   my $self = shift;
5109   code2country($self->country);
5110 }
5111
5112 =item geocode DATA_VENDOR
5113
5114 Returns a value for the customer location as encoded by DATA_VENDOR.
5115 Currently this only makes sense for "CCH" as DATA_VENDOR.
5116
5117 =cut
5118
5119 sub geocode {
5120   my ($self, $data_vendor) = (shift, shift);  #always cch for now
5121
5122   my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
5123                ? 'ship_'
5124                : '';
5125
5126   my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
5127     if $self->country eq 'US';
5128
5129   #CCH specific location stuff
5130   my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
5131
5132   my $geocode = '';
5133   my $cust_tax_location =
5134     qsearchs( {
5135                 'table'     => 'cust_tax_location',
5136                 'hashref'   => { 'zip' => $zip, 'data_vendor' => $data_vendor },
5137                 'extra_sql' => $extra_sql,
5138               }
5139             );
5140   $geocode = $cust_tax_location->geocode
5141     if $cust_tax_location;
5142
5143   $geocode;
5144 }
5145
5146 =item cust_status
5147
5148 =item status
5149
5150 Returns a status string for this customer, currently:
5151
5152 =over 4
5153
5154 =item prospect - No packages have ever been ordered
5155
5156 =item active - One or more recurring packages is active
5157
5158 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
5159
5160 =item suspended - All non-cancelled recurring packages are suspended
5161
5162 =item cancelled - All recurring packages are cancelled
5163
5164 =back
5165
5166 =cut
5167
5168 sub status { shift->cust_status(@_); }
5169
5170 sub cust_status {
5171   my $self = shift;
5172   for my $status (qw( prospect active inactive suspended cancelled )) {
5173     my $method = $status.'_sql';
5174     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
5175     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
5176     $sth->execute( ($self->custnum) x $numnum )
5177       or die "Error executing 'SELECT $sql': ". $sth->errstr;
5178     return $status if $sth->fetchrow_arrayref->[0];
5179   }
5180 }
5181
5182 =item ucfirst_cust_status
5183
5184 =item ucfirst_status
5185
5186 Returns the status with the first character capitalized.
5187
5188 =cut
5189
5190 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
5191
5192 sub ucfirst_cust_status {
5193   my $self = shift;
5194   ucfirst($self->cust_status);
5195 }
5196
5197 =item statuscolor
5198
5199 Returns a hex triplet color string for this customer's status.
5200
5201 =cut
5202
5203 use vars qw(%statuscolor);
5204 tie %statuscolor, 'Tie::IxHash',
5205   'prospect'  => '7e0079', #'000000', #black?  naw, purple
5206   'active'    => '00CC00', #green
5207   'inactive'  => '0000CC', #blue
5208   'suspended' => 'FF9900', #yellow
5209   'cancelled' => 'FF0000', #red
5210 ;
5211
5212 sub statuscolor { shift->cust_statuscolor(@_); }
5213
5214 sub cust_statuscolor {
5215   my $self = shift;
5216   $statuscolor{$self->cust_status};
5217 }
5218
5219 =item tickets
5220
5221 Returns an array of hashes representing the customer's RT tickets.
5222
5223 =cut
5224
5225 sub tickets {
5226   my $self = shift;
5227
5228   my $num = $conf->config('cust_main-max_tickets') || 10;
5229   my @tickets = ();
5230
5231   unless ( $conf->config('ticket_system-custom_priority_field') ) {
5232
5233     @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
5234
5235   } else {
5236
5237     foreach my $priority (
5238       $conf->config('ticket_system-custom_priority_field-values'), ''
5239     ) {
5240       last if scalar(@tickets) >= $num;
5241       push @tickets,
5242         @{ FS::TicketSystem->customer_tickets( $self->custnum,
5243                                                $num - scalar(@tickets),
5244                                                $priority,
5245                                              )
5246          };
5247     }
5248   }
5249   (@tickets);
5250 }
5251
5252 # Return services representing svc_accts in customer support packages
5253 sub support_services {
5254   my $self = shift;
5255   my %packages = map { $_ => 1 } $conf->config('support_packages');
5256
5257   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
5258     grep { $_->part_svc->svcdb eq 'svc_acct' }
5259     map { $_->cust_svc }
5260     grep { exists $packages{ $_->pkgpart } }
5261     $self->ncancelled_pkgs;
5262
5263 }
5264
5265 =back
5266
5267 =head1 CLASS METHODS
5268
5269 =over 4
5270
5271 =item statuses
5272
5273 Class method that returns the list of possible status strings for customers
5274 (see L<the status method|/status>).  For example:
5275
5276   @statuses = FS::cust_main->statuses();
5277
5278 =cut
5279
5280 sub statuses {
5281   #my $self = shift; #could be class...
5282   keys %statuscolor;
5283 }
5284
5285 =item prospect_sql
5286
5287 Returns an SQL expression identifying prospective cust_main records (customers
5288 with no packages ever ordered)
5289
5290 =cut
5291
5292 use vars qw($select_count_pkgs);
5293 $select_count_pkgs =
5294   "SELECT COUNT(*) FROM cust_pkg
5295     WHERE cust_pkg.custnum = cust_main.custnum";
5296
5297 sub select_count_pkgs_sql {
5298   $select_count_pkgs;
5299 }
5300
5301 sub prospect_sql { "
5302   0 = ( $select_count_pkgs )
5303 "; }
5304
5305 =item active_sql
5306
5307 Returns an SQL expression identifying active cust_main records (customers with
5308 active recurring packages).
5309
5310 =cut
5311
5312 sub active_sql { "
5313   0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
5314       )
5315 "; }
5316
5317 =item inactive_sql
5318
5319 Returns an SQL expression identifying inactive cust_main records (customers with
5320 no active recurring packages, but otherwise unsuspended/uncancelled).
5321
5322 =cut
5323
5324 sub inactive_sql { "
5325   0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
5326   AND
5327   0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
5328 "; }
5329
5330 =item susp_sql
5331 =item suspended_sql
5332
5333 Returns an SQL expression identifying suspended cust_main records.
5334
5335 =cut
5336
5337
5338 sub suspended_sql { susp_sql(@_); }
5339 sub susp_sql { "
5340     0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
5341     AND
5342     0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
5343 "; }
5344
5345 =item cancel_sql
5346 =item cancelled_sql
5347
5348 Returns an SQL expression identifying cancelled cust_main records.
5349
5350 =cut
5351
5352 sub cancelled_sql { cancel_sql(@_); }
5353 sub cancel_sql {
5354
5355   my $recurring_sql = FS::cust_pkg->recurring_sql;
5356   my $cancelled_sql = FS::cust_pkg->cancelled_sql;
5357
5358   "
5359         0 < ( $select_count_pkgs )
5360     AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql   )
5361     AND 0 = ( $select_count_pkgs AND $recurring_sql
5362                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
5363             )
5364     AND 0 = (  $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
5365   ";
5366
5367 }
5368
5369 =item uncancel_sql
5370 =item uncancelled_sql
5371
5372 Returns an SQL expression identifying un-cancelled cust_main records.
5373
5374 =cut
5375
5376 sub uncancelled_sql { uncancel_sql(@_); }
5377 sub uncancel_sql { "
5378   ( 0 < ( $select_count_pkgs
5379                    AND ( cust_pkg.cancel IS NULL
5380                          OR cust_pkg.cancel = 0
5381                        )
5382         )
5383     OR 0 = ( $select_count_pkgs )
5384   )
5385 "; }
5386
5387 =item balance_sql
5388
5389 Returns an SQL fragment to retreive the balance.
5390
5391 =cut
5392
5393 sub balance_sql { "
5394     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
5395         WHERE cust_bill.custnum   = cust_main.custnum     )
5396   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
5397         WHERE cust_pay.custnum    = cust_main.custnum     )
5398   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
5399         WHERE cust_credit.custnum = cust_main.custnum     )
5400   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
5401         WHERE cust_refund.custnum = cust_main.custnum     )
5402 "; }
5403
5404 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5405
5406 Returns an SQL fragment to retreive the balance for this customer, only
5407 considering invoices with date earlier than START_TIME, and optionally not
5408 later than END_TIME (total_owed_date minus total_credited minus
5409 total_unapplied_payments).
5410
5411 Times are specified as SQL fragments or numeric
5412 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
5413 L<Date::Parse> for conversion functions.  The empty string can be passed
5414 to disable that time constraint completely.
5415
5416 Available options are:
5417
5418 =over 4
5419
5420 =item unapplied_date
5421
5422 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)
5423
5424 =item total
5425
5426 (unused.  obsolete?)
5427 set to true to remove all customer comparison clauses, for totals
5428
5429 =item where
5430
5431 (unused.  obsolete?)
5432 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
5433
5434 =item join
5435
5436 (unused.  obsolete?)
5437 JOIN clause (typically used with the total option)
5438
5439 =back
5440
5441 =cut
5442
5443 sub balance_date_sql {
5444   my( $class, $start, $end, %opt ) = @_;
5445
5446   my $owed         = FS::cust_bill->owed_sql;
5447   my $unapp_refund = FS::cust_refund->unapplied_sql;
5448   my $unapp_credit = FS::cust_credit->unapplied_sql;
5449   my $unapp_pay    = FS::cust_pay->unapplied_sql;
5450
5451   my $j = $opt{'join'} || '';
5452
5453   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
5454   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
5455   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
5456   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
5457
5458   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
5459     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
5460     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
5461     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
5462   ";
5463
5464 }
5465
5466 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5467
5468 Helper method for balance_date_sql; name (and usage) subject to change
5469 (suggestions welcome).
5470
5471 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
5472 cust_refund, cust_credit or cust_pay).
5473
5474 If TABLE is "cust_bill" or the unapplied_date option is true, only
5475 considers records with date earlier than START_TIME, and optionally not
5476 later than END_TIME .
5477
5478 =cut
5479
5480 sub _money_table_where {
5481   my( $class, $table, $start, $end, %opt ) = @_;
5482
5483   my @where = ();
5484   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
5485   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
5486     push @where, "$table._date <= $start" if defined($start) && length($start);
5487     push @where, "$table._date >  $end"   if defined($end)   && length($end);
5488   }
5489   push @where, @{$opt{'where'}} if $opt{'where'};
5490   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5491
5492   $where;
5493
5494 }
5495
5496 =item search_sql HASHREF
5497
5498 (Class method)
5499
5500 Returns a qsearch hash expression to search for parameters specified in HREF.
5501 Valid parameters are
5502
5503 =over 4
5504
5505 =item agentnum
5506
5507 =item status
5508
5509 =item cancelled_pkgs
5510
5511 bool
5512
5513 =item signupdate
5514
5515 listref of start date, end date
5516
5517 =item payby
5518
5519 listref
5520
5521 =item current_balance
5522
5523 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
5524
5525 =item cust_fields
5526
5527 =item flattened_pkgs
5528
5529 bool
5530
5531 =back
5532
5533 =cut
5534
5535 sub search_sql {
5536   my ($class, $params) = @_;
5537
5538   my $dbh = dbh;
5539
5540   my @where = ();
5541   my $orderby;
5542
5543   ##
5544   # parse agent
5545   ##
5546
5547   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
5548     push @where,
5549       "cust_main.agentnum = $1";
5550   }
5551
5552   ##
5553   # parse status
5554   ##
5555
5556   #prospect active inactive suspended cancelled
5557   if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
5558     my $method = $params->{'status'}. '_sql';
5559     #push @where, $class->$method();
5560     push @where, FS::cust_main->$method();
5561   }
5562
5563   ##
5564   # parse cancelled package checkbox
5565   ##
5566
5567   my $pkgwhere = "";
5568
5569   $pkgwhere .= "AND (cancel = 0 or cancel is null)"
5570     unless $params->{'cancelled_pkgs'};
5571
5572   ##
5573   # dates
5574   ##
5575
5576   foreach my $field (qw( signupdate )) {
5577
5578     next unless exists($params->{$field});
5579
5580     my($beginning, $ending) = @{$params->{$field}};
5581
5582     push @where,
5583       "cust_main.$field IS NOT NULL",
5584       "cust_main.$field >= $beginning",
5585       "cust_main.$field <= $ending";
5586
5587     $orderby ||= "ORDER BY cust_main.$field";
5588
5589   }
5590
5591   ###
5592   # payby
5593   ###
5594
5595   my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
5596   if ( @payby ) {
5597     push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
5598   }
5599
5600   ##
5601   # amounts
5602   ##
5603
5604   #my $balance_sql = $class->balance_sql();
5605   my $balance_sql = FS::cust_main->balance_sql();
5606
5607   push @where, map { s/current_balance/$balance_sql/; $_ }
5608                    @{ $params->{'current_balance'} };
5609
5610   ##
5611   # custbatch
5612   ##
5613
5614   if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
5615     push @where,
5616       "cust_main.custbatch = '$1'";
5617   }
5618
5619   ##
5620   # setup queries, subs, etc. for the search
5621   ##
5622
5623   $orderby ||= 'ORDER BY custnum';
5624
5625   # here is the agent virtualization
5626   push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
5627
5628   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
5629
5630   my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum  ) ';
5631
5632   my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
5633
5634   my $select = join(', ',
5635                  'cust_main.custnum',
5636                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
5637                );
5638
5639   my(@extra_headers) = ();
5640   my(@extra_fields)  = ();
5641
5642   if ($params->{'flattened_pkgs'}) {
5643
5644     if ($dbh->{Driver}->{Name} eq 'Pg') {
5645
5646       $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";
5647
5648     }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
5649       $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
5650       $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
5651     }else{
5652       warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
5653            "omitting packing information from report.";
5654     }
5655
5656     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";
5657
5658     my $sth = dbh->prepare($header_query) or die dbh->errstr;
5659     $sth->execute() or die $sth->errstr;
5660     my $headerrow = $sth->fetchrow_arrayref;
5661     my $headercount = $headerrow ? $headerrow->[0] : 0;
5662     while($headercount) {
5663       unshift @extra_headers, "Package ". $headercount;
5664       unshift @extra_fields, eval q!sub {my $c = shift;
5665                                          my @a = split '\|', $c->magic;
5666                                          my $p = $a[!.--$headercount. q!];
5667                                          $p;
5668                                         };!;
5669     }
5670
5671   }
5672
5673   my $sql_query = {
5674     'table'         => 'cust_main',
5675     'select'        => $select,
5676     'hashref'       => {},
5677     'extra_sql'     => $extra_sql,
5678     'order_by'      => $orderby,
5679     'count_query'   => $count_query,
5680     'extra_headers' => \@extra_headers,
5681     'extra_fields'  => \@extra_fields,
5682   };
5683
5684 }
5685
5686 =item email_search_sql HASHREF
5687
5688 (Class method)
5689
5690 Emails a notice to the specified customers.
5691
5692 Valid parameters are those of the L<search_sql> method, plus the following:
5693
5694 =over 4
5695
5696 =item from
5697
5698 From: address
5699
5700 =item subject
5701
5702 Email Subject:
5703
5704 =item html_body
5705
5706 HTML body
5707
5708 =item text_body
5709
5710 Text body
5711
5712 =item job
5713
5714 Optional job queue job for status updates.
5715
5716 =back
5717
5718 Returns an error message, or false for success.
5719
5720 If an error occurs during any email, stops the enture send and returns that
5721 error.  Presumably if you're getting SMTP errors aborting is better than
5722 retrying everything.
5723
5724 =cut
5725
5726 sub email_search_sql {
5727   my($class, $params) = @_;
5728
5729   my $from = delete $params->{from};
5730   my $subject = delete $params->{subject};
5731   my $html_body = delete $params->{html_body};
5732   my $text_body = delete $params->{text_body};
5733
5734   my $job = delete $params->{'job'};
5735
5736   my $sql_query = $class->search_sql($params);
5737
5738   my $count_query   = delete($sql_query->{'count_query'});
5739   my $count_sth = dbh->prepare($count_query)
5740     or die "Error preparing $count_query: ". dbh->errstr;
5741   $count_sth->execute
5742     or die "Error executing $count_query: ". $count_sth->errstr;
5743   my $count_arrayref = $count_sth->fetchrow_arrayref;
5744   my $num_cust = $count_arrayref->[0];
5745
5746   #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
5747   #my @extra_fields  = @{ delete($sql_query->{'extra_fields'})  };
5748
5749
5750   my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
5751
5752   #eventually order+limit magic to reduce memory use?
5753   foreach my $cust_main ( qsearch($sql_query) ) {
5754
5755     my $to = $cust_main->invoicing_list_emailonly_scalar;
5756     next unless $to;
5757
5758     my $error = send_email(
5759       generate_email(
5760         'from'      => $from,
5761         'to'        => $to,
5762         'subject'   => $subject,
5763         'html_body' => $html_body,
5764         'text_body' => $text_body,
5765       )
5766     );
5767     return $error if $error;
5768
5769     if ( $job ) { #progressbar foo
5770       $num++;
5771       if ( time - $min_sec > $last ) {
5772         my $error = $job->update_statustext(
5773           int( 100 * $num / $num_cust )
5774         );
5775         die $error if $error;
5776         $last = time;
5777       }
5778     }
5779
5780   }
5781
5782   return '';
5783 }
5784
5785 use Storable qw(thaw);
5786 use Data::Dumper;
5787 use MIME::Base64;
5788 sub process_email_search_sql {
5789   my $job = shift;
5790   #warn "$me process_re_X $method for job $job\n" if $DEBUG;
5791
5792   my $param = thaw(decode_base64(shift));
5793   warn Dumper($param) if $DEBUG;
5794
5795   $param->{'job'} = $job;
5796
5797   my $error = FS::cust_main->email_search_sql( $param );
5798   die $error if $error;
5799
5800 }
5801
5802 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
5803
5804 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
5805 records.  Currently, I<first>, I<last> and/or I<company> may be specified (the
5806 appropriate ship_ field is also searched).
5807
5808 Additional options are the same as FS::Record::qsearch
5809
5810 =cut
5811
5812 sub fuzzy_search {
5813   my( $self, $fuzzy, $hash, @opt) = @_;
5814   #$self
5815   $hash ||= {};
5816   my @cust_main = ();
5817
5818   check_and_rebuild_fuzzyfiles();
5819   foreach my $field ( keys %$fuzzy ) {
5820
5821     my $all = $self->all_X($field);
5822     next unless scalar(@$all);
5823
5824     my %match = ();
5825     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
5826
5827     my @fcust = ();
5828     foreach ( keys %match ) {
5829       push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
5830       push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
5831     }
5832     my %fsaw = ();
5833     push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
5834   }
5835
5836   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
5837   my %saw = ();
5838   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
5839
5840   @cust_main;
5841
5842 }
5843
5844 =item masked FIELD
5845
5846 Returns a masked version of the named field
5847
5848 =cut
5849
5850 sub masked {
5851 my ($self,$field) = @_;
5852
5853 # Show last four
5854
5855 'x'x(length($self->getfield($field))-4).
5856   substr($self->getfield($field), (length($self->getfield($field))-4));
5857
5858 }
5859
5860 =back
5861
5862 =head1 SUBROUTINES
5863
5864 =over 4
5865
5866 =item smart_search OPTION => VALUE ...
5867
5868 Accepts the following options: I<search>, the string to search for.  The string
5869 will be searched for as a customer number, phone number, name or company name,
5870 as an exact, or, in some cases, a substring or fuzzy match (see the source code
5871 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
5872 skip fuzzy matching when an exact match is found.
5873
5874 Any additional options are treated as an additional qualifier on the search
5875 (i.e. I<agentnum>).
5876
5877 Returns a (possibly empty) array of FS::cust_main objects.
5878
5879 =cut
5880
5881 sub smart_search {
5882   my %options = @_;
5883
5884   #here is the agent virtualization
5885   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
5886
5887   my @cust_main = ();
5888
5889   my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
5890   my $search = delete $options{'search'};
5891   ( my $alphanum_search = $search ) =~ s/\W//g;
5892
5893   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
5894
5895     #false laziness w/Record::ut_phone
5896     my $phonen = "$1-$2-$3";
5897     $phonen .= " x$4" if $4;
5898
5899     push @cust_main, qsearch( {
5900       'table'   => 'cust_main',
5901       'hashref' => { %options },
5902       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
5903                      ' ( '.
5904                          join(' OR ', map "$_ = '$phonen'",
5905                                           qw( daytime night fax
5906                                               ship_daytime ship_night ship_fax )
5907                              ).
5908                      ' ) '.
5909                      " AND $agentnums_sql", #agent virtualization
5910     } );
5911
5912     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
5913       #try looking for matches with extensions unless one was specified
5914
5915       push @cust_main, qsearch( {
5916         'table'   => 'cust_main',
5917         'hashref' => { %options },
5918         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
5919                        ' ( '.
5920                            join(' OR ', map "$_ LIKE '$phonen\%'",
5921                                             qw( daytime night
5922                                                 ship_daytime ship_night )
5923                                ).
5924                        ' ) '.
5925                        " AND $agentnums_sql", #agent virtualization
5926       } );
5927
5928     }
5929
5930   # custnum search (also try agent_custid), with some tweaking options if your
5931   # legacy cust "numbers" have letters
5932   } elsif ( $search =~ /^\s*(\d+)\s*$/
5933             || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
5934                  && $search =~ /^\s*(\w\w?\d+)\s*$/
5935                )
5936           )
5937   {
5938
5939     push @cust_main, qsearch( {
5940       'table'     => 'cust_main',
5941       'hashref'   => { 'custnum' => $1, %options },
5942       'extra_sql' => " AND $agentnums_sql", #agent virtualization
5943     } );
5944
5945     push @cust_main, qsearch( {
5946       'table'     => 'cust_main',
5947       'hashref'   => { 'agent_custid' => $1, %options },
5948       'extra_sql' => " AND $agentnums_sql", #agent virtualization
5949     } );
5950
5951   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
5952
5953     my($company, $last, $first) = ( $1, $2, $3 );
5954
5955     # "Company (Last, First)"
5956     #this is probably something a browser remembered,
5957     #so just do an exact search
5958
5959     foreach my $prefix ( '', 'ship_' ) {
5960       push @cust_main, qsearch( {
5961         'table'     => 'cust_main',
5962         'hashref'   => { $prefix.'first'   => $first,
5963                          $prefix.'last'    => $last,
5964                          $prefix.'company' => $company,
5965                          %options,
5966                        },
5967         'extra_sql' => " AND $agentnums_sql",
5968       } );
5969     }
5970
5971   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
5972                                               # try (ship_){last,company}
5973
5974     my $value = lc($1);
5975
5976     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
5977     # # full strings the browser remembers won't work
5978     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
5979
5980     use Lingua::EN::NameParse;
5981     my $NameParse = new Lingua::EN::NameParse(
5982              auto_clean     => 1,
5983              allow_reversed => 1,
5984     );
5985
5986     my($last, $first) = ( '', '' );
5987     #maybe disable this too and just rely on NameParse?
5988     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
5989
5990       ($last, $first) = ( $1, $2 );
5991
5992     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
5993     } elsif ( ! $NameParse->parse($value) ) {
5994
5995       my %name = $NameParse->components;
5996       $first = $name{'given_name_1'};
5997       $last  = $name{'surname_1'};
5998
5999     }
6000
6001     if ( $first && $last ) {
6002
6003       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
6004
6005       #exact
6006       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
6007       $sql .= "
6008         (     ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
6009            OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
6010         )";
6011
6012       push @cust_main, qsearch( {
6013         'table'     => 'cust_main',
6014         'hashref'   => \%options,
6015         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
6016       } );
6017
6018       # or it just be something that was typed in... (try that in a sec)
6019
6020     }
6021
6022     my $q_value = dbh->quote($value);
6023
6024     #exact
6025     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
6026     $sql .= " (    LOWER(last)         = $q_value
6027                 OR LOWER(company)      = $q_value
6028                 OR LOWER(ship_last)    = $q_value
6029                 OR LOWER(ship_company) = $q_value
6030               )";
6031
6032     push @cust_main, qsearch( {
6033       'table'     => 'cust_main',
6034       'hashref'   => \%options,
6035       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
6036     } );
6037
6038     #no exact match, trying substring/fuzzy
6039     #always do substring & fuzzy (unless they're explicity config'ed off)
6040     #getting complaints searches are not returning enough
6041     unless ( @cust_main  && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
6042
6043       #still some false laziness w/search_sql (was search/cust_main.cgi)
6044
6045       #substring
6046
6047       my @hashrefs = (
6048         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
6049         { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
6050       );
6051
6052       if ( $first && $last ) {
6053
6054         push @hashrefs,
6055           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
6056             'last'         => { op=>'ILIKE', value=>"%$last%" },
6057           },
6058           { 'ship_first'   => { op=>'ILIKE', value=>"%$first%" },
6059             'ship_last'    => { op=>'ILIKE', value=>"%$last%" },
6060           },
6061         ;
6062
6063       } else {
6064
6065         push @hashrefs,
6066           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
6067           { 'ship_last'    => { op=>'ILIKE', value=>"%$value%" }, },
6068         ;
6069       }
6070
6071       foreach my $hashref ( @hashrefs ) {
6072
6073         push @cust_main, qsearch( {
6074           'table'     => 'cust_main',
6075           'hashref'   => { %$hashref,
6076                            %options,
6077                          },
6078           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
6079         } );
6080
6081       }
6082
6083       #fuzzy
6084       my @fuzopts = (
6085         \%options,                #hashref
6086         '',                       #select
6087         " AND $agentnums_sql",    #extra_sql  #agent virtualization
6088       );
6089
6090       if ( $first && $last ) {
6091         push @cust_main, FS::cust_main->fuzzy_search(
6092           { 'last'   => $last,    #fuzzy hashref
6093             'first'  => $first }, #
6094           @fuzopts
6095         );
6096       }
6097       foreach my $field ( 'last', 'company' ) {
6098         push @cust_main,
6099           FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
6100       }
6101
6102     }
6103
6104     #eliminate duplicates
6105     my %saw = ();
6106     @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
6107
6108   }
6109
6110   @cust_main;
6111
6112 }
6113
6114 =item email_search
6115
6116 Accepts the following options: I<email>, the email address to search for.  The
6117 email address will be searched for as an email invoice destination and as an
6118 svc_acct account.
6119
6120 #Any additional options are treated as an additional qualifier on the search
6121 #(i.e. I<agentnum>).
6122
6123 Returns a (possibly empty) array of FS::cust_main objects (but usually just
6124 none or one).
6125
6126 =cut
6127
6128 sub email_search {
6129   my %options = @_;
6130
6131   local($DEBUG) = 1;
6132
6133   my $email = delete $options{'email'};
6134
6135   #we're only being used by RT at the moment... no agent virtualization yet
6136   #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
6137
6138   my @cust_main = ();
6139
6140   if ( $email =~ /([^@]+)\@([^@]+)/ ) {
6141
6142     my ( $user, $domain ) = ( $1, $2 );
6143
6144     warn "$me smart_search: searching for $user in domain $domain"
6145       if $DEBUG;
6146
6147     push @cust_main,
6148       map $_->cust_main,
6149           qsearch( {
6150                      'table'     => 'cust_main_invoice',
6151                      'hashref'   => { 'dest' => $email },
6152                    }
6153                  );
6154
6155     push @cust_main,
6156       map  $_->cust_main,
6157       grep $_,
6158       map  $_->cust_svc->cust_pkg,
6159           qsearch( {
6160                      'table'     => 'svc_acct',
6161                      'hashref'   => { 'username' => $user, },
6162                      'extra_sql' =>
6163                        'AND ( SELECT domain FROM svc_domain
6164                                 WHERE svc_acct.domsvc = svc_domain.svcnum
6165                             ) = '. dbh->quote($domain),
6166                    }
6167                  );
6168   }
6169
6170   my %saw = ();
6171   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
6172
6173   warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
6174     if $DEBUG;
6175
6176   @cust_main;
6177
6178 }
6179
6180 =item check_and_rebuild_fuzzyfiles
6181
6182 =cut
6183
6184 use vars qw(@fuzzyfields);
6185 @fuzzyfields = ( 'last', 'first', 'company' );
6186
6187 sub check_and_rebuild_fuzzyfiles {
6188   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6189   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
6190 }
6191
6192 =item rebuild_fuzzyfiles
6193
6194 =cut
6195
6196 sub rebuild_fuzzyfiles {
6197
6198   use Fcntl qw(:flock);
6199
6200   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6201   mkdir $dir, 0700 unless -d $dir;
6202
6203   foreach my $fuzzy ( @fuzzyfields ) {
6204
6205     open(LOCK,">>$dir/cust_main.$fuzzy")
6206       or die "can't open $dir/cust_main.$fuzzy: $!";
6207     flock(LOCK,LOCK_EX)
6208       or die "can't lock $dir/cust_main.$fuzzy: $!";
6209
6210     open (CACHE,">$dir/cust_main.$fuzzy.tmp")
6211       or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
6212
6213     foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
6214       my $sth = dbh->prepare("SELECT $field FROM cust_main".
6215                              " WHERE $field != '' AND $field IS NOT NULL");
6216       $sth->execute or die $sth->errstr;
6217
6218       while ( my $row = $sth->fetchrow_arrayref ) {
6219         print CACHE $row->[0]. "\n";
6220       }
6221
6222     }
6223
6224     close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
6225
6226     rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
6227     close LOCK;
6228   }
6229
6230 }
6231
6232 =item all_X
6233
6234 =cut
6235
6236 sub all_X {
6237   my( $self, $field ) = @_;
6238   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6239   open(CACHE,"<$dir/cust_main.$field")
6240     or die "can't open $dir/cust_main.$field: $!";
6241   my @array = map { chomp; $_; } <CACHE>;
6242   close CACHE;
6243   \@array;
6244 }
6245
6246 =item append_fuzzyfiles LASTNAME COMPANY
6247
6248 =cut
6249
6250 sub append_fuzzyfiles {
6251   #my( $first, $last, $company ) = @_;
6252
6253   &check_and_rebuild_fuzzyfiles;
6254
6255   use Fcntl qw(:flock);
6256
6257   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6258
6259   foreach my $field (qw( first last company )) {
6260     my $value = shift;
6261
6262     if ( $value ) {
6263
6264       open(CACHE,">>$dir/cust_main.$field")
6265         or die "can't open $dir/cust_main.$field: $!";
6266       flock(CACHE,LOCK_EX)
6267         or die "can't lock $dir/cust_main.$field: $!";
6268
6269       print CACHE "$value\n";
6270
6271       flock(CACHE,LOCK_UN)
6272         or die "can't unlock $dir/cust_main.$field: $!";
6273       close CACHE;
6274     }
6275
6276   }
6277
6278   1;
6279 }
6280
6281 =item process_batch_import
6282
6283 Load a batch import as a queued JSRPC job
6284
6285 =cut
6286
6287 use Storable qw(thaw);
6288 use Data::Dumper;
6289 use MIME::Base64;
6290 sub process_batch_import {
6291   my $job = shift;
6292
6293   my $param = thaw(decode_base64(shift));
6294   warn Dumper($param) if $DEBUG;
6295
6296   my $files = $param->{'uploaded_files'}
6297     or die "No files provided.\n";
6298
6299   my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files;
6300
6301   my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
6302   my $file = $dir. $files{'file'};
6303
6304   my $type;
6305   if ( $file =~ /\.(\w+)$/i ) {
6306     $type = lc($1);
6307   } else {
6308     #or error out???
6309     warn "can't parse file type from filename $file; defaulting to CSV";
6310     $type = 'csv';
6311   }
6312
6313   my $error =
6314     FS::cust_main::batch_import( {
6315       job       => $job,
6316       file      => $file,
6317       type      => $type,
6318       custbatch => $param->{custbatch},
6319       agentnum  => $param->{'agentnum'},
6320       refnum    => $param->{'refnum'},
6321       pkgpart   => $param->{'pkgpart'},
6322       #'fields'  => [qw( cust_pkg.setup dayphone first last address1 address2
6323       #                 city state zip comments                          )],
6324       'format'  => $param->{'format'},
6325     } );
6326
6327   unlink $file;
6328
6329   die "$error\n" if $error;
6330
6331 }
6332
6333 =item batch_import
6334
6335 =cut
6336
6337 #some false laziness w/cdr.pm now
6338 sub batch_import {
6339   my $param = shift;
6340
6341   my $job       = $param->{job};
6342
6343   my $filename  = $param->{file};
6344   my $type      = $param->{type} || 'csv';
6345
6346   my $custbatch = $param->{custbatch};
6347
6348   my $agentnum  = $param->{agentnum};
6349   my $refnum    = $param->{refnum};
6350   my $pkgpart   = $param->{pkgpart};
6351
6352   my $format    = $param->{'format'};
6353
6354   my @fields;
6355   my $payby;
6356   if ( $format eq 'simple' ) {
6357     @fields = qw( cust_pkg.setup dayphone first last
6358                   address1 address2 city state zip comments );
6359     $payby = 'BILL';
6360   } elsif ( $format eq 'extended' ) {
6361     @fields = qw( agent_custid refnum
6362                   last first address1 address2 city state zip country
6363                   daytime night
6364                   ship_last ship_first 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  } elsif ( $format eq 'extended-plus_company' ) {
6373     @fields = qw( agent_custid refnum
6374                   last first company address1 address2 city state zip country
6375                   daytime night
6376                   ship_last ship_first ship_company ship_address1 ship_address2
6377                   ship_city ship_state ship_zip ship_country
6378                   payinfo paycvv paydate
6379                   invoicing_list
6380                   cust_pkg.pkgpart
6381                   svc_acct.username svc_acct._password
6382                 );
6383     $payby = 'BILL';
6384   } else {
6385     die "unknown format $format";
6386   }
6387
6388   my $count;
6389   my $parser;
6390   my @buffer = ();
6391   if ( $type eq 'csv' ) {
6392
6393     eval "use Text::CSV_XS;";
6394     die $@ if $@;
6395
6396     $parser = new Text::CSV_XS;
6397
6398     @buffer = split(/\r?\n/, slurp($filename) );
6399     $count = scalar(@buffer);
6400
6401   } elsif ( $type eq 'xls' ) {
6402
6403     eval "use Spreadsheet::ParseExcel;";
6404     die $@ if $@;
6405
6406     my $excel = new Spreadsheet::ParseExcel::Workbook->Parse($filename);
6407     $parser = $excel->{Worksheet}[0]; #first sheet
6408
6409     $count = $parser->{MaxRow} || $parser->{MinRow};
6410     $count++;
6411
6412   } else {
6413     die "Unknown file type $type\n";
6414   }
6415
6416   #my $columns;
6417
6418   local $SIG{HUP} = 'IGNORE';
6419   local $SIG{INT} = 'IGNORE';
6420   local $SIG{QUIT} = 'IGNORE';
6421   local $SIG{TERM} = 'IGNORE';
6422   local $SIG{TSTP} = 'IGNORE';
6423   local $SIG{PIPE} = 'IGNORE';
6424
6425   my $oldAutoCommit = $FS::UID::AutoCommit;
6426   local $FS::UID::AutoCommit = 0;
6427   my $dbh = dbh;
6428
6429   my $line;
6430   my $row = 0;
6431   my( $last, $min_sec ) = ( time, 5 ); #progressbar foo
6432   while (1) {
6433
6434     my @columns = ();
6435     if ( $type eq 'csv' ) {
6436
6437       last unless scalar(@buffer);
6438       $line = shift(@buffer);
6439
6440       $parser->parse($line) or do {
6441         $dbh->rollback if $oldAutoCommit;
6442         return "can't parse: ". $parser->error_input();
6443       };
6444       @columns = $parser->fields();
6445
6446     } elsif ( $type eq 'xls' ) {
6447
6448       last if $row > ($parser->{MaxRow} || $parser->{MinRow});
6449
6450       my @row = @{ $parser->{Cells}[$row] };
6451       @columns = map $_->{Val}, @row;
6452
6453       #my $z = 'A';
6454       #warn $z++. ": $_\n" for @columns;
6455
6456     } else {
6457       die "Unknown file type $type\n";
6458     }
6459
6460     #warn join('-',@columns);
6461
6462     my %cust_main = (
6463       custbatch => $custbatch,
6464       agentnum  => $agentnum,
6465       refnum    => $refnum,
6466       country   => $conf->config('countrydefault') || 'US',
6467       payby     => $payby, #default
6468       paydate   => '12/2037', #default
6469     );
6470     my $billtime = time;
6471     my %cust_pkg = ( pkgpart => $pkgpart );
6472     my %svc_acct = ();
6473     foreach my $field ( @fields ) {
6474
6475       if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|adjourn|expire|cancel)$/ ) {
6476
6477         #$cust_pkg{$1} = str2time( shift @$columns );
6478         if ( $1 eq 'pkgpart' ) {
6479           $cust_pkg{$1} = shift @columns;
6480         } elsif ( $1 eq 'setup' ) {
6481           $billtime = str2time(shift @columns);
6482         } else {
6483           $cust_pkg{$1} = str2time( shift @columns );
6484         }
6485
6486       } elsif ( $field =~ /^svc_acct\.(username|_password)$/ ) {
6487
6488         $svc_acct{$1} = shift @columns;
6489
6490       } else {
6491
6492         #refnum interception
6493         if ( $field eq 'refnum' && $columns[0] !~ /^\s*(\d+)\s*$/ ) {
6494
6495           my $referral = $columns[0];
6496           my %hash = ( 'referral' => $referral,
6497                        'agentnum' => $agentnum,
6498                        'disabled' => '',
6499                      );
6500
6501           my $part_referral = qsearchs('part_referral', \%hash )
6502                               || new FS::part_referral \%hash;
6503
6504           unless ( $part_referral->refnum ) {
6505             my $error = $part_referral->insert;
6506             if ( $error ) {
6507               $dbh->rollback if $oldAutoCommit;
6508               return "can't auto-insert advertising source: $referral: $error";
6509             }
6510           }
6511
6512           $columns[0] = $part_referral->refnum;
6513         }
6514
6515         my $value = shift @columns;
6516         $cust_main{$field} = $value if length($value);
6517       }
6518     }
6519
6520     $cust_main{'payby'} = 'CARD'
6521       if defined $cust_main{'payinfo'}
6522       && length  $cust_main{'payinfo'};
6523
6524     my $invoicing_list = $cust_main{'invoicing_list'}
6525                            ? [ delete $cust_main{'invoicing_list'} ]
6526                            : [];
6527
6528     my $cust_main = new FS::cust_main ( \%cust_main );
6529
6530     use Tie::RefHash;
6531     tie my %hash, 'Tie::RefHash'; #this part is important
6532
6533     if ( $cust_pkg{'pkgpart'} ) {
6534       my $cust_pkg = new FS::cust_pkg ( \%cust_pkg );
6535
6536       my @svc_acct = ();
6537       if ( $svc_acct{'username'} ) {
6538         my $part_pkg = $cust_pkg->part_pkg;
6539         unless ( $part_pkg ) {
6540           $dbh->rollback if $oldAutoCommit;
6541           return "unknown pkgpart: ". $cust_pkg{'pkgpart'};
6542         }
6543         $svc_acct{svcpart} = $part_pkg->svcpart( 'svc_acct' );
6544         push @svc_acct, new FS::svc_acct ( \%svc_acct )
6545       }
6546
6547       $hash{$cust_pkg} = \@svc_acct;
6548     }
6549
6550     my $error = $cust_main->insert( \%hash, $invoicing_list );
6551
6552     if ( $error ) {
6553       $dbh->rollback if $oldAutoCommit;
6554       return "can't insert customer". ( $line ? " for $line" : '' ). ": $error";
6555     }
6556
6557     if ( $format eq 'simple' ) {
6558
6559       #false laziness w/bill.cgi
6560       $error = $cust_main->bill( 'time' => $billtime );
6561       if ( $error ) {
6562         $dbh->rollback if $oldAutoCommit;
6563         return "can't bill customer for $line: $error";
6564       }
6565
6566       $error = $cust_main->apply_payments_and_credits;
6567       if ( $error ) {
6568         $dbh->rollback if $oldAutoCommit;
6569         return "can't bill customer for $line: $error";
6570       }
6571
6572       $error = $cust_main->collect();
6573       if ( $error ) {
6574         $dbh->rollback if $oldAutoCommit;
6575         return "can't collect customer for $line: $error";
6576       }
6577
6578     }
6579
6580     $row++;
6581
6582     if ( $job && time - $min_sec > $last ) { #progress bar
6583       $job->update_statustext( int(100 * $row / $count) );
6584       $last = time;
6585     }
6586
6587   }
6588
6589   $dbh->commit or die $dbh->errstr if $oldAutoCommit;;
6590
6591   return "Empty file!" unless $row;
6592
6593   ''; #no error
6594
6595 }
6596
6597 =item batch_charge
6598
6599 =cut
6600
6601 sub batch_charge {
6602   my $param = shift;
6603   #warn join('-',keys %$param);
6604   my $fh = $param->{filehandle};
6605   my @fields = @{$param->{fields}};
6606
6607   eval "use Text::CSV_XS;";
6608   die $@ if $@;
6609
6610   my $csv = new Text::CSV_XS;
6611   #warn $csv;
6612   #warn $fh;
6613
6614   my $imported = 0;
6615   #my $columns;
6616
6617   local $SIG{HUP} = 'IGNORE';
6618   local $SIG{INT} = 'IGNORE';
6619   local $SIG{QUIT} = 'IGNORE';
6620   local $SIG{TERM} = 'IGNORE';
6621   local $SIG{TSTP} = 'IGNORE';
6622   local $SIG{PIPE} = 'IGNORE';
6623
6624   my $oldAutoCommit = $FS::UID::AutoCommit;
6625   local $FS::UID::AutoCommit = 0;
6626   my $dbh = dbh;
6627
6628   #while ( $columns = $csv->getline($fh) ) {
6629   my $line;
6630   while ( defined($line=<$fh>) ) {
6631
6632     $csv->parse($line) or do {
6633       $dbh->rollback if $oldAutoCommit;
6634       return "can't parse: ". $csv->error_input();
6635     };
6636
6637     my @columns = $csv->fields();
6638     #warn join('-',@columns);
6639
6640     my %row = ();
6641     foreach my $field ( @fields ) {
6642       $row{$field} = shift @columns;
6643     }
6644
6645     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
6646     unless ( $cust_main ) {
6647       $dbh->rollback if $oldAutoCommit;
6648       return "unknown custnum $row{'custnum'}";
6649     }
6650
6651     if ( $row{'amount'} > 0 ) {
6652       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
6653       if ( $error ) {
6654         $dbh->rollback if $oldAutoCommit;
6655         return $error;
6656       }
6657       $imported++;
6658     } elsif ( $row{'amount'} < 0 ) {
6659       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
6660                                       $row{'pkg'}                         );
6661       if ( $error ) {
6662         $dbh->rollback if $oldAutoCommit;
6663         return $error;
6664       }
6665       $imported++;
6666     } else {
6667       #hmm?
6668     }
6669
6670   }
6671
6672   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6673
6674   return "Empty file!" unless $imported;
6675
6676   ''; #no error
6677
6678 }
6679
6680 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
6681
6682 Sends a templated email notification to the customer (see L<Text::Template>).
6683
6684 OPTIONS is a hash and may include
6685
6686 I<from> - the email sender (default is invoice_from)
6687
6688 I<to> - comma-separated scalar or arrayref of recipients
6689    (default is invoicing_list)
6690
6691 I<subject> - The subject line of the sent email notification
6692    (default is "Notice from company_name")
6693
6694 I<extra_fields> - a hashref of name/value pairs which will be substituted
6695    into the template
6696
6697 The following variables are vavailable in the template.
6698
6699 I<$first> - the customer first name
6700 I<$last> - the customer last name
6701 I<$company> - the customer company
6702 I<$payby> - a description of the method of payment for the customer
6703             # would be nice to use FS::payby::shortname
6704 I<$payinfo> - the account information used to collect for this customer
6705 I<$expdate> - the expiration of the customer payment in seconds from epoch
6706
6707 =cut
6708
6709 sub notify {
6710   my ($customer, $template, %options) = @_;
6711
6712   return unless $conf->exists($template);
6713
6714   my $from = $conf->config('invoice_from') if $conf->exists('invoice_from');
6715   $from = $options{from} if exists($options{from});
6716
6717   my $to = join(',', $customer->invoicing_list_emailonly);
6718   $to = $options{to} if exists($options{to});
6719
6720   my $subject = "Notice from " . $conf->config('company_name')
6721     if $conf->exists('company_name');
6722   $subject = $options{subject} if exists($options{subject});
6723
6724   my $notify_template = new Text::Template (TYPE => 'ARRAY',
6725                                             SOURCE => [ map "$_\n",
6726                                               $conf->config($template)]
6727                                            )
6728     or die "can't create new Text::Template object: Text::Template::ERROR";
6729   $notify_template->compile()
6730     or die "can't compile template: Text::Template::ERROR";
6731
6732   $FS::notify_template::_template::company_name = $conf->config('company_name');
6733   $FS::notify_template::_template::company_address =
6734     join("\n", $conf->config('company_address') ). "\n";
6735
6736   my $paydate = $customer->paydate || '2037-12-31';
6737   $FS::notify_template::_template::first = $customer->first;
6738   $FS::notify_template::_template::last = $customer->last;
6739   $FS::notify_template::_template::company = $customer->company;
6740   $FS::notify_template::_template::payinfo = $customer->mask_payinfo;
6741   my $payby = $customer->payby;
6742   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6743   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6744
6745   #credit cards expire at the end of the month/year of their exp date
6746   if ($payby eq 'CARD' || $payby eq 'DCRD') {
6747     $FS::notify_template::_template::payby = 'credit card';
6748     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6749     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6750     $expire_time--;
6751   }elsif ($payby eq 'COMP') {
6752     $FS::notify_template::_template::payby = 'complimentary account';
6753   }else{
6754     $FS::notify_template::_template::payby = 'current method';
6755   }
6756   $FS::notify_template::_template::expdate = $expire_time;
6757
6758   for (keys %{$options{extra_fields}}){
6759     no strict "refs";
6760     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
6761   }
6762
6763   send_email(from => $from,
6764              to => $to,
6765              subject => $subject,
6766              body => $notify_template->fill_in( PACKAGE =>
6767                                                 'FS::notify_template::_template'                                              ),
6768             );
6769
6770 }
6771
6772 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
6773
6774 Generates a templated notification to the customer (see L<Text::Template>).
6775
6776 OPTIONS is a hash and may include
6777
6778 I<extra_fields> - a hashref of name/value pairs which will be substituted
6779    into the template.  These values may override values mentioned below
6780    and those from the customer record.
6781
6782 The following variables are available in the template instead of or in addition
6783 to the fields of the customer record.
6784
6785 I<$payby> - a description of the method of payment for the customer
6786             # would be nice to use FS::payby::shortname
6787 I<$payinfo> - the masked account information used to collect for this customer
6788 I<$expdate> - the expiration of the customer payment method in seconds from epoch
6789 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
6790
6791 =cut
6792
6793 sub generate_letter {
6794   my ($self, $template, %options) = @_;
6795
6796   return unless $conf->exists($template);
6797
6798   my $letter_template = new Text::Template
6799                         ( TYPE       => 'ARRAY',
6800                           SOURCE     => [ map "$_\n", $conf->config($template)],
6801                           DELIMITERS => [ '[@--', '--@]' ],
6802                         )
6803     or die "can't create new Text::Template object: Text::Template::ERROR";
6804
6805   $letter_template->compile()
6806     or die "can't compile template: Text::Template::ERROR";
6807
6808   my %letter_data = map { $_ => $self->$_ } $self->fields;
6809   $letter_data{payinfo} = $self->mask_payinfo;
6810
6811   #my $paydate = $self->paydate || '2037-12-31';
6812   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
6813
6814   my $payby = $self->payby;
6815   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6816   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6817
6818   #credit cards expire at the end of the month/year of their exp date
6819   if ($payby eq 'CARD' || $payby eq 'DCRD') {
6820     $letter_data{payby} = 'credit card';
6821     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6822     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6823     $expire_time--;
6824   }elsif ($payby eq 'COMP') {
6825     $letter_data{payby} = 'complimentary account';
6826   }else{
6827     $letter_data{payby} = 'current method';
6828   }
6829   $letter_data{expdate} = $expire_time;
6830
6831   for (keys %{$options{extra_fields}}){
6832     $letter_data{$_} = $options{extra_fields}->{$_};
6833   }
6834
6835   unless(exists($letter_data{returnaddress})){
6836     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
6837                                                   $self->agent_template)
6838                      );
6839     if ( length($retadd) ) {
6840       $letter_data{returnaddress} = $retadd;
6841     } elsif ( grep /\S/, $conf->config('company_address') ) {
6842       $letter_data{returnaddress} =
6843         join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
6844                           $conf->config('company_address')
6845         );
6846     } else {
6847       $letter_data{returnaddress} = '~';
6848     }
6849   }
6850
6851   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
6852
6853   $letter_data{company_name} = $conf->config('company_name');
6854
6855   my $dir = $FS::UID::conf_dir."cache.". $FS::UID::datasrc;
6856   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
6857                            DIR      => $dir,
6858                            SUFFIX   => '.tex',
6859                            UNLINK   => 0,
6860                          ) or die "can't open temp file: $!\n";
6861
6862   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
6863   close $fh;
6864   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
6865   return $1;
6866 }
6867
6868 =item print_ps TEMPLATE
6869
6870 Returns an postscript letter filled in from TEMPLATE, as a scalar.
6871
6872 =cut
6873
6874 sub print_ps {
6875   my $self = shift;
6876   my $file = $self->generate_letter(@_);
6877   FS::Misc::generate_ps($file);
6878 }
6879
6880 =item print TEMPLATE
6881
6882 Prints the filled in template.
6883
6884 TEMPLATE is the name of a L<Text::Template> to fill in and print.
6885
6886 =cut
6887
6888 sub queueable_print {
6889   my %opt = @_;
6890
6891   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
6892     or die "invalid customer number: " . $opt{custvnum};
6893
6894   my $error = $self->print( $opt{template} );
6895   die $error if $error;
6896 }
6897
6898 sub print {
6899   my ($self, $template) = (shift, shift);
6900   do_print [ $self->print_ps($template) ];
6901 }
6902
6903 sub agent_template {
6904   my $self = shift;
6905   $self->_agent_plandata('agent_templatename');
6906 }
6907
6908 sub agent_invoice_from {
6909   my $self = shift;
6910   $self->_agent_plandata('agent_invoice_from');
6911 }
6912
6913 sub _agent_plandata {
6914   my( $self, $option ) = @_;
6915
6916   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
6917   #agent-specific Conf
6918
6919   use FS::part_event::Condition;
6920
6921   my $agentnum = $self->agentnum;
6922
6923   my $regexp = '';
6924   if ( driver_name =~ /^Pg/i ) {
6925     $regexp = '~';
6926   } elsif ( driver_name =~ /^mysql/i ) {
6927     $regexp = 'REGEXP';
6928   } else {
6929     die "don't know how to use regular expressions in ". driver_name. " databases";
6930   }
6931
6932   my $part_event_option =
6933     qsearchs({
6934       'select'    => 'part_event_option.*',
6935       'table'     => 'part_event_option',
6936       'addl_from' => q{
6937         LEFT JOIN part_event USING ( eventpart )
6938         LEFT JOIN part_event_option AS peo_agentnum
6939           ON ( part_event.eventpart = peo_agentnum.eventpart
6940                AND peo_agentnum.optionname = 'agentnum'
6941                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
6942              )
6943         LEFT JOIN part_event_option AS peo_cust_bill_age
6944           ON ( part_event.eventpart = peo_cust_bill_age.eventpart
6945                AND peo_cust_bill_age.optionname = 'cust_bill_age'
6946              )
6947       },
6948       #'hashref'   => { 'optionname' => $option },
6949       #'hashref'   => { 'part_event_option.optionname' => $option },
6950       'extra_sql' =>
6951         " WHERE part_event_option.optionname = ". dbh->quote($option).
6952         " AND action = 'cust_bill_send_agent' ".
6953         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
6954         " AND peo_agentnum.optionname = 'agentnum' ".
6955         " AND agentnum IS NULL OR agentnum = $agentnum ".
6956         " ORDER BY
6957            CASE WHEN peo_cust_bill_age.optionname != 'cust_bill_age'
6958            THEN -1
6959            ELSE ". FS::part_event::Condition->age2seconds_sql('peo_cust_bill_age.optionvalue').
6960         " END
6961           , part_event.weight".
6962         " LIMIT 1"
6963     });
6964
6965   unless ( $part_event_option ) {
6966     return $self->agent->invoice_template || ''
6967       if $option eq 'agent_templatename';
6968     return '';
6969   }
6970
6971   $part_event_option->optionvalue;
6972
6973 }
6974
6975 sub queued_bill {
6976   ## actual sub, not a method, designed to be called from the queue.
6977   ## sets up the customer, and calls the bill_and_collect
6978   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
6979   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
6980       $cust_main->bill_and_collect(
6981         %args,
6982       );
6983 }
6984
6985 =back
6986
6987 =head1 BUGS
6988
6989 The delete method.
6990
6991 The delete method should possibly take an FS::cust_main object reference
6992 instead of a scalar customer number.
6993
6994 Bill and collect options should probably be passed as references instead of a
6995 list.
6996
6997 There should probably be a configuration file with a list of allowed credit
6998 card types.
6999
7000 No multiple currency support (probably a larger project than just this module).
7001
7002 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
7003
7004 Birthdates rely on negative epoch values.
7005
7006 The payby for card/check batches is broken.  With mixed batching, bad
7007 things will happen.
7008
7009 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
7010
7011 =head1 SEE ALSO
7012
7013 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
7014 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
7015 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
7016
7017 =cut
7018
7019 1;
7020