FS/FS/cust_main.pm

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