FS/FS/cust_main.pm

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