FS/FS/cust_main.pm

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