FS/FS/cust_main.pm

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