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