FS/FS/cust_main.pm

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