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