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