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