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