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