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