FS/FS/cust_main.pm

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