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