FS/FS/cust_main.pm

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