FS/FS/cust_main.pm

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