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