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