FS/FS/cust_main.pm

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