FS/FS/cust_main.pm

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