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