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