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