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