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