FS/FS/cust_main.pm

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