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(join('\n',$conf->config('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     || $self->ut_textn('invoice_terms')
1226   ;
1227   #barf.  need message catalogs.  i18n.  etc.
1228   $error .= "Please select an advertising source."
1229     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1230   return $error if $error;
1231
1232   return "Unknown agent"
1233     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1234
1235   return "Unknown refnum"
1236     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1237
1238   return "Unknown referring custnum: ". $self->referral_custnum
1239     unless ! $self->referral_custnum
1240            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1241
1242   if ( $self->ss eq '' ) {
1243     $self->ss('');
1244   } else {
1245     my $ss = $self->ss;
1246     $ss =~ s/\D//g;
1247     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1248       or return "Illegal social security number: ". $self->ss;
1249     $self->ss("$1-$2-$3");
1250   }
1251
1252
1253 # bad idea to disable, causes billing to fail because of no tax rates later
1254 #  unless ( $import ) {
1255     unless ( qsearch('cust_main_county', {
1256       'country' => $self->country,
1257       'state'   => '',
1258      } ) ) {
1259       return "Unknown state/county/country: ".
1260         $self->state. "/". $self->county. "/". $self->country
1261         unless qsearch('cust_main_county',{
1262           'state'   => $self->state,
1263           'county'  => $self->county,
1264           'country' => $self->country,
1265         } );
1266     }
1267 #  }
1268
1269   $error =
1270     $self->ut_phonen('daytime', $self->country)
1271     || $self->ut_phonen('night', $self->country)
1272     || $self->ut_phonen('fax', $self->country)
1273     || $self->ut_zip('zip', $self->country)
1274   ;
1275   return $error if $error;
1276
1277   my @addfields = qw(
1278     last first company address1 address2 city county state zip
1279     country daytime night fax
1280   );
1281
1282   if ( defined $self->dbdef_table->column('ship_last') ) {
1283     if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1284                        @addfields )
1285          && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
1286        )
1287     {
1288       my $error =
1289         $self->ut_name('ship_last')
1290         || $self->ut_name('ship_first')
1291         || $self->ut_textn('ship_company')
1292         || $self->ut_text('ship_address1')
1293         || $self->ut_textn('ship_address2')
1294         || $self->ut_text('ship_city')
1295         || $self->ut_textn('ship_county')
1296         || $self->ut_textn('ship_state')
1297         || $self->ut_country('ship_country')
1298       ;
1299       return $error if $error;
1300
1301       #false laziness with above
1302       unless ( qsearchs('cust_main_county', {
1303         'country' => $self->ship_country,
1304         'state'   => '',
1305        } ) ) {
1306         return "Unknown ship_state/ship_county/ship_country: ".
1307           $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1308           unless qsearch('cust_main_county',{
1309             'state'   => $self->ship_state,
1310             'county'  => $self->ship_county,
1311             'country' => $self->ship_country,
1312           } );
1313       }
1314       #eofalse
1315
1316       $error =
1317         $self->ut_phonen('ship_daytime', $self->ship_country)
1318         || $self->ut_phonen('ship_night', $self->ship_country)
1319         || $self->ut_phonen('ship_fax', $self->ship_country)
1320         || $self->ut_zip('ship_zip', $self->ship_country)
1321       ;
1322       return $error if $error;
1323
1324     } else { # ship_ info eq billing info, so don't store dup info in database
1325       $self->setfield("ship_$_", '')
1326         foreach qw( last first company address1 address2 city county state zip
1327                     country daytime night fax );
1328     }
1329   }
1330
1331   #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1332   #  or return "Illegal payby: ". $self->payby;
1333   #$self->payby($1);
1334   FS::payby->can_payby($self->table, $self->payby)
1335     or return "Illegal payby: ". $self->payby;
1336
1337   $error =    $self->ut_numbern('paystart_month')
1338            || $self->ut_numbern('paystart_year')
1339            || $self->ut_numbern('payissue')
1340            || $self->ut_textn('paytype')
1341   ;
1342   return $error if $error;
1343
1344   if ( $self->payip eq '' ) {
1345     $self->payip('');
1346   } else {
1347     $error = $self->ut_ip('payip');
1348     return $error if $error;
1349   }
1350
1351   # If it is encrypted and the private key is not availaible then we can't
1352   # check the credit card.
1353
1354   my $check_payinfo = 1;
1355
1356   if ($self->is_encrypted($self->payinfo)) {
1357     $check_payinfo = 0;
1358   }
1359
1360   if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1361
1362     my $payinfo = $self->payinfo;
1363     $payinfo =~ s/\D//g;
1364     $payinfo =~ /^(\d{13,16})$/
1365       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1366     $payinfo = $1;
1367     $self->payinfo($payinfo);
1368     validate($payinfo)
1369       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1370
1371     return gettext('unknown_card_type')
1372       if cardtype($self->payinfo) eq "Unknown";
1373
1374     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1375     if ( $ban ) {
1376       return 'Banned credit card: banned on '.
1377              time2str('%a %h %o at %r', $ban->_date).
1378              ' by '. $ban->otaker.
1379              ' (ban# '. $ban->bannum. ')';
1380     }
1381
1382     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1383       if ( cardtype($self->payinfo) eq 'American Express card' ) {
1384         $self->paycvv =~ /^(\d{4})$/
1385           or return "CVV2 (CID) for American Express cards is four digits.";
1386         $self->paycvv($1);
1387       } else {
1388         $self->paycvv =~ /^(\d{3})$/
1389           or return "CVV2 (CVC2/CID) is three digits.";
1390         $self->paycvv($1);
1391       }
1392     } else {
1393       $self->paycvv('');
1394     }
1395
1396     my $cardtype = cardtype($payinfo);
1397     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1398
1399       return "Start date or issue number is required for $cardtype cards"
1400         unless $self->paystart_month && $self->paystart_year or $self->payissue;
1401
1402       return "Start month must be between 1 and 12"
1403         if $self->paystart_month
1404            and $self->paystart_month < 1 || $self->paystart_month > 12;
1405
1406       return "Start year must be 1990 or later"
1407         if $self->paystart_year
1408            and $self->paystart_year < 1990;
1409
1410       return "Issue number must be beween 1 and 99"
1411         if $self->payissue
1412           and $self->payissue < 1 || $self->payissue > 99;
1413
1414     } else {
1415       $self->paystart_month('');
1416       $self->paystart_year('');
1417       $self->payissue('');
1418     }
1419
1420   } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1421
1422     my $payinfo = $self->payinfo;
1423     $payinfo =~ s/[^\d\@]//g;
1424     if ( $conf->exists('echeck-nonus') ) {
1425       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1426       $payinfo = "$1\@$2";
1427     } else {
1428       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1429       $payinfo = "$1\@$2";
1430     }
1431     $self->payinfo($payinfo);
1432     $self->paycvv('');
1433
1434     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1435     if ( $ban ) {
1436       return 'Banned ACH account: banned on '.
1437              time2str('%a %h %o at %r', $ban->_date).
1438              ' by '. $ban->otaker.
1439              ' (ban# '. $ban->bannum. ')';
1440     }
1441
1442   } elsif ( $self->payby eq 'LECB' ) {
1443
1444     my $payinfo = $self->payinfo;
1445     $payinfo =~ s/\D//g;
1446     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1447     $payinfo = $1;
1448     $self->payinfo($payinfo);
1449     $self->paycvv('');
1450
1451   } elsif ( $self->payby eq 'BILL' ) {
1452
1453     $error = $self->ut_textn('payinfo');
1454     return "Illegal P.O. number: ". $self->payinfo if $error;
1455     $self->paycvv('');
1456
1457   } elsif ( $self->payby eq 'COMP' ) {
1458
1459     my $curuser = $FS::CurrentUser::CurrentUser;
1460     if (    ! $self->custnum
1461          && ! $curuser->access_right('Complimentary customer')
1462        )
1463     {
1464       return "You are not permitted to create complimentary accounts."
1465     }
1466
1467     $error = $self->ut_textn('payinfo');
1468     return "Illegal comp account issuer: ". $self->payinfo if $error;
1469     $self->paycvv('');
1470
1471   } elsif ( $self->payby eq 'PREPAY' ) {
1472
1473     my $payinfo = $self->payinfo;
1474     $payinfo =~ s/\W//g; #anything else would just confuse things
1475     $self->payinfo($payinfo);
1476     $error = $self->ut_alpha('payinfo');
1477     return "Illegal prepayment identifier: ". $self->payinfo if $error;
1478     return "Unknown prepayment identifier"
1479       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1480     $self->paycvv('');
1481
1482   }
1483
1484   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1485     return "Expiration date required"
1486       unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1487     $self->paydate('');
1488   } else {
1489     my( $m, $y );
1490     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1491       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1492     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1493       ( $m, $y ) = ( $3, "20$2" );
1494     } else {
1495       return "Illegal expiration date: ". $self->paydate;
1496     }
1497     $self->paydate("$y-$m-01");
1498     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1499     return gettext('expired_card')
1500       if !$import
1501       && !$ignore_expired_card
1502       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1503   }
1504
1505   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1506        ( ! $conf->exists('require_cardname')
1507          || $self->payby !~ /^(CARD|DCRD)$/  )
1508   ) {
1509     $self->payname( $self->first. " ". $self->getfield('last') );
1510   } else {
1511     $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1512       or return gettext('illegal_name'). " payname: ". $self->payname;
1513     $self->payname($1);
1514   }
1515
1516   foreach my $flag (qw( tax spool_cdr )) {
1517     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1518     $self->$flag($1);
1519   }
1520
1521   $self->otaker(getotaker) unless $self->otaker;
1522
1523   warn "$me check AFTER: \n". $self->_dump
1524     if $DEBUG > 2;
1525
1526   $self->SUPER::check;
1527 }
1528
1529 =item all_pkgs
1530
1531 Returns all packages (see L<FS::cust_pkg>) for this customer.
1532
1533 =cut
1534
1535 sub all_pkgs {
1536   my $self = shift;
1537
1538   return $self->num_pkgs unless wantarray;
1539
1540   my @cust_pkg = ();
1541   if ( $self->{'_pkgnum'} ) {
1542     @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
1543   } else {
1544     @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1545   }
1546
1547   sort sort_packages @cust_pkg;
1548 }
1549
1550 =item ncancelled_pkgs
1551
1552 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1553
1554 =cut
1555
1556 sub ncancelled_pkgs {
1557   my $self = shift;
1558
1559   return $self->num_ncancelled_pkgs unless wantarray;
1560
1561   my @cust_pkg = ();
1562   if ( $self->{'_pkgnum'} ) {
1563
1564     @cust_pkg = grep { ! $_->getfield('cancel') }
1565                 values %{ $self->{'_pkgnum'}->cache };
1566
1567   } else {
1568
1569     @cust_pkg =
1570       qsearch( 'cust_pkg', {
1571                              'custnum' => $self->custnum,
1572                              'cancel'  => '',
1573                            });
1574     push @cust_pkg,
1575       qsearch( 'cust_pkg', {
1576                              'custnum' => $self->custnum,
1577                              'cancel'  => 0,
1578                            });
1579   }
1580
1581   sort sort_packages @cust_pkg;
1582
1583 }
1584
1585 # This should be generalized to use config options to determine order.
1586 sub sort_packages {
1587   if ( $a->get('cancel') and $b->get('cancel') ) {
1588     $a->pkgnum <=> $b->pkgnum;
1589   } elsif ( $a->get('cancel') or $b->get('cancel') ) {
1590     return -1 if $b->get('cancel');
1591     return  1 if $a->get('cancel');
1592     return 0;
1593   } else {
1594     $a->pkgnum <=> $b->pkgnum;
1595   }
1596 }
1597
1598 =item suspended_pkgs
1599
1600 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1601
1602 =cut
1603
1604 sub suspended_pkgs {
1605   my $self = shift;
1606   grep { $_->susp } $self->ncancelled_pkgs;
1607 }
1608
1609 =item unflagged_suspended_pkgs
1610
1611 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1612 customer (thouse packages without the `manual_flag' set).
1613
1614 =cut
1615
1616 sub unflagged_suspended_pkgs {
1617   my $self = shift;
1618   return $self->suspended_pkgs
1619     unless dbdef->table('cust_pkg')->column('manual_flag');
1620   grep { ! $_->manual_flag } $self->suspended_pkgs;
1621 }
1622
1623 =item unsuspended_pkgs
1624
1625 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1626 this customer.
1627
1628 =cut
1629
1630 sub unsuspended_pkgs {
1631   my $self = shift;
1632   grep { ! $_->susp } $self->ncancelled_pkgs;
1633 }
1634
1635 =item num_cancelled_pkgs
1636
1637 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1638 customer.
1639
1640 =cut
1641
1642 sub num_cancelled_pkgs {
1643   shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
1644 }
1645
1646 sub num_ncancelled_pkgs {
1647   shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
1648 }
1649
1650 sub num_pkgs {
1651   my( $self, $sql ) = @_;
1652   $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
1653   my $sth = dbh->prepare(
1654     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
1655   ) or die dbh->errstr;
1656   $sth->execute($self->custnum) or die $sth->errstr;
1657   $sth->fetchrow_arrayref->[0];
1658 }
1659
1660 =item unsuspend
1661
1662 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1663 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
1664 on success or a list of errors.
1665
1666 =cut
1667
1668 sub unsuspend {
1669   my $self = shift;
1670   grep { $_->unsuspend } $self->suspended_pkgs;
1671 }
1672
1673 =item suspend
1674
1675 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1676
1677 Returns a list: an empty list on success or a list of errors.
1678
1679 =cut
1680
1681 sub suspend {
1682   my $self = shift;
1683   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
1684 }
1685
1686 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1687
1688 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1689 PKGPARTs (see L<FS::part_pkg>).
1690
1691 Returns a list: an empty list on success or a list of errors.
1692
1693 =cut
1694
1695 sub suspend_if_pkgpart {
1696   my $self = shift;
1697   my (@pkgparts, %opt);
1698   if (ref($_[0]) eq 'HASH'){
1699     @pkgparts = @{$_[0]{pkgparts}};
1700     %opt      = %{$_[0]};
1701   }else{
1702     @pkgparts = @_;
1703   }
1704   grep { $_->suspend(%opt) }
1705     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1706       $self->unsuspended_pkgs;
1707 }
1708
1709 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1710
1711 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1712 listed PKGPARTs (see L<FS::part_pkg>).
1713
1714 Returns a list: an empty list on success or a list of errors.
1715
1716 =cut
1717
1718 sub suspend_unless_pkgpart {
1719   my $self = shift;
1720   my (@pkgparts, %opt);
1721   if (ref($_[0]) eq 'HASH'){
1722     @pkgparts = @{$_[0]{pkgparts}};
1723     %opt      = %{$_[0]};
1724   }else{
1725     @pkgparts = @_;
1726   }
1727   grep { $_->suspend(%opt) }
1728     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1729       $self->unsuspended_pkgs;
1730 }
1731
1732 =item cancel [ OPTION => VALUE ... ]
1733
1734 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1735
1736 Available options are: I<quiet>, I<reasonnum>, and I<ban>
1737
1738 I<quiet> can be set true to supress email cancellation notices.
1739
1740 # I<reasonnum> can be set to a cancellation reason (see L<FS::cancel_reason>)
1741
1742 I<ban> can be set true to ban this customer's credit card or ACH information,
1743 if present.
1744
1745 Always returns a list: an empty list on success or a list of errors.
1746
1747 =cut
1748
1749 sub cancel {
1750   my $self = shift;
1751   my %opt = @_;
1752
1753   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1754
1755     #should try decryption (we might have the private key)
1756     # and if not maybe queue a job for the server that does?
1757     return ( "Can't (yet) ban encrypted credit cards" )
1758       if $self->is_encrypted($self->payinfo);
1759
1760     my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1761     my $error = $ban->insert;
1762     return ( $error ) if $error;
1763
1764   }
1765
1766   grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1767 }
1768
1769 sub _banned_pay_hashref {
1770   my $self = shift;
1771
1772   my %payby2ban = (
1773     'CARD' => 'CARD',
1774     'DCRD' => 'CARD',
1775     'CHEK' => 'CHEK',
1776     'DCHK' => 'CHEK'
1777   );
1778
1779   {
1780     'payby'   => $payby2ban{$self->payby},
1781     'payinfo' => md5_base64($self->payinfo),
1782     #don't ever *search* on reason! #'reason'  =>
1783   };
1784 }
1785
1786 =item notes
1787
1788 Returns all notes (see L<FS::cust_main_note>) for this customer.
1789
1790 =cut
1791
1792 sub notes {
1793   my $self = shift;
1794   #order by?
1795   qsearch( 'cust_main_note',
1796            { 'custnum' => $self->custnum },
1797            '',
1798            'ORDER BY _DATE DESC'
1799          );
1800 }
1801
1802 =item agent
1803
1804 Returns the agent (see L<FS::agent>) for this customer.
1805
1806 =cut
1807
1808 sub agent {
1809   my $self = shift;
1810   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1811 }
1812
1813 =item bill OPTIONS
1814
1815 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
1816 conjunction with the collect method.
1817
1818 Options are passed as name-value pairs.
1819
1820 Currently available options are:
1821
1822 resetup - if set true, re-charges setup fees.
1823
1824 time - bills the customer as if it were that time.  Specified as a UNIX
1825 timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and
1826 L<Date::Parse> for conversion functions.  For example:
1827
1828  use Date::Parse;
1829  ...
1830  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1831
1832
1833 If there is an error, returns the error, otherwise returns false.
1834
1835 =cut
1836
1837 sub bill {
1838   my( $self, %options ) = @_;
1839   return '' if $self->payby eq 'COMP';
1840   warn "$me bill customer ". $self->custnum. "\n"
1841     if $DEBUG;
1842
1843   my $time = $options{'time'} || time;
1844
1845   my $error;
1846
1847   #put below somehow?
1848   local $SIG{HUP} = 'IGNORE';
1849   local $SIG{INT} = 'IGNORE';
1850   local $SIG{QUIT} = 'IGNORE';
1851   local $SIG{TERM} = 'IGNORE';
1852   local $SIG{TSTP} = 'IGNORE';
1853   local $SIG{PIPE} = 'IGNORE';
1854
1855   my $oldAutoCommit = $FS::UID::AutoCommit;
1856   local $FS::UID::AutoCommit = 0;
1857   my $dbh = dbh;
1858
1859   $self->select_for_update; #mutex
1860
1861   #create a new invoice
1862   #(we'll remove it later if it doesn't actually need to be generated [contains
1863   # no line items] and we're inside a transaciton so nothing else will see it)
1864   my $cust_bill = new FS::cust_bill ( {
1865     'custnum' => $self->custnum,
1866     '_date'   => $time,
1867     #'charged' => $charged,
1868     'charged' => 0,
1869   } );
1870   $error = $cust_bill->insert;
1871   if ( $error ) {
1872     $dbh->rollback if $oldAutoCommit;
1873     return "can't create invoice for customer #". $self->custnum. ": $error";
1874   }
1875   my $invnum = $cust_bill->invnum;
1876
1877   ###
1878   # find the packages which are due for billing, find out how much they are
1879   # & generate invoice database.
1880   ###
1881
1882   my( $total_setup, $total_recur ) = ( 0, 0 );
1883   my %tax;
1884   my @precommit_hooks = ();
1885
1886   foreach my $cust_pkg (
1887     qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1888   ) {
1889
1890     #NO!! next if $cust_pkg->cancel;
1891     next if $cust_pkg->getfield('cancel');
1892
1893     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
1894
1895     #? to avoid use of uninitialized value errors... ?
1896     $cust_pkg->setfield('bill', '')
1897       unless defined($cust_pkg->bill);
1898
1899     my $part_pkg = $cust_pkg->part_pkg;
1900
1901     my %hash = $cust_pkg->hash;
1902     my $old_cust_pkg = new FS::cust_pkg \%hash;
1903
1904     my @details = ();
1905
1906     ###
1907     # bill setup
1908     ###
1909
1910     my $setup = 0;
1911     if ( ! $cust_pkg->setup &&
1912          (
1913            ( $conf->exists('disable_setup_suspended_pkgs') &&
1914             ! $cust_pkg->getfield('susp')
1915           ) || ! $conf->exists('disable_setup_suspended_pkgs')
1916          )
1917       || $options{'resetup'}
1918     ) {
1919
1920       warn "    bill setup\n" if $DEBUG > 1;
1921
1922       $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
1923       if ( $@ ) {
1924         $dbh->rollback if $oldAutoCommit;
1925         return "$@ running calc_setup for $cust_pkg\n";
1926       }
1927
1928       $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1929     }
1930
1931     ###
1932     # bill recurring fee
1933     ###
1934
1935     my $recur = 0;
1936     my $sdate;
1937     if ( $part_pkg->getfield('freq') ne '0' &&
1938          ! $cust_pkg->getfield('susp') &&
1939          ( $cust_pkg->getfield('bill') || 0 ) <= $time
1940     ) {
1941
1942       warn "    bill recur\n" if $DEBUG > 1;
1943
1944       # XXX shared with $recur_prog
1945       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1946
1947       #over two params!  lets at least switch to a hashref for the rest...
1948       my %param = ( 'precommit_hooks' => \@precommit_hooks, );
1949
1950       $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
1951       if ( $@ ) {
1952         $dbh->rollback if $oldAutoCommit;
1953         return "$@ running calc_recur for $cust_pkg\n";
1954       }
1955
1956       #change this bit to use Date::Manip? CAREFUL with timezones (see
1957       # mailing list archive)
1958       my ($sec,$min,$hour,$mday,$mon,$year) =
1959         (localtime($sdate) )[0,1,2,3,4,5];
1960
1961       #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1962       # only for figuring next bill date, nothing else, so, reset $sdate again
1963       # here
1964       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1965       $cust_pkg->last_bill($sdate)
1966         if $cust_pkg->dbdef_table->column('last_bill');
1967
1968       if ( $part_pkg->freq =~ /^\d+$/ ) {
1969         $mon += $part_pkg->freq;
1970         until ( $mon < 12 ) { $mon -= 12; $year++; }
1971       } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1972         my $weeks = $1;
1973         $mday += $weeks * 7;
1974       } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1975         my $days = $1;
1976         $mday += $days;
1977       } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
1978         my $hours = $1;
1979         $hour += $hours;
1980       } else {
1981         $dbh->rollback if $oldAutoCommit;
1982         return "unparsable frequency: ". $part_pkg->freq;
1983       }
1984       $cust_pkg->setfield('bill',
1985         timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1986     }
1987
1988     warn "\$setup is undefined" unless defined($setup);
1989     warn "\$recur is undefined" unless defined($recur);
1990     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1991
1992     ###
1993     # If $cust_pkg has been modified, update it and create cust_bill_pkg records
1994     ###
1995
1996     if ( $cust_pkg->modified ) {  # hmmm.. and if the options are modified?
1997
1998       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
1999         if $DEBUG >1;
2000
2001       $error=$cust_pkg->replace($old_cust_pkg,
2002                                 options => { $cust_pkg->options },
2003                                );
2004       if ( $error ) { #just in case
2005         $dbh->rollback if $oldAutoCommit;
2006         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
2007       }
2008
2009       $setup = sprintf( "%.2f", $setup );
2010       $recur = sprintf( "%.2f", $recur );
2011       if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
2012         $dbh->rollback if $oldAutoCommit;
2013         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
2014       }
2015       if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
2016         $dbh->rollback if $oldAutoCommit;
2017         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
2018       }
2019
2020       if ( $setup != 0 || $recur != 0 ) {
2021
2022         warn "    charges (setup=$setup, recur=$recur); adding line items\n"
2023           if $DEBUG > 1;
2024         my $cust_bill_pkg = new FS::cust_bill_pkg ({
2025           'invnum'  => $invnum,
2026           'pkgnum'  => $cust_pkg->pkgnum,
2027           'setup'   => $setup,
2028           'recur'   => $recur,
2029           'sdate'   => $sdate,
2030           'edate'   => $cust_pkg->bill,
2031           'details' => \@details,
2032         });
2033         $error = $cust_bill_pkg->insert;
2034         if ( $error ) {
2035           $dbh->rollback if $oldAutoCommit;
2036           return "can't create invoice line item for invoice #$invnum: $error";
2037         }
2038         $total_setup += $setup;
2039         $total_recur += $recur;
2040
2041         ###
2042         # handle taxes
2043         ###
2044
2045         unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
2046
2047           my $prefix =
2048             ( $conf->exists('tax-ship_address') && length($self->ship_last) )
2049             ? 'ship_'
2050             : '';
2051           my %taxhash = map { $_ => $self->get("$prefix$_") }
2052                             qw( state county country );
2053
2054           $taxhash{'taxclass'} = $part_pkg->taxclass;
2055
2056           my @taxes = qsearch( 'cust_main_county', \%taxhash );
2057
2058           unless ( @taxes ) {
2059             $taxhash{'taxclass'} = '';
2060             @taxes =  qsearch( 'cust_main_county', \%taxhash );
2061           }
2062
2063           #one more try at a whole-country tax rate
2064           unless ( @taxes ) {
2065             $taxhash{$_} = '' foreach qw( state county );
2066             @taxes =  qsearch( 'cust_main_county', \%taxhash );
2067           }
2068
2069           # maybe eliminate this entirely, along with all the 0% records
2070           unless ( @taxes ) {
2071             $dbh->rollback if $oldAutoCommit;
2072             return
2073               "fatal: can't find tax rate for state/county/country/taxclass ".
2074               join('/', ( map $self->get("$prefix$_"),
2075                               qw(state county country)
2076                         ),
2077                         $part_pkg->taxclass ). "\n";
2078           }
2079
2080           foreach my $tax ( @taxes ) {
2081
2082             my $taxable_charged = 0;
2083             $taxable_charged += $setup
2084               unless $part_pkg->setuptax =~ /^Y$/i
2085                   || $tax->setuptax =~ /^Y$/i;
2086             $taxable_charged += $recur
2087               unless $part_pkg->recurtax =~ /^Y$/i
2088                   || $tax->recurtax =~ /^Y$/i;
2089             next unless $taxable_charged;
2090
2091             if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
2092               #my ($mon,$year) = (localtime($sdate) )[4,5];
2093               my ($mon,$year) = (localtime( $sdate || $cust_bill->_date ) )[4,5];
2094               $mon++;
2095               my $freq = $part_pkg->freq || 1;
2096               if ( $freq !~ /(\d+)$/ ) {
2097                 $dbh->rollback if $oldAutoCommit;
2098                 return "daily/weekly package definitions not (yet?)".
2099                        " compatible with monthly tax exemptions";
2100               }
2101               my $taxable_per_month =
2102                 sprintf("%.2f", $taxable_charged / $freq );
2103
2104               #call the whole thing off if this customer has any old
2105               #exemption records...
2106               my @cust_tax_exempt =
2107                 qsearch( 'cust_tax_exempt' => { custnum=> $self->custnum } );
2108               if ( @cust_tax_exempt ) {
2109                 $dbh->rollback if $oldAutoCommit;
2110                 return
2111                   'this customer still has old-style tax exemption records; '.
2112                   'run bin/fs-migrate-cust_tax_exempt?';
2113               }
2114
2115               foreach my $which_month ( 1 .. $freq ) {
2116
2117                 #maintain the new exemption table now
2118                 my $sql = "
2119                   SELECT SUM(amount)
2120                     FROM cust_tax_exempt_pkg
2121                       LEFT JOIN cust_bill_pkg USING ( billpkgnum )
2122                       LEFT JOIN cust_bill     USING ( invnum     )
2123                     WHERE custnum = ?
2124                       AND taxnum  = ?
2125                       AND year    = ?
2126                       AND month   = ?
2127                 ";
2128                 my $sth = dbh->prepare($sql) or do {
2129                   $dbh->rollback if $oldAutoCommit;
2130                   return "fatal: can't lookup exising exemption: ". dbh->errstr;
2131                 };
2132                 $sth->execute(
2133                   $self->custnum,
2134                   $tax->taxnum,
2135                   1900+$year,
2136                   $mon,
2137                 ) or do {
2138                   $dbh->rollback if $oldAutoCommit;
2139                   return "fatal: can't lookup exising exemption: ". dbh->errstr;
2140                 };
2141                 my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0;
2142
2143                 my $remaining_exemption =
2144                   $tax->exempt_amount - $existing_exemption;
2145                 if ( $remaining_exemption > 0 ) {
2146                   my $addl = $remaining_exemption > $taxable_per_month
2147                     ? $taxable_per_month
2148                     : $remaining_exemption;
2149                   $taxable_charged -= $addl;
2150
2151                   my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( {
2152                     'billpkgnum' => $cust_bill_pkg->billpkgnum,
2153                     'taxnum'     => $tax->taxnum,
2154                     'year'       => 1900+$year,
2155                     'month'      => $mon,
2156                     'amount'     => sprintf("%.2f", $addl ),
2157                   } );
2158                   $error = $cust_tax_exempt_pkg->insert;
2159                   if ( $error ) {
2160                     $dbh->rollback if $oldAutoCommit;
2161                     return "fatal: can't insert cust_tax_exempt_pkg: $error";
2162                   }
2163                 } # if $remaining_exemption > 0
2164
2165                 #++
2166                 $mon++;
2167                 #until ( $mon < 12 ) { $mon -= 12; $year++; }
2168                 until ( $mon < 13 ) { $mon -= 12; $year++; }
2169
2170               } #foreach $which_month
2171
2172             } #if $tax->exempt_amount
2173
2174             $taxable_charged = sprintf( "%.2f", $taxable_charged);
2175
2176             #$tax += $taxable_charged * $cust_main_county->tax / 100
2177             $tax{ $tax->taxname || 'Tax' } +=
2178               $taxable_charged * $tax->tax / 100
2179
2180           } #foreach my $tax ( @taxes )
2181
2182         } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
2183
2184       } #if $setup != 0 || $recur != 0
2185
2186     } #if $cust_pkg->modified
2187
2188   } #foreach my $cust_pkg
2189
2190   unless ( $cust_bill->cust_bill_pkg ) {
2191     $cust_bill->delete; #don't create an invoice w/o line items
2192     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2193     return '';
2194   }
2195
2196   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
2197
2198   foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
2199     my $tax = sprintf("%.2f", $tax{$taxname} );
2200     $charged = sprintf( "%.2f", $charged+$tax );
2201
2202     my $cust_bill_pkg = new FS::cust_bill_pkg ({
2203       'invnum'   => $invnum,
2204       'pkgnum'   => 0,
2205       'setup'    => $tax,
2206       'recur'    => 0,
2207       'sdate'    => '',
2208       'edate'    => '',
2209       'itemdesc' => $taxname,
2210     });
2211     $error = $cust_bill_pkg->insert;
2212     if ( $error ) {
2213       $dbh->rollback if $oldAutoCommit;
2214       return "can't create invoice line item for invoice #$invnum: $error";
2215     }
2216     $total_setup += $tax;
2217
2218   }
2219
2220   $cust_bill->charged( sprintf( "%.2f", $total_setup + $total_recur ) );
2221   $error = $cust_bill->replace;
2222   if ( $error ) {
2223     $dbh->rollback if $oldAutoCommit;
2224     return "can't update charged for invoice #$invnum: $error";
2225   }
2226
2227   foreach my $hook ( @precommit_hooks ) {
2228     eval {
2229       &{$hook}; #($self) ?
2230     };
2231     if ( $@ ) {
2232       $dbh->rollback if $oldAutoCommit;
2233       return "$@ running precommit hook $hook\n";
2234     }
2235   }
2236
2237   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2238   ''; #no error
2239 }
2240
2241 =item collect OPTIONS
2242
2243 (Attempt to) collect money for this customer's outstanding invoices (see
2244 L<FS::cust_bill>).  Usually used after the bill method.
2245
2246 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
2247 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
2248 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
2249
2250 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
2251 and the invoice events web interface.
2252
2253 If there is an error, returns the error, otherwise returns false.
2254
2255 Options are passed as name-value pairs.
2256
2257 Currently available options are:
2258
2259 invoice_time - Use this time when deciding when to print invoices and
2260 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>
2261 for conversion functions.
2262
2263 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
2264 events.
2265
2266 quiet - set true to surpress email card/ACH decline notices.
2267
2268 freq - "1d" for the traditional, daily events (the default), or "1m" for the
2269 new monthly events
2270
2271 payby - allows for one time override of normal customer billing method
2272
2273 =cut
2274
2275 sub collect {
2276   my( $self, %options ) = @_;
2277   my $invoice_time = $options{'invoice_time'} || time;
2278
2279   #put below somehow?
2280   local $SIG{HUP} = 'IGNORE';
2281   local $SIG{INT} = 'IGNORE';
2282   local $SIG{QUIT} = 'IGNORE';
2283   local $SIG{TERM} = 'IGNORE';
2284   local $SIG{TSTP} = 'IGNORE';
2285   local $SIG{PIPE} = 'IGNORE';
2286
2287   my $oldAutoCommit = $FS::UID::AutoCommit;
2288   local $FS::UID::AutoCommit = 0;
2289   my $dbh = dbh;
2290
2291   $self->select_for_update; #mutex
2292
2293   my $balance = $self->balance;
2294   warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2295     if $DEBUG;
2296   unless ( $balance > 0 ) { #redundant?????
2297     $dbh->rollback if $oldAutoCommit; #hmm
2298     return '';
2299   }
2300
2301   if ( exists($options{'retry_card'}) ) {
2302     carp 'retry_card option passed to collect is deprecated; use retry';
2303     $options{'retry'} ||= $options{'retry_card'};
2304   }
2305   if ( exists($options{'retry'}) && $options{'retry'} ) {
2306     my $error = $self->retry_realtime;
2307     if ( $error ) {
2308       $dbh->rollback if $oldAutoCommit;
2309       return $error;
2310     }
2311   }
2312
2313   my $extra_sql = '';
2314   if ( defined $options{'freq'} && $options{'freq'} eq '1m' ) {
2315     $extra_sql = " AND freq = '1m' ";
2316   } else {
2317     $extra_sql = " AND ( freq = '1d' OR freq IS NULL OR freq = '' ) ";
2318   }
2319
2320   foreach my $cust_bill ( $self->open_cust_bill ) {
2321
2322     # don't try to charge for the same invoice if it's already in a batch
2323     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
2324
2325     last if $self->balance <= 0;
2326
2327     warn "  invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n"
2328       if $DEBUG > 1;
2329
2330     foreach my $part_bill_event ( due_events ( $cust_bill,
2331                                                exists($options{'payby'})
2332                                                  ? $options{'payby'}
2333                                                  : $self->payby,
2334                                                $invoice_time,
2335                                                $extra_sql ) ) {
2336
2337       last if $cust_bill->owed <= 0  # don't run subsequent events if owed<=0
2338            || $self->balance   <= 0; # or if balance<=0
2339
2340       {
2341         local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2342         warn "  do_event " .  $cust_bill . " ". (%options) .  "\n"
2343           if $DEBUG > 1;
2344
2345         if (my $error = $part_bill_event->do_event($cust_bill, %options)) {
2346           # gah, even with transactions.
2347           $dbh->commit if $oldAutoCommit; #well.
2348           return $error;
2349         }
2350       }
2351
2352     }
2353
2354   }
2355
2356   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2357   '';
2358
2359 }
2360
2361 =item retry_realtime
2362
2363 Schedules realtime / batch  credit card / electronic check / LEC billing
2364 events for for retry.  Useful if card information has changed or manual
2365 retry is desired.  The 'collect' method must be called to actually retry
2366 the transaction.
2367
2368 Implementation details: For each of this customer's open invoices, changes
2369 the status of the first "done" (with statustext error) realtime processing
2370 event to "failed".
2371
2372 =cut
2373
2374 sub retry_realtime {
2375   my $self = shift;
2376
2377   local $SIG{HUP} = 'IGNORE';
2378   local $SIG{INT} = 'IGNORE';
2379   local $SIG{QUIT} = 'IGNORE';
2380   local $SIG{TERM} = 'IGNORE';
2381   local $SIG{TSTP} = 'IGNORE';
2382   local $SIG{PIPE} = 'IGNORE';
2383
2384   my $oldAutoCommit = $FS::UID::AutoCommit;
2385   local $FS::UID::AutoCommit = 0;
2386   my $dbh = dbh;
2387
2388   foreach my $cust_bill (
2389     grep { $_->cust_bill_event }
2390       $self->open_cust_bill
2391   ) {
2392     my @cust_bill_event =
2393       sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
2394         grep {
2395                #$_->part_bill_event->plan eq 'realtime-card'
2396                $_->part_bill_event->eventcode =~
2397                    /\$cust_bill\->(batch|realtime)_(card|ach|lec)/
2398                  && $_->status eq 'done'
2399                  && $_->statustext
2400              }
2401           $cust_bill->cust_bill_event;
2402     next unless @cust_bill_event;
2403     my $error = $cust_bill_event[0]->retry;
2404     if ( $error ) {
2405       $dbh->rollback if $oldAutoCommit;
2406       return "error scheduling invoice event for retry: $error";
2407     }
2408
2409   }
2410
2411   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2412   '';
2413
2414 }
2415
2416 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
2417
2418 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
2419 via a Business::OnlinePayment realtime gateway.  See
2420 L<http://420.am/business-onlinepayment> for supported gateways.
2421
2422 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2423
2424 Available options are: I<description>, I<invnum>, I<quiet>
2425
2426 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2427 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2428 if set, will override the value from the customer record.
2429
2430 I<description> is a free-text field passed to the gateway.  It defaults to
2431 "Internet services".
2432
2433 If an I<invnum> is specified, this payment (if successful) is applied to the
2434 specified invoice.  If you don't specify an I<invnum> you might want to
2435 call the B<apply_payments> method.
2436
2437 I<quiet> can be set true to surpress email decline notices.
2438
2439 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
2440
2441 =cut
2442
2443 sub realtime_bop {
2444   my( $self, $method, $amount, %options ) = @_;
2445   if ( $DEBUG ) {
2446     warn "$me realtime_bop: $method $amount\n";
2447     warn "  $_ => $options{$_}\n" foreach keys %options;
2448   }
2449
2450   $options{'description'} ||= 'Internet services';
2451
2452   eval "use Business::OnlinePayment";
2453   die $@ if $@;
2454
2455   my $payinfo = exists($options{'payinfo'})
2456                   ? $options{'payinfo'}
2457                   : $self->payinfo;
2458
2459   ###
2460   # select a gateway
2461   ###
2462
2463   my $taxclass = '';
2464   if ( $options{'invnum'} ) {
2465     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
2466     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
2467     my @taxclasses =
2468       map  { $_->part_pkg->taxclass }
2469       grep { $_ }
2470       map  { $_->cust_pkg }
2471       $cust_bill->cust_bill_pkg;
2472     unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
2473                                                            #different taxclasses
2474       $taxclass = $taxclasses[0];
2475     }
2476   }
2477
2478   #look for an agent gateway override first
2479   my $cardtype;
2480   if ( $method eq 'CC' ) {
2481     $cardtype = cardtype($payinfo);
2482   } elsif ( $method eq 'ECHECK' ) {
2483     $cardtype = 'ACH';
2484   } else {
2485     $cardtype = $method;
2486   }
2487
2488   my $override =
2489        qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2490                                            cardtype => $cardtype,
2491                                            taxclass => $taxclass,       } )
2492     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2493                                            cardtype => '',
2494                                            taxclass => $taxclass,       } )
2495     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2496                                            cardtype => $cardtype,
2497                                            taxclass => '',              } )
2498     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2499                                            cardtype => '',
2500                                            taxclass => '',              } );
2501
2502   my $payment_gateway = '';
2503   my( $processor, $login, $password, $action, @bop_options );
2504   if ( $override ) { #use a payment gateway override
2505
2506     $payment_gateway = $override->payment_gateway;
2507
2508     $processor   = $payment_gateway->gateway_module;
2509     $login       = $payment_gateway->gateway_username;
2510     $password    = $payment_gateway->gateway_password;
2511     $action      = $payment_gateway->gateway_action;
2512     @bop_options = $payment_gateway->options;
2513
2514   } else { #use the standard settings from the config
2515
2516     ( $processor, $login, $password, $action, @bop_options ) =
2517       $self->default_payment_gateway($method);
2518
2519   }
2520
2521   ###
2522   # massage data
2523   ###
2524
2525   my $address = exists($options{'address1'})
2526                     ? $options{'address1'}
2527                     : $self->address1;
2528   my $address2 = exists($options{'address2'})
2529                     ? $options{'address2'}
2530                     : $self->address2;
2531   $address .= ", ". $address2 if length($address2);
2532
2533   my $o_payname = exists($options{'payname'})
2534                     ? $options{'payname'}
2535                     : $self->payname;
2536   my($payname, $payfirst, $paylast);
2537   if ( $o_payname && $method ne 'ECHECK' ) {
2538     ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2539       or return "Illegal payname $payname";
2540     ($payfirst, $paylast) = ($1, $2);
2541   } else {
2542     $payfirst = $self->getfield('first');
2543     $paylast = $self->getfield('last');
2544     $payname =  "$payfirst $paylast";
2545   }
2546
2547   my @invoicing_list = $self->invoicing_list_emailonly;
2548   if ( $conf->exists('emailinvoiceautoalways')
2549        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
2550        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
2551     push @invoicing_list, $self->all_emails;
2552   }
2553
2554   my $email = ($conf->exists('business-onlinepayment-email-override'))
2555               ? $conf->config('business-onlinepayment-email-override')
2556               : $invoicing_list[0];
2557
2558   my %content = ();
2559
2560   my $payip = exists($options{'payip'})
2561                 ? $options{'payip'}
2562                 : $self->payip;
2563   $content{customer_ip} = $payip
2564     if length($payip);
2565
2566   $content{invoice_number} = $options{'invnum'}
2567     if exists($options{'invnum'}) && length($options{'invnum'});
2568
2569   if ( $method eq 'CC' ) {
2570
2571     $content{card_number} = $payinfo;
2572     my $paydate = exists($options{'paydate'})
2573                     ? $options{'paydate'}
2574                     : $self->paydate;
2575     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2576     $content{expiration} = "$2/$1";
2577
2578     my $paycvv = exists($options{'paycvv'})
2579                    ? $options{'paycvv'}
2580                    : $self->paycvv;
2581     $content{cvv2} = $self->paycvv
2582       if length($paycvv);
2583
2584     my $paystart_month = exists($options{'paystart_month'})
2585                            ? $options{'paystart_month'}
2586                            : $self->paystart_month;
2587
2588     my $paystart_year  = exists($options{'paystart_year'})
2589                            ? $options{'paystart_year'}
2590                            : $self->paystart_year;
2591
2592     $content{card_start} = "$paystart_month/$paystart_year"
2593       if $paystart_month && $paystart_year;
2594
2595     my $payissue       = exists($options{'payissue'})
2596                            ? $options{'payissue'}
2597                            : $self->payissue;
2598     $content{issue_number} = $payissue if $payissue;
2599
2600     $content{recurring_billing} = 'YES'
2601       if qsearch('cust_pay', { 'custnum' => $self->custnum,
2602                                'payby'   => 'CARD',
2603                                'payinfo' => $payinfo,
2604                              } )
2605       || qsearch('cust_pay', { 'custnum' => $self->custnum,
2606                                'payby'   => 'CARD',
2607                                'paymask' => $self->mask_payinfo('CARD', $payinfo),
2608                              } );
2609
2610
2611   } elsif ( $method eq 'ECHECK' ) {
2612     ( $content{account_number}, $content{routing_code} ) =
2613       split('@', $payinfo);
2614     $content{bank_name} = $o_payname;
2615     $content{bank_state} = $self->getfield('paystate');
2616     $content{account_type} = uc($self->getfield('paytype')) || 'CHECKING';
2617     $content{account_name} = $payname;
2618     $content{customer_org} = $self->company ? 'B' : 'I';
2619     $content{state_id}       = $self->getfield('stateid');
2620     $content{state_id_state} = $self->getfield('stateid_state');
2621     $content{customer_ssn} = exists($options{'ss'})
2622                                ? $options{'ss'}
2623                                : $self->ss;
2624   } elsif ( $method eq 'LEC' ) {
2625     $content{phone} = $payinfo;
2626   }
2627
2628   ###
2629   # run transaction(s)
2630   ###
2631
2632   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
2633
2634   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
2635   $transaction->content(
2636     'type'           => $method,
2637     'login'          => $login,
2638     'password'       => $password,
2639     'action'         => $action1,
2640     'description'    => $options{'description'},
2641     'amount'         => $amount,
2642     #'invoice_number' => $options{'invnum'},
2643     'customer_id'    => $self->custnum,
2644     'last_name'      => $paylast,
2645     'first_name'     => $payfirst,
2646     'name'           => $payname,
2647     'address'        => $address,
2648     'city'           => ( exists($options{'city'})
2649                             ? $options{'city'}
2650                             : $self->city          ),
2651     'state'          => ( exists($options{'state'})
2652                             ? $options{'state'}
2653                             : $self->state          ),
2654     'zip'            => ( exists($options{'zip'})
2655                             ? $options{'zip'}
2656                             : $self->zip          ),
2657     'country'        => ( exists($options{'country'})
2658                             ? $options{'country'}
2659                             : $self->country          ),
2660     'referer'        => 'http://cleanwhisker.420.am/',
2661     'email'          => $email,
2662     'phone'          => $self->daytime || $self->night,
2663     %content, #after
2664   );
2665   $transaction->submit();
2666
2667   if ( $transaction->is_success() && $action2 ) {
2668     my $auth = $transaction->authorization;
2669     my $ordernum = $transaction->can('order_number')
2670                    ? $transaction->order_number
2671                    : '';
2672
2673     my $capture =
2674       new Business::OnlinePayment( $processor, @bop_options );
2675
2676     my %capture = (
2677       %content,
2678       type           => $method,
2679       action         => $action2,
2680       login          => $login,
2681       password       => $password,
2682       order_number   => $ordernum,
2683       amount         => $amount,
2684       authorization  => $auth,
2685       description    => $options{'description'},
2686     );
2687
2688     foreach my $field (qw( authorization_source_code returned_ACI
2689                            transaction_identifier validation_code
2690                            transaction_sequence_num local_transaction_date
2691                            local_transaction_time AVS_result_code          )) {
2692       $capture{$field} = $transaction->$field() if $transaction->can($field);
2693     }
2694
2695     $capture->content( %capture );
2696
2697     $capture->submit();
2698
2699     unless ( $capture->is_success ) {
2700       my $e = "Authorization successful but capture failed, custnum #".
2701               $self->custnum. ': '.  $capture->result_code.
2702               ": ". $capture->error_message;
2703       warn $e;
2704       return $e;
2705     }
2706
2707   }
2708
2709   ###
2710   # remove paycvv after initial transaction
2711   ###
2712
2713   #false laziness w/misc/process/payment.cgi - check both to make sure working
2714   # correctly
2715   if ( defined $self->dbdef_table->column('paycvv')
2716        && length($self->paycvv)
2717        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2718   ) {
2719     my $error = $self->remove_cvv;
2720     if ( $error ) {
2721       warn "WARNING: error removing cvv: $error\n";
2722     }
2723   }
2724
2725   ###
2726   # result handling
2727   ###
2728
2729   if ( $transaction->is_success() ) {
2730
2731     my %method2payby = (
2732       'CC'     => 'CARD',
2733       'ECHECK' => 'CHEK',
2734       'LEC'    => 'LECB',
2735     );
2736
2737     my $paybatch = '';
2738     if ( $payment_gateway ) { # agent override
2739       $paybatch = $payment_gateway->gatewaynum. '-';
2740     }
2741
2742     $paybatch .= "$processor:". $transaction->authorization;
2743
2744     $paybatch .= ':'. $transaction->order_number
2745       if $transaction->can('order_number')
2746       && length($transaction->order_number);
2747
2748     my $cust_pay = new FS::cust_pay ( {
2749        'custnum'  => $self->custnum,
2750        'invnum'   => $options{'invnum'},
2751        'paid'     => $amount,
2752        '_date'     => '',
2753        'payby'    => $method2payby{$method},
2754        'payinfo'  => $payinfo,
2755        'paybatch' => $paybatch,
2756     } );
2757     my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
2758     if ( $error ) {
2759       $cust_pay->invnum(''); #try again with no specific invnum
2760       my $error2 = $cust_pay->insert( $options{'manual'} ?
2761                                       ( 'manual' => 1 ) : ()
2762                                     );
2763       if ( $error2 ) {
2764         # gah, even with transactions.
2765         my $e = 'WARNING: Card/ACH debited but database not updated - '.
2766                 "error inserting payment ($processor): $error2".
2767                 " (previously tried insert with invnum #$options{'invnum'}" .
2768                 ": $error )";
2769         warn $e;
2770         return $e;
2771       }
2772     }
2773     return ''; #no error
2774
2775   } else {
2776
2777     my $perror = "$processor error: ". $transaction->error_message;
2778
2779     unless ( $transaction->error_message ) {
2780
2781       my $t_response;
2782       if ( $transaction->can('response_page') ) {
2783         $t_response = {
2784                         'page'    => ( $transaction->can('response_page')
2785                                          ? $transaction->response_page
2786                                          : ''
2787                                      ),
2788                         'code'    => ( $transaction->can('response_code')
2789                                          ? $transaction->response_code
2790                                          : ''
2791                                      ),
2792                         'headers' => ( $transaction->can('response_headers')
2793                                          ? $transaction->response_headers
2794                                          : ''
2795                                      ),
2796                       };
2797       } else {
2798         $t_response .=
2799           "No additional debugging information available for $processor";
2800       }
2801
2802       $perror .= "No error_message returned from $processor -- ".
2803                  ( ref($t_response) ? Dumper($t_response) : $t_response );
2804
2805     }
2806
2807     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2808          && $conf->exists('emaildecline')
2809          && grep { $_ ne 'POST' } $self->invoicing_list
2810          && ! grep { $transaction->error_message =~ /$_/ }
2811                    $conf->config('emaildecline-exclude')
2812     ) {
2813       my @templ = $conf->config('declinetemplate');
2814       my $template = new Text::Template (
2815         TYPE   => 'ARRAY',
2816         SOURCE => [ map "$_\n", @templ ],
2817       ) or return "($perror) can't create template: $Text::Template::ERROR";
2818       $template->compile()
2819         or return "($perror) can't compile template: $Text::Template::ERROR";
2820
2821       my $templ_hash = { error => $transaction->error_message };
2822
2823       my $error = send_email(
2824         'from'    => $conf->config('invoice_from'),
2825         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2826         'subject' => 'Your payment could not be processed',
2827         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
2828       );
2829
2830       $perror .= " (also received error sending decline notification: $error)"
2831         if $error;
2832
2833     }
2834
2835     return $perror;
2836   }
2837
2838 }
2839
2840 =item default_payment_gateway
2841
2842 =cut
2843
2844 sub default_payment_gateway {
2845   my( $self, $method ) = @_;
2846
2847   die "Real-time processing not enabled\n"
2848     unless $conf->exists('business-onlinepayment');
2849
2850   #load up config
2851   my $bop_config = 'business-onlinepayment';
2852   $bop_config .= '-ach'
2853     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2854   my ( $processor, $login, $password, $action, @bop_options ) =
2855     $conf->config($bop_config);
2856   $action ||= 'normal authorization';
2857   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2858   die "No real-time processor is enabled - ".
2859       "did you set the business-onlinepayment configuration value?\n"
2860     unless $processor;
2861
2862   ( $processor, $login, $password, $action, @bop_options )
2863 }
2864
2865 =item remove_cvv
2866
2867 Removes the I<paycvv> field from the database directly.
2868
2869 If there is an error, returns the error, otherwise returns false.
2870
2871 =cut
2872
2873 sub remove_cvv {
2874   my $self = shift;
2875   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2876     or return dbh->errstr;
2877   $sth->execute($self->custnum)
2878     or return $sth->errstr;
2879   $self->paycvv('');
2880   '';
2881 }
2882
2883 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2884
2885 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2886 via a Business::OnlinePayment realtime gateway.  See
2887 L<http://420.am/business-onlinepayment> for supported gateways.
2888
2889 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2890
2891 Available options are: I<amount>, I<reason>, I<paynum>
2892
2893 Most gateways require a reference to an original payment transaction to refund,
2894 so you probably need to specify a I<paynum>.
2895
2896 I<amount> defaults to the original amount of the payment if not specified.
2897
2898 I<reason> specifies a reason for the refund.
2899
2900 Implementation note: If I<amount> is unspecified or equal to the amount of the
2901 orignal payment, first an attempt is made to "void" the transaction via
2902 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2903 the normal attempt is made to "refund" ("credit") the transaction via the
2904 gateway is attempted.
2905
2906 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2907 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2908 #if set, will override the value from the customer record.
2909
2910 #If an I<invnum> is specified, this payment (if successful) is applied to the
2911 #specified invoice.  If you don't specify an I<invnum> you might want to
2912 #call the B<apply_payments> method.
2913
2914 =cut
2915
2916 #some false laziness w/realtime_bop, not enough to make it worth merging
2917 #but some useful small subs should be pulled out
2918 sub realtime_refund_bop {
2919   my( $self, $method, %options ) = @_;
2920   if ( $DEBUG ) {
2921     warn "$me realtime_refund_bop: $method refund\n";
2922     warn "  $_ => $options{$_}\n" foreach keys %options;
2923   }
2924
2925   eval "use Business::OnlinePayment";
2926   die $@ if $@;
2927
2928   ###
2929   # look up the original payment and optionally a gateway for that payment
2930   ###
2931
2932   my $cust_pay = '';
2933   my $amount = $options{'amount'};
2934
2935   my( $processor, $login, $password, @bop_options ) ;
2936   my( $auth, $order_number ) = ( '', '', '' );
2937
2938   if ( $options{'paynum'} ) {
2939
2940     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
2941     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2942       or return "Unknown paynum $options{'paynum'}";
2943     $amount ||= $cust_pay->paid;
2944
2945     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
2946       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2947                 $cust_pay->paybatch;
2948     my $gatewaynum = '';
2949     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
2950
2951     if ( $gatewaynum ) { #gateway for the payment to be refunded
2952
2953       my $payment_gateway =
2954         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
2955       die "payment gateway $gatewaynum not found"
2956         unless $payment_gateway;
2957
2958       $processor   = $payment_gateway->gateway_module;
2959       $login       = $payment_gateway->gateway_username;
2960       $password    = $payment_gateway->gateway_password;
2961       @bop_options = $payment_gateway->options;
2962
2963     } else { #try the default gateway
2964
2965       my( $conf_processor, $unused_action );
2966       ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
2967         $self->default_payment_gateway($method);
2968
2969       return "processor of payment $options{'paynum'} $processor does not".
2970              " match default processor $conf_processor"
2971         unless $processor eq $conf_processor;
2972
2973     }
2974
2975
2976   } else { # didn't specify a paynum, so look for agent gateway overrides
2977            # like a normal transaction
2978
2979     my $cardtype;
2980     if ( $method eq 'CC' ) {
2981       $cardtype = cardtype($self->payinfo);
2982     } elsif ( $method eq 'ECHECK' ) {
2983       $cardtype = 'ACH';
2984     } else {
2985       $cardtype = $method;
2986     }
2987     my $override =
2988            qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2989                                                cardtype => $cardtype,
2990                                                taxclass => '',              } )
2991         || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2992                                                cardtype => '',
2993                                                taxclass => '',              } );
2994
2995     if ( $override ) { #use a payment gateway override
2996
2997       my $payment_gateway = $override->payment_gateway;
2998
2999       $processor   = $payment_gateway->gateway_module;
3000       $login       = $payment_gateway->gateway_username;
3001       $password    = $payment_gateway->gateway_password;
3002       #$action      = $payment_gateway->gateway_action;
3003       @bop_options = $payment_gateway->options;
3004
3005     } else { #use the standard settings from the config
3006
3007       my $unused_action;
3008       ( $processor, $login, $password, $unused_action, @bop_options ) =
3009         $self->default_payment_gateway($method);
3010
3011     }
3012
3013   }
3014   return "neither amount nor paynum specified" unless $amount;
3015
3016   my %content = (
3017     'type'           => $method,
3018     'login'          => $login,
3019     'password'       => $password,
3020     'order_number'   => $order_number,
3021     'amount'         => $amount,
3022     'referer'        => 'http://cleanwhisker.420.am/',
3023   );
3024   $content{authorization} = $auth
3025     if length($auth); #echeck/ACH transactions have an order # but no auth
3026                       #(at least with authorize.net)
3027
3028   my $disable_void_after;
3029   if ($conf->exists('disable_void_after')
3030       && $conf->config('disable_void_after') =~ /^(\d+)$/) {
3031     $disable_void_after = $1;
3032   }
3033
3034   #first try void if applicable
3035   if ( $cust_pay && $cust_pay->paid == $amount
3036     && (
3037       ( not defined($disable_void_after) )
3038       || ( time < ($cust_pay->_date + $disable_void_after ) )
3039     )
3040   ) {
3041     warn "  attempting void\n" if $DEBUG > 1;
3042     my $void = new Business::OnlinePayment( $processor, @bop_options );
3043     $void->content( 'action' => 'void', %content );
3044     $void->submit();
3045     if ( $void->is_success ) {
3046       my $error = $cust_pay->void($options{'reason'});
3047       if ( $error ) {
3048         # gah, even with transactions.
3049         my $e = 'WARNING: Card/ACH voided but database not updated - '.
3050                 "error voiding payment: $error";
3051         warn $e;
3052         return $e;
3053       }
3054       warn "  void successful\n" if $DEBUG > 1;
3055       return '';
3056     }
3057   }
3058
3059   warn "  void unsuccessful, trying refund\n"
3060     if $DEBUG > 1;
3061
3062   #massage data
3063   my $address = $self->address1;
3064   $address .= ", ". $self->address2 if $self->address2;
3065
3066   my($payname, $payfirst, $paylast);
3067   if ( $self->payname && $method ne 'ECHECK' ) {
3068     $payname = $self->payname;
3069     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3070       or return "Illegal payname $payname";
3071     ($payfirst, $paylast) = ($1, $2);
3072   } else {
3073     $payfirst = $self->getfield('first');
3074     $paylast = $self->getfield('last');
3075     $payname =  "$payfirst $paylast";
3076   }
3077
3078   my @invoicing_list = $self->invoicing_list_emailonly;
3079   if ( $conf->exists('emailinvoiceautoalways')
3080        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3081        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3082     push @invoicing_list, $self->all_emails;
3083   }
3084
3085   my $email = ($conf->exists('business-onlinepayment-email-override'))
3086               ? $conf->config('business-onlinepayment-email-override')
3087               : $invoicing_list[0];
3088
3089   my $payip = exists($options{'payip'})
3090                 ? $options{'payip'}
3091                 : $self->payip;
3092   $content{customer_ip} = $payip
3093     if length($payip);
3094
3095   my $payinfo = '';
3096   if ( $method eq 'CC' ) {
3097
3098     if ( $cust_pay ) {
3099       $content{card_number} = $payinfo = $cust_pay->payinfo;
3100       #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3101       #$content{expiration} = "$2/$1";
3102     } else {
3103       $content{card_number} = $payinfo = $self->payinfo;
3104       $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3105       $content{expiration} = "$2/$1";
3106     }
3107
3108   } elsif ( $method eq 'ECHECK' ) {
3109     ( $content{account_number}, $content{routing_code} ) =
3110       split('@', $payinfo = $self->payinfo);
3111     $content{bank_name} = $self->payname;
3112     $content{account_type} = 'CHECKING';
3113     $content{account_name} = $payname;
3114     $content{customer_org} = $self->company ? 'B' : 'I';
3115     $content{customer_ssn} = $self->ss;
3116   } elsif ( $method eq 'LEC' ) {
3117     $content{phone} = $payinfo = $self->payinfo;
3118   }
3119
3120   #then try refund
3121   my $refund = new Business::OnlinePayment( $processor, @bop_options );
3122   my %sub_content = $refund->content(
3123     'action'         => 'credit',
3124     'customer_id'    => $self->custnum,
3125     'last_name'      => $paylast,
3126     'first_name'     => $payfirst,
3127     'name'           => $payname,
3128     'address'        => $address,
3129     'city'           => $self->city,
3130     'state'          => $self->state,
3131     'zip'            => $self->zip,
3132     'country'        => $self->country,
3133     'email'          => $email,
3134     'phone'          => $self->daytime || $self->night,
3135     %content, #after
3136   );
3137   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
3138     if $DEBUG > 1;
3139   $refund->submit();
3140
3141   return "$processor error: ". $refund->error_message
3142     unless $refund->is_success();
3143
3144   my %method2payby = (
3145     'CC'     => 'CARD',
3146     'ECHECK' => 'CHEK',
3147     'LEC'    => 'LECB',
3148   );
3149
3150   my $paybatch = "$processor:". $refund->authorization;
3151   $paybatch .= ':'. $refund->order_number
3152     if $refund->can('order_number') && $refund->order_number;
3153
3154   while ( $cust_pay && $cust_pay->unapplied < $amount ) {
3155     my @cust_bill_pay = $cust_pay->cust_bill_pay;
3156     last unless @cust_bill_pay;
3157     my $cust_bill_pay = pop @cust_bill_pay;
3158     my $error = $cust_bill_pay->delete;
3159     last if $error;
3160   }
3161
3162   my $cust_refund = new FS::cust_refund ( {
3163     'custnum'  => $self->custnum,
3164     'paynum'   => $options{'paynum'},
3165     'refund'   => $amount,
3166     '_date'    => '',
3167     'payby'    => $method2payby{$method},
3168     'payinfo'  => $payinfo,
3169     'paybatch' => $paybatch,
3170     'reason'   => $options{'reason'} || 'card or ACH refund',
3171   } );
3172   my $error = $cust_refund->insert;
3173   if ( $error ) {
3174     $cust_refund->paynum(''); #try again with no specific paynum
3175     my $error2 = $cust_refund->insert;
3176     if ( $error2 ) {
3177       # gah, even with transactions.
3178       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
3179               "error inserting refund ($processor): $error2".
3180               " (previously tried insert with paynum #$options{'paynum'}" .
3181               ": $error )";
3182       warn $e;
3183       return $e;
3184     }
3185   }
3186
3187   ''; #no error
3188
3189 }
3190
3191 =item batch_card OPTION => VALUE...
3192
3193 Adds a payment for this invoice to the pending credit card batch (see
3194 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
3195 runs the payment using a realtime gateway.
3196
3197 =cut
3198
3199 sub batch_card {
3200   my ($self, %options) = @_;
3201
3202   my $amount;
3203   if (exists($options{amount})) {
3204     $amount = $options{amount};
3205   }else{
3206     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
3207   }
3208   return '' unless $amount > 0;
3209
3210   my $invnum = delete $options{invnum};
3211   my $payby = $options{invnum} || $self->payby;  #dubious
3212
3213   if ($options{'realtime'}) {
3214     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
3215                                 $amount,
3216                                 %options,
3217                               );
3218   }
3219
3220   my $oldAutoCommit = $FS::UID::AutoCommit;
3221   local $FS::UID::AutoCommit = 0;
3222   my $dbh = dbh;
3223
3224   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
3225     or return "Cannot lock pay_batch: " . $dbh->errstr;
3226
3227   my %pay_batch = (
3228     'status' => 'O',
3229     'payby'  => FS::payby->payby2payment($payby),
3230   );
3231
3232   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
3233
3234   unless ( $pay_batch ) {
3235     $pay_batch = new FS::pay_batch \%pay_batch;
3236     my $error = $pay_batch->insert;
3237     if ( $error ) {
3238       $dbh->rollback if $oldAutoCommit;
3239       die "error creating new batch: $error\n";
3240     }
3241   }
3242
3243   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
3244       'batchnum' => $pay_batch->batchnum,
3245       'custnum'  => $self->custnum,
3246   } );
3247
3248   foreach (qw( address1 address2 city state zip country payby payinfo paydate
3249                payname )) {
3250     $options{$_} = '' unless exists($options{$_});
3251   }
3252
3253   my $cust_pay_batch = new FS::cust_pay_batch ( {
3254     'batchnum' => $pay_batch->batchnum,
3255     'invnum'   => $invnum || 0,                    # is there a better value?
3256                                                    # this field should be
3257                                                    # removed...
3258                                                    # cust_bill_pay_batch now
3259     'custnum'  => $self->custnum,
3260     'last'     => $self->getfield('last'),
3261     'first'    => $self->getfield('first'),
3262     'address1' => $options{address1} || $self->address1,
3263     'address2' => $options{address2} || $self->address2,
3264     'city'     => $options{city}     || $self->city,
3265     'state'    => $options{state}    || $self->state,
3266     'zip'      => $options{zip}      || $self->zip,
3267     'country'  => $options{country}  || $self->country,
3268     'payby'    => $options{payby}    || $self->payby,
3269     'payinfo'  => $options{payinfo}  || $self->payinfo,
3270     'exp'      => $options{paydate}  || $self->paydate,
3271     'payname'  => $options{payname}  || $self->payname,
3272     'amount'   => $amount,                         # consolidating
3273   } );
3274
3275   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
3276     if $old_cust_pay_batch;
3277
3278   my $error;
3279   if ($old_cust_pay_batch) {
3280     $error = $cust_pay_batch->replace($old_cust_pay_batch)
3281   } else {
3282     $error = $cust_pay_batch->insert;
3283   }
3284
3285   if ( $error ) {
3286     $dbh->rollback if $oldAutoCommit;
3287     die $error;
3288   }
3289
3290   my $unapplied = $self->total_credited + $self->total_unapplied_payments + $self->in_transit_payments;
3291   foreach my $cust_bill ($self->open_cust_bill) {
3292     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
3293     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
3294       'invnum' => $cust_bill->invnum,
3295       'paybatchnum' => $cust_pay_batch->paybatchnum,
3296       'amount' => $cust_bill->owed,
3297       '_date' => time,
3298     };
3299     if ($unapplied >= $cust_bill_pay_batch->amount){
3300       $unapplied -= $cust_bill_pay_batch->amount;
3301       next;
3302     }else{
3303       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
3304                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
3305     }
3306     $error = $cust_bill_pay_batch->insert;
3307     if ( $error ) {
3308       $dbh->rollback if $oldAutoCommit;
3309       die $error;
3310     }
3311   }
3312
3313   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3314   '';
3315 }
3316
3317 =item total_owed
3318
3319 Returns the total owed for this customer on all invoices
3320 (see L<FS::cust_bill/owed>).
3321
3322 =cut
3323
3324 sub total_owed {
3325   my $self = shift;
3326   $self->total_owed_date(2145859200); #12/31/2037
3327 }
3328
3329 =item total_owed_date TIME
3330
3331 Returns the total owed for this customer on all invoices with date earlier than
3332 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
3333 see L<Time::Local> and L<Date::Parse> for conversion functions.
3334
3335 =cut
3336
3337 sub total_owed_date {
3338   my $self = shift;
3339   my $time = shift;
3340   my $total_bill = 0;
3341   foreach my $cust_bill (
3342     grep { $_->_date <= $time }
3343       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3344   ) {
3345     $total_bill += $cust_bill->owed;
3346   }
3347   sprintf( "%.2f", $total_bill );
3348 }
3349
3350 =item apply_payments_and_credits
3351
3352 Applies unapplied payments and credits.
3353
3354 In most cases, this new method should be used in place of sequential
3355 apply_payments and apply_credits methods.
3356
3357 =cut
3358
3359 sub apply_payments_and_credits {
3360   my $self = shift;
3361
3362   foreach my $cust_bill ( $self->open_cust_bill ) {
3363     $cust_bill->apply_payments_and_credits;
3364   }
3365
3366 }
3367
3368 =item apply_credits OPTION => VALUE ...
3369
3370 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
3371 to outstanding invoice balances in chronological order (or reverse
3372 chronological order if the I<order> option is set to B<newest>) and returns the
3373 value of any remaining unapplied credits available for refund (see
3374 L<FS::cust_refund>).
3375
3376 =cut
3377
3378 sub apply_credits {
3379   my $self = shift;
3380   my %opt = @_;
3381
3382   return 0 unless $self->total_credited;
3383
3384   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
3385       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
3386
3387   my @invoices = $self->open_cust_bill;
3388   @invoices = sort { $b->_date <=> $a->_date } @invoices
3389     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
3390
3391   my $credit;
3392   foreach my $cust_bill ( @invoices ) {
3393     my $amount;
3394
3395     if ( !defined($credit) || $credit->credited == 0) {
3396       $credit = pop @credits or last;
3397     }
3398
3399     if ($cust_bill->owed >= $credit->credited) {
3400       $amount=$credit->credited;
3401     }else{
3402       $amount=$cust_bill->owed;
3403     }
3404
3405     my $cust_credit_bill = new FS::cust_credit_bill ( {
3406       'crednum' => $credit->crednum,
3407       'invnum'  => $cust_bill->invnum,
3408       'amount'  => $amount,
3409     } );
3410     my $error = $cust_credit_bill->insert;
3411     die $error if $error;
3412
3413     redo if ($cust_bill->owed > 0);
3414
3415   }
3416
3417   return $self->total_credited;
3418 }
3419
3420 =item apply_payments
3421
3422 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
3423 to outstanding invoice balances in chronological order.
3424
3425  #and returns the value of any remaining unapplied payments.
3426
3427 =cut
3428
3429 sub apply_payments {
3430   my $self = shift;
3431
3432   #return 0 unless
3433
3434   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
3435       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
3436
3437   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
3438       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
3439
3440   my $payment;
3441
3442   foreach my $cust_bill ( @invoices ) {
3443     my $amount;
3444
3445     if ( !defined($payment) || $payment->unapplied == 0 ) {
3446       $payment = pop @payments or last;
3447     }
3448
3449     if ( $cust_bill->owed >= $payment->unapplied ) {
3450       $amount = $payment->unapplied;
3451     } else {
3452       $amount = $cust_bill->owed;
3453     }
3454
3455     my $cust_bill_pay = new FS::cust_bill_pay ( {
3456       'paynum' => $payment->paynum,
3457       'invnum' => $cust_bill->invnum,
3458       'amount' => $amount,
3459     } );
3460     my $error = $cust_bill_pay->insert;
3461     die $error if $error;
3462
3463     redo if ( $cust_bill->owed > 0);
3464
3465   }
3466
3467   return $self->total_unapplied_payments;
3468 }
3469
3470 =item total_credited
3471
3472 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3473 customer.  See L<FS::cust_credit/credited>.
3474
3475 =cut
3476
3477 sub total_credited {
3478   my $self = shift;
3479   my $total_credit = 0;
3480   foreach my $cust_credit ( qsearch('cust_credit', {
3481     'custnum' => $self->custnum,
3482   } ) ) {
3483     $total_credit += $cust_credit->credited;
3484   }
3485   sprintf( "%.2f", $total_credit );
3486 }
3487
3488 =item total_unapplied_payments
3489
3490 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3491 See L<FS::cust_pay/unapplied>.
3492
3493 =cut
3494
3495 sub total_unapplied_payments {
3496   my $self = shift;
3497   my $total_unapplied = 0;
3498   foreach my $cust_pay ( qsearch('cust_pay', {
3499     'custnum' => $self->custnum,
3500   } ) ) {
3501     $total_unapplied += $cust_pay->unapplied;
3502   }
3503   sprintf( "%.2f", $total_unapplied );
3504 }
3505
3506 =item balance
3507
3508 Returns the balance for this customer (total_owed minus total_credited
3509 minus total_unapplied_payments).
3510
3511 =cut
3512
3513 sub balance {
3514   my $self = shift;
3515   sprintf( "%.2f",
3516     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
3517   );
3518 }
3519
3520 =item balance_date TIME
3521
3522 Returns the balance for this customer, only considering invoices with date
3523 earlier than TIME (total_owed_date minus total_credited minus
3524 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
3525 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
3526 functions.
3527
3528 =cut
3529
3530 sub balance_date {
3531   my $self = shift;
3532   my $time = shift;
3533   sprintf( "%.2f",
3534     $self->total_owed_date($time)
3535       - $self->total_credited
3536       - $self->total_unapplied_payments
3537   );
3538 }
3539
3540 =item in_transit_payments
3541
3542 Returns the total of requests for payments for this customer pending in
3543 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
3544
3545 =cut
3546
3547 sub in_transit_payments {
3548   my $self = shift;
3549   my $in_transit_payments = 0;
3550   foreach my $pay_batch ( qsearch('pay_batch', {
3551     'status' => 'I',
3552   } ) ) {
3553     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
3554       'batchnum' => $pay_batch->batchnum,
3555       'custnum' => $self->custnum,
3556     } ) ) {
3557       $in_transit_payments += $cust_pay_batch->amount;
3558     }
3559   }
3560   sprintf( "%.2f", $in_transit_payments );
3561 }
3562
3563 =item paydate_monthyear
3564
3565 Returns a two-element list consisting of the month and year of this customer's
3566 paydate (credit card expiration date for CARD customers)
3567
3568 =cut
3569
3570 sub paydate_monthyear {
3571   my $self = shift;
3572   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3573     ( $2, $1 );
3574   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3575     ( $1, $3 );
3576   } else {
3577     ('', '');
3578   }
3579 }
3580
3581 =item invoicing_list [ ARRAYREF ]
3582
3583 If an arguement is given, sets these email addresses as invoice recipients
3584 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
3585 (except as warnings), so use check_invoicing_list first.
3586
3587 Returns a list of email addresses (with svcnum entries expanded).
3588
3589 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
3590 check it without disturbing anything by passing nothing.
3591
3592 This interface may change in the future.
3593
3594 =cut
3595
3596 sub invoicing_list {
3597   my( $self, $arrayref ) = @_;
3598
3599   if ( $arrayref ) {
3600     my @cust_main_invoice;
3601     if ( $self->custnum ) {
3602       @cust_main_invoice =
3603         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3604     } else {
3605       @cust_main_invoice = ();
3606     }
3607     foreach my $cust_main_invoice ( @cust_main_invoice ) {
3608       #warn $cust_main_invoice->destnum;
3609       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3610         #warn $cust_main_invoice->destnum;
3611         my $error = $cust_main_invoice->delete;
3612         warn $error if $error;
3613       }
3614     }
3615     if ( $self->custnum ) {
3616       @cust_main_invoice =
3617         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3618     } else {
3619       @cust_main_invoice = ();
3620     }
3621     my %seen = map { $_->address => 1 } @cust_main_invoice;
3622     foreach my $address ( @{$arrayref} ) {
3623       next if exists $seen{$address} && $seen{$address};
3624       $seen{$address} = 1;
3625       my $cust_main_invoice = new FS::cust_main_invoice ( {
3626         'custnum' => $self->custnum,
3627         'dest'    => $address,
3628       } );
3629       my $error = $cust_main_invoice->insert;
3630       warn $error if $error;
3631     }
3632   }
3633
3634   if ( $self->custnum ) {
3635     map { $_->address }
3636       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3637   } else {
3638     ();
3639   }
3640
3641 }
3642
3643 =item check_invoicing_list ARRAYREF
3644
3645 Checks these arguements as valid input for the invoicing_list method.  If there
3646 is an error, returns the error, otherwise returns false.
3647
3648 =cut
3649
3650 sub check_invoicing_list {
3651   my( $self, $arrayref ) = @_;
3652   foreach my $address ( @{$arrayref} ) {
3653
3654     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3655       return 'Can\'t add FAX invoice destination with a blank FAX number.';
3656     }
3657
3658     my $cust_main_invoice = new FS::cust_main_invoice ( {
3659       'custnum' => $self->custnum,
3660       'dest'    => $address,
3661     } );
3662     my $error = $self->custnum
3663                 ? $cust_main_invoice->check
3664                 : $cust_main_invoice->checkdest
3665     ;
3666     return $error if $error;
3667   }
3668   '';
3669 }
3670
3671 =item set_default_invoicing_list
3672
3673 Sets the invoicing list to all accounts associated with this customer,
3674 overwriting any previous invoicing list.
3675
3676 =cut
3677
3678 sub set_default_invoicing_list {
3679   my $self = shift;
3680   $self->invoicing_list($self->all_emails);
3681 }
3682
3683 =item all_emails
3684
3685 Returns the email addresses of all accounts provisioned for this customer.
3686
3687 =cut
3688
3689 sub all_emails {
3690   my $self = shift;
3691   my %list;
3692   foreach my $cust_pkg ( $self->all_pkgs ) {
3693     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3694     my @svc_acct =
3695       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3696         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3697           @cust_svc;
3698     $list{$_}=1 foreach map { $_->email } @svc_acct;
3699   }
3700   keys %list;
3701 }
3702
3703 =item invoicing_list_addpost
3704
3705 Adds postal invoicing to this customer.  If this customer is already configured
3706 to receive postal invoices, does nothing.
3707
3708 =cut
3709
3710 sub invoicing_list_addpost {
3711   my $self = shift;
3712   return if grep { $_ eq 'POST' } $self->invoicing_list;
3713   my @invoicing_list = $self->invoicing_list;
3714   push @invoicing_list, 'POST';
3715   $self->invoicing_list(\@invoicing_list);
3716 }
3717
3718 =item invoicing_list_emailonly
3719
3720 Returns the list of email invoice recipients (invoicing_list without non-email
3721 destinations such as POST and FAX).
3722
3723 =cut
3724
3725 sub invoicing_list_emailonly {
3726   my $self = shift;
3727   warn "$me invoicing_list_emailonly called"
3728     if $DEBUG;
3729   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3730 }
3731
3732 =item invoicing_list_emailonly_scalar
3733
3734 Returns the list of email invoice recipients (invoicing_list without non-email
3735 destinations such as POST and FAX) as a comma-separated scalar.
3736
3737 =cut
3738
3739 sub invoicing_list_emailonly_scalar {
3740   my $self = shift;
3741   warn "$me invoicing_list_emailonly_scalar called"
3742     if $DEBUG;
3743   join(', ', $self->invoicing_list_emailonly);
3744 }
3745
3746 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3747
3748 Returns an array of customers referred by this customer (referral_custnum set
3749 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3750 customers referred by customers referred by this customer and so on, inclusive.
3751 The default behavior is DEPTH 1 (no recursion).
3752
3753 =cut
3754
3755 sub referral_cust_main {
3756   my $self = shift;
3757   my $depth = @_ ? shift : 1;
3758   my $exclude = @_ ? shift : {};
3759
3760   my @cust_main =
3761     map { $exclude->{$_->custnum}++; $_; }
3762       grep { ! $exclude->{ $_->custnum } }
3763         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3764
3765   if ( $depth > 1 ) {
3766     push @cust_main,
3767       map { $_->referral_cust_main($depth-1, $exclude) }
3768         @cust_main;
3769   }
3770
3771   @cust_main;
3772 }
3773
3774 =item referral_cust_main_ncancelled
3775
3776 Same as referral_cust_main, except only returns customers with uncancelled
3777 packages.
3778
3779 =cut
3780
3781 sub referral_cust_main_ncancelled {
3782   my $self = shift;
3783   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3784 }
3785
3786 =item referral_cust_pkg [ DEPTH ]
3787
3788 Like referral_cust_main, except returns a flat list of all unsuspended (and
3789 uncancelled) packages for each customer.  The number of items in this list may
3790 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3791
3792 =cut
3793
3794 sub referral_cust_pkg {
3795   my $self = shift;
3796   my $depth = @_ ? shift : 1;
3797
3798   map { $_->unsuspended_pkgs }
3799     grep { $_->unsuspended_pkgs }
3800       $self->referral_cust_main($depth);
3801 }
3802
3803 =item referring_cust_main
3804
3805 Returns the single cust_main record for the customer who referred this customer
3806 (referral_custnum), or false.
3807
3808 =cut
3809
3810 sub referring_cust_main {
3811   my $self = shift;
3812   return '' unless $self->referral_custnum;
3813   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3814 }
3815
3816 =item credit AMOUNT, REASON
3817
3818 Applies a credit to this customer.  If there is an error, returns the error,
3819 otherwise returns false.
3820
3821 =cut
3822
3823 sub credit {
3824   my( $self, $amount, $reason ) = @_;
3825   my $cust_credit = new FS::cust_credit {
3826     'custnum' => $self->custnum,
3827     'amount'  => $amount,
3828     'reason'  => $reason,
3829   };
3830   $cust_credit->insert;
3831 }
3832
3833 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3834
3835 Creates a one-time charge for this customer.  If there is an error, returns
3836 the error, otherwise returns false.
3837
3838 =cut
3839
3840 sub charge {
3841   my $self = shift;
3842   my ( $amount, $pkg, $comment, $taxclass, $additional );
3843   if ( ref( $_[0] ) ) {
3844     $amount     = $_[0]->{amount};
3845     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3846     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
3847                                            : '$'. sprintf("%.2f",$amount);
3848     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3849     $additional = $_[0]->{additional};
3850   }else{
3851     $amount     = shift;
3852     $pkg        = @_ ? shift : 'One-time charge';
3853     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
3854     $taxclass   = @_ ? shift : '';
3855     $additional = [];
3856   }
3857
3858   local $SIG{HUP} = 'IGNORE';
3859   local $SIG{INT} = 'IGNORE';
3860   local $SIG{QUIT} = 'IGNORE';
3861   local $SIG{TERM} = 'IGNORE';
3862   local $SIG{TSTP} = 'IGNORE';
3863   local $SIG{PIPE} = 'IGNORE';
3864
3865   my $oldAutoCommit = $FS::UID::AutoCommit;
3866   local $FS::UID::AutoCommit = 0;
3867   my $dbh = dbh;
3868
3869   my $part_pkg = new FS::part_pkg ( {
3870     'pkg'      => $pkg,
3871     'comment'  => $comment,
3872     'plan'     => 'flat',
3873     'freq'     => 0,
3874     'disabled' => 'Y',
3875     'taxclass' => $taxclass,
3876   } );
3877
3878   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3879                         ( 0 .. @$additional - 1 )
3880                   ),
3881                   'additional_count' => scalar(@$additional),
3882                   'setup_fee' => $amount,
3883                 );
3884
3885   my $error = $part_pkg->insert( options => \%options );
3886   if ( $error ) {
3887     $dbh->rollback if $oldAutoCommit;
3888     return $error;
3889   }
3890
3891   my $pkgpart = $part_pkg->pkgpart;
3892   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3893   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3894     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3895     $error = $type_pkgs->insert;
3896     if ( $error ) {
3897       $dbh->rollback if $oldAutoCommit;
3898       return $error;
3899     }
3900   }
3901
3902   my $cust_pkg = new FS::cust_pkg ( {
3903     'custnum' => $self->custnum,
3904     'pkgpart' => $pkgpart,
3905   } );
3906
3907   $error = $cust_pkg->insert;
3908   if ( $error ) {
3909     $dbh->rollback if $oldAutoCommit;
3910     return $error;
3911   }
3912
3913   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3914   '';
3915
3916 }
3917
3918 =item cust_bill
3919
3920 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3921
3922 =cut
3923
3924 sub cust_bill {
3925   my $self = shift;
3926   sort { $a->_date <=> $b->_date }
3927     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3928 }
3929
3930 =item open_cust_bill
3931
3932 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3933 customer.
3934
3935 =cut
3936
3937 sub open_cust_bill {
3938   my $self = shift;
3939   grep { $_->owed > 0 } $self->cust_bill;
3940 }
3941
3942 =item cust_credit
3943
3944 Returns all the credits (see L<FS::cust_credit>) for this customer.
3945
3946 =cut
3947
3948 sub cust_credit {
3949   my $self = shift;
3950   sort { $a->_date <=> $b->_date }
3951     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3952 }
3953
3954 =item cust_pay
3955
3956 Returns all the payments (see L<FS::cust_pay>) for this customer.
3957
3958 =cut
3959
3960 sub cust_pay {
3961   my $self = shift;
3962   sort { $a->_date <=> $b->_date }
3963     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3964 }
3965
3966 =item cust_pay_void
3967
3968 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3969
3970 =cut
3971
3972 sub cust_pay_void {
3973   my $self = shift;
3974   sort { $a->_date <=> $b->_date }
3975     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3976 }
3977
3978
3979 =item cust_refund
3980
3981 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3982
3983 =cut
3984
3985 sub cust_refund {
3986   my $self = shift;
3987   sort { $a->_date <=> $b->_date }
3988     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3989 }
3990
3991 =item name
3992
3993 Returns a name string for this customer, either "Company (Last, First)" or
3994 "Last, First".
3995
3996 =cut
3997
3998 sub name {
3999   my $self = shift;
4000   my $name = $self->contact;
4001   $name = $self->company. " ($name)" if $self->company;
4002   $name;
4003 }
4004
4005 =item ship_name
4006
4007 Returns a name string for this (service/shipping) contact, either
4008 "Company (Last, First)" or "Last, First".
4009
4010 =cut
4011
4012 sub ship_name {
4013   my $self = shift;
4014   if ( $self->get('ship_last') ) {
4015     my $name = $self->ship_contact;
4016     $name = $self->ship_company. " ($name)" if $self->ship_company;
4017     $name;
4018   } else {
4019     $self->name;
4020   }
4021 }
4022
4023 =item contact
4024
4025 Returns this customer's full (billing) contact name only, "Last, First"
4026
4027 =cut
4028
4029 sub contact {
4030   my $self = shift;
4031   $self->get('last'). ', '. $self->first;
4032 }
4033
4034 =item ship_contact
4035
4036 Returns this customer's full (shipping) contact name only, "Last, First"
4037
4038 =cut
4039
4040 sub ship_contact {
4041   my $self = shift;
4042   $self->get('ship_last')
4043     ? $self->get('ship_last'). ', '. $self->ship_first
4044     : $self->contact;
4045 }
4046
4047 =item country_full
4048
4049 Returns this customer's full country name
4050
4051 =cut
4052
4053 sub country_full {
4054   my $self = shift;
4055   code2country($self->country);
4056 }
4057
4058 =item cust_status
4059
4060 =item status
4061
4062 Returns a status string for this customer, currently:
4063
4064 =over 4
4065
4066 =item prospect - No packages have ever been ordered
4067
4068 =item active - One or more recurring packages is active
4069
4070 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4071
4072 =item suspended - All non-cancelled recurring packages are suspended
4073
4074 =item cancelled - All recurring packages are cancelled
4075
4076 =back
4077
4078 =cut
4079
4080 sub status { shift->cust_status(@_); }
4081
4082 sub cust_status {
4083   my $self = shift;
4084   for my $status (qw( prospect active inactive suspended cancelled )) {
4085     my $method = $status.'_sql';
4086     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4087     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4088     $sth->execute( ($self->custnum) x $numnum )
4089       or die "Error executing 'SELECT $sql': ". $sth->errstr;
4090     return $status if $sth->fetchrow_arrayref->[0];
4091   }
4092 }
4093
4094 =item ucfirst_cust_status
4095
4096 =item ucfirst_status
4097
4098 Returns the status with the first character capitalized.
4099
4100 =cut
4101
4102 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4103
4104 sub ucfirst_cust_status {
4105   my $self = shift;
4106   ucfirst($self->cust_status);
4107 }
4108
4109 =item statuscolor
4110
4111 Returns a hex triplet color string for this customer's status.
4112
4113 =cut
4114
4115 use vars qw(%statuscolor);
4116 %statuscolor = (
4117   'prospect'  => '7e0079', #'000000', #black?  naw, purple
4118   'active'    => '00CC00', #green
4119   'inactive'  => '0000CC', #blue
4120   'suspended' => 'FF9900', #yellow
4121   'cancelled' => 'FF0000', #red
4122 );
4123
4124 sub statuscolor { shift->cust_statuscolor(@_); }
4125
4126 sub cust_statuscolor {
4127   my $self = shift;
4128   $statuscolor{$self->cust_status};
4129 }
4130
4131 =back
4132
4133 =head1 CLASS METHODS
4134
4135 =over 4
4136
4137 =item prospect_sql
4138
4139 Returns an SQL expression identifying prospective cust_main records (customers
4140 with no packages ever ordered)
4141
4142 =cut
4143
4144 use vars qw($select_count_pkgs);
4145 $select_count_pkgs =
4146   "SELECT COUNT(*) FROM cust_pkg
4147     WHERE cust_pkg.custnum = cust_main.custnum";
4148
4149 sub select_count_pkgs_sql {
4150   $select_count_pkgs;
4151 }
4152
4153 sub prospect_sql { "
4154   0 = ( $select_count_pkgs )
4155 "; }
4156
4157 =item active_sql
4158
4159 Returns an SQL expression identifying active cust_main records (customers with
4160 no active recurring packages, but otherwise unsuspended/uncancelled).
4161
4162 =cut
4163
4164 sub active_sql { "
4165   0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
4166       )
4167 "; }
4168
4169 =item inactive_sql
4170
4171 Returns an SQL expression identifying inactive cust_main records (customers with
4172 active recurring packages).
4173
4174 =cut
4175
4176 sub inactive_sql { "
4177   0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
4178   AND
4179   0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
4180 "; }
4181
4182 =item susp_sql
4183 =item suspended_sql
4184
4185 Returns an SQL expression identifying suspended cust_main records.
4186
4187 =cut
4188
4189
4190 sub suspended_sql { susp_sql(@_); }
4191 sub susp_sql { "
4192     0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
4193     AND
4194     0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
4195 "; }
4196
4197 =item cancel_sql
4198 =item cancelled_sql
4199
4200 Returns an SQL expression identifying cancelled cust_main records.
4201
4202 =cut
4203
4204 sub cancelled_sql { cancel_sql(@_); }
4205 sub cancel_sql {
4206
4207   my $recurring_sql = FS::cust_pkg->recurring_sql;
4208   #my $recurring_sql = "
4209   #  '0' != ( select freq from part_pkg
4210   #             where cust_pkg.pkgpart = part_pkg.pkgpart )
4211   #";
4212
4213   "
4214     0 < ( $select_count_pkgs )
4215     AND 0 = ( $select_count_pkgs AND $recurring_sql
4216                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4217             )
4218   ";
4219 }
4220
4221 =item uncancel_sql
4222 =item uncancelled_sql
4223
4224 Returns an SQL expression identifying un-cancelled cust_main records.
4225
4226 =cut
4227
4228 sub uncancelled_sql { uncancel_sql(@_); }
4229 sub uncancel_sql { "
4230   ( 0 < ( $select_count_pkgs
4231                    AND ( cust_pkg.cancel IS NULL
4232                          OR cust_pkg.cancel = 0
4233                        )
4234         )
4235     OR 0 = ( $select_count_pkgs )
4236   )
4237 "; }
4238
4239 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
4240
4241 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
4242 records.  Currently, I<first>, I<last> and/or I<company> may be specified (the
4243 appropriate ship_ field is also searched).
4244
4245 Additional options are the same as FS::Record::qsearch
4246
4247 =cut
4248
4249 sub fuzzy_search {
4250   my( $self, $fuzzy, $hash, @opt) = @_;
4251   #$self
4252   $hash ||= {};
4253   my @cust_main = ();
4254
4255   check_and_rebuild_fuzzyfiles();
4256   foreach my $field ( keys %$fuzzy ) {
4257
4258     my $all = $self->all_X($field);
4259     next unless scalar(@$all);
4260
4261     my %match = ();
4262     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
4263
4264     my @fcust = ();
4265     foreach ( keys %match ) {
4266       push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
4267       push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
4268     }
4269     my %fsaw = ();
4270     push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
4271   }
4272
4273   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
4274   my %saw = ();
4275   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
4276
4277   @cust_main;
4278
4279 }
4280
4281 =item masked FIELD
4282
4283 Returns a masked version of the named field
4284
4285 =cut
4286
4287 sub masked {
4288 my ($self,$field) = @_;
4289
4290 # Show last four
4291
4292 'x'x(length($self->getfield($field))-4).
4293   substr($self->getfield($field), (length($self->getfield($field))-4));
4294
4295 }
4296
4297 =back
4298
4299 =head1 SUBROUTINES
4300
4301 =over 4
4302
4303 =item smart_search OPTION => VALUE ...
4304
4305 Accepts the following options: I<search>, the string to search for.  The string
4306 will be searched for as a customer number, phone number, name or company name,
4307 as an exact, or, in some cases, a substring or fuzzy match (see the source code
4308 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
4309 skip fuzzy matching when an exact match is found.
4310
4311 Any additional options are treated as an additional qualifier on the search
4312 (i.e. I<agentnum>).
4313
4314 Returns a (possibly empty) array of FS::cust_main objects.
4315
4316 =cut
4317
4318 sub smart_search {
4319   my %options = @_;
4320
4321   #here is the agent virtualization
4322   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
4323
4324   my @cust_main = ();
4325
4326   my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
4327   my $search = delete $options{'search'};
4328   ( my $alphanum_search = $search ) =~ s/\W//g;
4329
4330   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
4331
4332     #false laziness w/Record::ut_phone
4333     my $phonen = "$1-$2-$3";
4334     $phonen .= " x$4" if $4;
4335
4336     push @cust_main, qsearch( {
4337       'table'   => 'cust_main',
4338       'hashref' => { %options },
4339       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
4340                      ' ( '.
4341                          join(' OR ', map "$_ = '$phonen'",
4342                                           qw( daytime night fax
4343                                               ship_daytime ship_night ship_fax )
4344                              ).
4345                      ' ) '.
4346                      " AND $agentnums_sql", #agent virtualization
4347     } );
4348
4349     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
4350       #try looking for matches with extensions unless one was specified
4351
4352       push @cust_main, qsearch( {
4353         'table'   => 'cust_main',
4354         'hashref' => { %options },
4355         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
4356                        ' ( '.
4357                            join(' OR ', map "$_ LIKE '$phonen\%'",
4358                                             qw( daytime night
4359                                                 ship_daytime ship_night )
4360                                ).
4361                        ' ) '.
4362                        " AND $agentnums_sql", #agent virtualization
4363       } );
4364
4365     }
4366
4367   } elsif ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
4368
4369     push @cust_main, qsearch( {
4370       'table'     => 'cust_main',
4371       'hashref'   => { 'custnum' => $1, %options },
4372       'extra_sql' => " AND $agentnums_sql", #agent virtualization
4373     } );
4374
4375   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
4376
4377     my($company, $last, $first) = ( $1, $2, $3 );
4378
4379     # "Company (Last, First)"
4380     #this is probably something a browser remembered,
4381     #so just do an exact search
4382
4383     foreach my $prefix ( '', 'ship_' ) {
4384       push @cust_main, qsearch( {
4385         'table'     => 'cust_main',
4386         'hashref'   => { $prefix.'first'   => $first,
4387                          $prefix.'last'    => $last,
4388                          $prefix.'company' => $company,
4389                          %options,
4390                        },
4391         'extra_sql' => " AND $agentnums_sql",
4392       } );
4393     }
4394
4395   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
4396                                               # try (ship_){last,company}
4397
4398     my $value = lc($1);
4399
4400     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
4401     # # full strings the browser remembers won't work
4402     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
4403
4404     use Lingua::EN::NameParse;
4405     my $NameParse = new Lingua::EN::NameParse(
4406              auto_clean     => 1,
4407              allow_reversed => 1,
4408     );
4409
4410     my($last, $first) = ( '', '' );
4411     #maybe disable this too and just rely on NameParse?
4412     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
4413
4414       ($last, $first) = ( $1, $2 );
4415
4416     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
4417     } elsif ( ! $NameParse->parse($value) ) {
4418
4419       my %name = $NameParse->components;
4420       $first = $name{'given_name_1'};
4421       $last  = $name{'surname_1'};
4422
4423     }
4424
4425     if ( $first && $last ) {
4426
4427       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
4428
4429       #exact
4430       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
4431       $sql .= "
4432         (     ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
4433            OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
4434         )";
4435
4436       push @cust_main, qsearch( {
4437         'table'     => 'cust_main',
4438         'hashref'   => \%options,
4439         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
4440       } );
4441
4442       # or it just be something that was typed in... (try that in a sec)
4443
4444     }
4445
4446     my $q_value = dbh->quote($value);
4447
4448     #exact
4449     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
4450     $sql .= " (    LOWER(last)         = $q_value
4451                 OR LOWER(company)      = $q_value
4452                 OR LOWER(ship_last)    = $q_value
4453                 OR LOWER(ship_company) = $q_value
4454               )";
4455
4456     push @cust_main, qsearch( {
4457       'table'     => 'cust_main',
4458       'hashref'   => \%options,
4459       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
4460     } );
4461
4462     #always do substring & fuzzy,
4463     #getting complains searches are not returning enough
4464     unless ( @cust_main && $skip_fuzzy ) {  #no exact match, trying substring/fuzzy
4465
4466       #still some false laziness w/ search/cust_main.cgi
4467
4468       #substring
4469
4470       my @hashrefs = (
4471         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
4472         { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
4473       );
4474
4475       if ( $first && $last ) {
4476
4477         push @hashrefs,
4478           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
4479             'last'         => { op=>'ILIKE', value=>"%$last%" },
4480           },
4481           { 'ship_first'   => { op=>'ILIKE', value=>"%$first%" },
4482             'ship_last'    => { op=>'ILIKE', value=>"%$last%" },
4483           },
4484         ;
4485
4486       } else {
4487
4488         push @hashrefs,
4489           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
4490           { 'ship_last'    => { op=>'ILIKE', value=>"%$value%" }, },
4491         ;
4492       }
4493
4494       foreach my $hashref ( @hashrefs ) {
4495
4496         push @cust_main, qsearch( {
4497           'table'     => 'cust_main',
4498           'hashref'   => { %$hashref,
4499                            %options,
4500                          },
4501           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
4502         } );
4503
4504       }
4505
4506       #fuzzy
4507       my @fuzopts = (
4508         \%options,                #hashref
4509         '',                       #select
4510         " AND $agentnums_sql",    #extra_sql  #agent virtualization
4511       );
4512
4513       if ( $first && $last ) {
4514         push @cust_main, FS::cust_main->fuzzy_search(
4515           { 'last'   => $last,    #fuzzy hashref
4516             'first'  => $first }, #
4517           @fuzopts
4518         );
4519       }
4520       foreach my $field ( 'last', 'company' ) {
4521         push @cust_main,
4522           FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
4523       }
4524
4525     }
4526
4527     #eliminate duplicates
4528     my %saw = ();
4529     @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
4530
4531   }
4532
4533   @cust_main;
4534
4535 }
4536
4537 =item check_and_rebuild_fuzzyfiles
4538
4539 =cut
4540
4541 use vars qw(@fuzzyfields);
4542 @fuzzyfields = ( 'last', 'first', 'company' );
4543
4544 sub check_and_rebuild_fuzzyfiles {
4545   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4546   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
4547 }
4548
4549 =item rebuild_fuzzyfiles
4550
4551 =cut
4552
4553 sub rebuild_fuzzyfiles {
4554
4555   use Fcntl qw(:flock);
4556
4557   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4558   mkdir $dir, 0700 unless -d $dir;
4559
4560   foreach my $fuzzy ( @fuzzyfields ) {
4561
4562     open(LOCK,">>$dir/cust_main.$fuzzy")
4563       or die "can't open $dir/cust_main.$fuzzy: $!";
4564     flock(LOCK,LOCK_EX)
4565       or die "can't lock $dir/cust_main.$fuzzy: $!";
4566
4567     open (CACHE,">$dir/cust_main.$fuzzy.tmp")
4568       or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
4569
4570     foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
4571       my $sth = dbh->prepare("SELECT $field FROM cust_main".
4572                              " WHERE $field != '' AND $field IS NOT NULL");
4573       $sth->execute or die $sth->errstr;
4574
4575       while ( my $row = $sth->fetchrow_arrayref ) {
4576         print CACHE $row->[0]. "\n";
4577       }
4578
4579     }
4580
4581     close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
4582
4583     rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
4584     close LOCK;
4585   }
4586
4587 }
4588
4589 =item all_X
4590
4591 =cut
4592
4593 sub all_X {
4594   my( $self, $field ) = @_;
4595   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4596   open(CACHE,"<$dir/cust_main.$field")
4597     or die "can't open $dir/cust_main.$field: $!";
4598   my @array = map { chomp; $_; } <CACHE>;
4599   close CACHE;
4600   \@array;
4601 }
4602
4603 =item append_fuzzyfiles LASTNAME COMPANY
4604
4605 =cut
4606
4607 sub append_fuzzyfiles {
4608   #my( $first, $last, $company ) = @_;
4609
4610   &check_and_rebuild_fuzzyfiles;
4611
4612   use Fcntl qw(:flock);
4613
4614   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4615
4616   foreach my $field (qw( first last company )) {
4617     my $value = shift;
4618
4619     if ( $value ) {
4620
4621       open(CACHE,">>$dir/cust_main.$field")
4622         or die "can't open $dir/cust_main.$field: $!";
4623       flock(CACHE,LOCK_EX)
4624         or die "can't lock $dir/cust_main.$field: $!";
4625
4626       print CACHE "$value\n";
4627
4628       flock(CACHE,LOCK_UN)
4629         or die "can't unlock $dir/cust_main.$field: $!";
4630       close CACHE;
4631     }
4632
4633   }
4634
4635   1;
4636 }
4637
4638 =item batch_import
4639
4640 =cut
4641
4642 sub batch_import {
4643   my $param = shift;
4644   #warn join('-',keys %$param);
4645   my $fh = $param->{filehandle};
4646   my $agentnum = $param->{agentnum};
4647
4648   my $refnum = $param->{refnum};
4649   my $pkgpart = $param->{pkgpart};
4650
4651   #my @fields = @{$param->{fields}};
4652   my $format = $param->{'format'};
4653   my @fields;
4654   my $payby;
4655   if ( $format eq 'simple' ) {
4656     @fields = qw( cust_pkg.setup dayphone first last
4657                   address1 address2 city state zip comments );
4658     $payby = 'BILL';
4659   } elsif ( $format eq 'extended' ) {
4660     @fields = qw( agent_custid refnum
4661                   last first address1 address2 city state zip country
4662                   daytime night
4663                   ship_last ship_first ship_address1 ship_address2
4664                   ship_city ship_state ship_zip ship_country
4665                   payinfo paycvv paydate
4666                   invoicing_list
4667                   cust_pkg.pkgpart
4668                   svc_acct.username svc_acct._password
4669                 );
4670     $payby = 'BILL';
4671   } else {
4672     die "unknown format $format";
4673   }
4674
4675   eval "use Text::CSV_XS;";
4676   die $@ if $@;
4677
4678   my $csv = new Text::CSV_XS;
4679   #warn $csv;
4680   #warn $fh;
4681
4682   my $imported = 0;
4683   #my $columns;
4684
4685   local $SIG{HUP} = 'IGNORE';
4686   local $SIG{INT} = 'IGNORE';
4687   local $SIG{QUIT} = 'IGNORE';
4688   local $SIG{TERM} = 'IGNORE';
4689   local $SIG{TSTP} = 'IGNORE';
4690   local $SIG{PIPE} = 'IGNORE';
4691
4692   my $oldAutoCommit = $FS::UID::AutoCommit;
4693   local $FS::UID::AutoCommit = 0;
4694   my $dbh = dbh;
4695
4696   #while ( $columns = $csv->getline($fh) ) {
4697   my $line;
4698   while ( defined($line=<$fh>) ) {
4699
4700     $csv->parse($line) or do {
4701       $dbh->rollback if $oldAutoCommit;
4702       return "can't parse: ". $csv->error_input();
4703     };
4704
4705     my @columns = $csv->fields();
4706     #warn join('-',@columns);
4707
4708     my %cust_main = (
4709       agentnum => $agentnum,
4710       refnum   => $refnum,
4711       country  => $conf->config('countrydefault') || 'US',
4712       payby    => $payby, #default
4713       paydate  => '12/2037', #default
4714     );
4715     my $billtime = time;
4716     my %cust_pkg = ( pkgpart => $pkgpart );
4717     my %svc_acct = ();
4718     foreach my $field ( @fields ) {
4719
4720       if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|expire|cancel)$/ ) {
4721
4722         #$cust_pkg{$1} = str2time( shift @$columns );
4723         if ( $1 eq 'pkgpart' ) {
4724           $cust_pkg{$1} = shift @columns;
4725         } elsif ( $1 eq 'setup' ) {
4726           $billtime = str2time(shift @columns);
4727         } else {
4728           $cust_pkg{$1} = str2time( shift @columns );
4729         }
4730
4731       } elsif ( $field =~ /^svc_acct\.(username|_password)$/ ) {
4732
4733         $svc_acct{$1} = shift @columns;
4734
4735       } else {
4736
4737         #refnum interception
4738         if ( $field eq 'refnum' && $columns[0] !~ /^\s*(\d+)\s*$/ ) {
4739
4740           my $referral = $columns[0];
4741           my %hash = ( 'referral' => $referral,
4742                        'agentnum' => $agentnum,
4743                        'disabled' => '',
4744                      );
4745
4746           my $part_referral = qsearchs('part_referral', \%hash )
4747                               || new FS::part_referral \%hash;
4748
4749           unless ( $part_referral->refnum ) {
4750             my $error = $part_referral->insert;
4751             if ( $error ) {
4752               $dbh->rollback if $oldAutoCommit;
4753               return "can't auto-insert advertising source: $referral: $error";
4754             }
4755           }
4756
4757           $columns[0] = $part_referral->refnum;
4758         }
4759
4760         #$cust_main{$field} = shift @$columns;
4761         $cust_main{$field} = shift @columns;
4762       }
4763     }
4764
4765     $cust_main{'payby'} = 'CARD' if length($cust_main{'payinfo'});
4766
4767     my $invoicing_list = $cust_main{'invoicing_list'}
4768                            ? [ delete $cust_main{'invoicing_list'} ]
4769                            : [];
4770
4771     my $cust_main = new FS::cust_main ( \%cust_main );
4772
4773     use Tie::RefHash;
4774     tie my %hash, 'Tie::RefHash'; #this part is important
4775
4776     if ( $cust_pkg{'pkgpart'} ) {
4777       my $cust_pkg = new FS::cust_pkg ( \%cust_pkg );
4778
4779       my @svc_acct = ();
4780       if ( $svc_acct{'username'} ) {
4781         my $part_pkg = $cust_pkg->part_pkg;
4782         unless ( $part_pkg ) {
4783           $dbh->rollback if $oldAutoCommit;
4784           return "unknown pkgnum ". $cust_pkg{'pkgpart'};
4785         }
4786         $svc_acct{svcpart} = $part_pkg->svcpart( 'svc_acct' );
4787         push @svc_acct, new FS::svc_acct ( \%svc_acct )
4788       }
4789
4790       $hash{$cust_pkg} = \@svc_acct;
4791     }
4792
4793     my $error = $cust_main->insert( \%hash, $invoicing_list );
4794
4795     if ( $error ) {
4796       $dbh->rollback if $oldAutoCommit;
4797       return "can't insert customer for $line: $error";
4798     }
4799
4800     if ( $format eq 'simple' ) {
4801
4802       #false laziness w/bill.cgi
4803       $error = $cust_main->bill( 'time' => $billtime );
4804       if ( $error ) {
4805         $dbh->rollback if $oldAutoCommit;
4806         return "can't bill customer for $line: $error";
4807       }
4808
4809       $cust_main->apply_payments_and_credits;
4810
4811       $error = $cust_main->collect();
4812       if ( $error ) {
4813         $dbh->rollback if $oldAutoCommit;
4814         return "can't collect customer for $line: $error";
4815       }
4816
4817     }
4818
4819     $imported++;
4820   }
4821
4822   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4823
4824   return "Empty file!" unless $imported;
4825
4826   ''; #no error
4827
4828 }
4829
4830 =item batch_charge
4831
4832 =cut
4833
4834 sub batch_charge {
4835   my $param = shift;
4836   #warn join('-',keys %$param);
4837   my $fh = $param->{filehandle};
4838   my @fields = @{$param->{fields}};
4839
4840   eval "use Text::CSV_XS;";
4841   die $@ if $@;
4842
4843   my $csv = new Text::CSV_XS;
4844   #warn $csv;
4845   #warn $fh;
4846
4847   my $imported = 0;
4848   #my $columns;
4849
4850   local $SIG{HUP} = 'IGNORE';
4851   local $SIG{INT} = 'IGNORE';
4852   local $SIG{QUIT} = 'IGNORE';
4853   local $SIG{TERM} = 'IGNORE';
4854   local $SIG{TSTP} = 'IGNORE';
4855   local $SIG{PIPE} = 'IGNORE';
4856
4857   my $oldAutoCommit = $FS::UID::AutoCommit;
4858   local $FS::UID::AutoCommit = 0;
4859   my $dbh = dbh;
4860
4861   #while ( $columns = $csv->getline($fh) ) {
4862   my $line;
4863   while ( defined($line=<$fh>) ) {
4864
4865     $csv->parse($line) or do {
4866       $dbh->rollback if $oldAutoCommit;
4867       return "can't parse: ". $csv->error_input();
4868     };
4869
4870     my @columns = $csv->fields();
4871     #warn join('-',@columns);
4872
4873     my %row = ();
4874     foreach my $field ( @fields ) {
4875       $row{$field} = shift @columns;
4876     }
4877
4878     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
4879     unless ( $cust_main ) {
4880       $dbh->rollback if $oldAutoCommit;
4881       return "unknown custnum $row{'custnum'}";
4882     }
4883
4884     if ( $row{'amount'} > 0 ) {
4885       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4886       if ( $error ) {
4887         $dbh->rollback if $oldAutoCommit;
4888         return $error;
4889       }
4890       $imported++;
4891     } elsif ( $row{'amount'} < 0 ) {
4892       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4893                                       $row{'pkg'}                         );
4894       if ( $error ) {
4895         $dbh->rollback if $oldAutoCommit;
4896         return $error;
4897       }
4898       $imported++;
4899     } else {
4900       #hmm?
4901     }
4902
4903   }
4904
4905   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4906
4907   return "Empty file!" unless $imported;
4908
4909   ''; #no error
4910
4911 }
4912
4913 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4914
4915 Sends a templated email notification to the customer (see L<Text::Template>).
4916
4917 OPTIONS is a hash and may include
4918
4919 I<from> - the email sender (default is invoice_from)
4920
4921 I<to> - comma-separated scalar or arrayref of recipients
4922    (default is invoicing_list)
4923
4924 I<subject> - The subject line of the sent email notification
4925    (default is "Notice from company_name")
4926
4927 I<extra_fields> - a hashref of name/value pairs which will be substituted
4928    into the template
4929
4930 The following variables are vavailable in the template.
4931
4932 I<$first> - the customer first name
4933 I<$last> - the customer last name
4934 I<$company> - the customer company
4935 I<$payby> - a description of the method of payment for the customer
4936             # would be nice to use FS::payby::shortname
4937 I<$payinfo> - the account information used to collect for this customer
4938 I<$expdate> - the expiration of the customer payment in seconds from epoch
4939
4940 =cut
4941
4942 sub notify {
4943   my ($customer, $template, %options) = @_;
4944
4945   return unless $conf->exists($template);
4946
4947   my $from = $conf->config('invoice_from') if $conf->exists('invoice_from');
4948   $from = $options{from} if exists($options{from});
4949
4950   my $to = join(',', $customer->invoicing_list_emailonly);
4951   $to = $options{to} if exists($options{to});
4952
4953   my $subject = "Notice from " . $conf->config('company_name')
4954     if $conf->exists('company_name');
4955   $subject = $options{subject} if exists($options{subject});
4956
4957   my $notify_template = new Text::Template (TYPE => 'ARRAY',
4958                                             SOURCE => [ map "$_\n",
4959                                               $conf->config($template)]
4960                                            )
4961     or die "can't create new Text::Template object: Text::Template::ERROR";
4962   $notify_template->compile()
4963     or die "can't compile template: Text::Template::ERROR";
4964
4965   my $paydate = $customer->paydate;
4966   $FS::notify_template::_template::first = $customer->first;
4967   $FS::notify_template::_template::last = $customer->last;
4968   $FS::notify_template::_template::company = $customer->company;
4969   $FS::notify_template::_template::payinfo = $customer->mask_payinfo;
4970   my $payby = $customer->payby;
4971   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4972   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4973
4974   #credit cards expire at the end of the month/year of their exp date
4975   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4976     $FS::notify_template::_template::payby = 'credit card';
4977     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4978     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4979     $expire_time--;
4980   }elsif ($payby eq 'COMP') {
4981     $FS::notify_template::_template::payby = 'complimentary account';
4982   }else{
4983     $FS::notify_template::_template::payby = 'current method';
4984   }
4985   $FS::notify_template::_template::expdate = $expire_time;
4986
4987   for (keys %{$options{extra_fields}}){
4988     no strict "refs";
4989     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4990   }
4991
4992   send_email(from => $from,
4993              to => $to,
4994              subject => $subject,
4995              body => $notify_template->fill_in( PACKAGE =>
4996                                                 'FS::notify_template::_template'                                              ),
4997             );
4998
4999 }
5000
5001 =back
5002
5003 =head1 BUGS
5004
5005 The delete method.
5006
5007 The delete method should possibly take an FS::cust_main object reference
5008 instead of a scalar customer number.
5009
5010 Bill and collect options should probably be passed as references instead of a
5011 list.
5012
5013 There should probably be a configuration file with a list of allowed credit
5014 card types.
5015
5016 No multiple currency support (probably a larger project than just this module).
5017
5018 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5019
5020 Birthdates rely on negative epoch values.
5021
5022 The payby for card/check batches is broken.  With mixed batching, bad
5023 things will happen.
5024
5025 =head1 SEE ALSO
5026
5027 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5028 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5029 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
5030
5031 =cut
5032
5033 1;
5034