FS/FS/cust_main.pm

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