FS/FS/cust_main.pm

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