FS/FS/cust_main.pm

   1 package FS::cust_main;
   2
   3 require 5.006;
   4 use strict;
   5 use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields
   6              $import $skip_fuzzyfiles $ignore_expired_card @paytypes);
   7 use vars qw( $realtime_bop_decline_quiet ); #ugh
   8 use Safe;
   9 use Carp;
  10 use Exporter;
  11 use Scalar::Util qw( blessed );
  12 use Time::Local qw(timelocal_nocheck);
  13 use Data::Dumper;
  14 use Tie::IxHash;
  15 use Digest::MD5 qw(md5_base64);
  16 use Date::Format;
  17 use Date::Parse;
  18 #use Date::Manip;
  19 use String::Approx qw(amatch);
  20 use Business::CreditCard 0.28;
  21 use Locale::Country;
  22 use Data::Dumper;
  23 use FS::UID qw( getotaker dbh driver_name );
  24 use FS::Record qw( qsearchs qsearch dbdef );
  25 use FS::Misc qw( send_email generate_ps do_print );
  26 use FS::Msgcat qw(gettext);
  27 use FS::cust_pkg;
  28 use FS::cust_svc;
  29 use FS::cust_bill;
  30 use FS::cust_bill_pkg;
  31 use FS::cust_pay;
  32 use FS::cust_pay_pending;
  33 use FS::cust_pay_void;
  34 use FS::cust_pay_batch;
  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_event;
  47 use FS::part_event_condition;
  48 #use FS::cust_event;
  49 use FS::type_pkgs;
  50 use FS::payment_gateway;
  51 use FS::agent_payment_gateway;
  52 use FS::banned_pay;
  53 use FS::payinfo_Mixin;
  54 use FS::TicketSystem;
  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(join('\n',$conf->config('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
1073   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1074               ? shift
1075               : $self->replace_old;
1076
1077   my @param = @_;
1078
1079   warn "$me replace called\n"
1080     if $DEBUG;
1081
1082   my $curuser = $FS::CurrentUser::CurrentUser;
1083   if (    $self->payby eq 'COMP'
1084        && $self->payby ne $old->payby
1085        && ! $curuser->access_right('Complimentary customer')
1086      )
1087   {
1088     return "You are not permitted to create complimentary accounts.";
1089   }
1090
1091   local($ignore_expired_card) = 1
1092     if $old->payby  =~ /^(CARD|DCRD)$/
1093     && $self->payby =~ /^(CARD|DCRD)$/
1094     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1095
1096   local $SIG{HUP} = 'IGNORE';
1097   local $SIG{INT} = 'IGNORE';
1098   local $SIG{QUIT} = 'IGNORE';
1099   local $SIG{TERM} = 'IGNORE';
1100   local $SIG{TSTP} = 'IGNORE';
1101   local $SIG{PIPE} = 'IGNORE';
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     || $self->ut_textn('invoice_terms')
1227   ;
1228   #barf.  need message catalogs.  i18n.  etc.
1229   $error .= "Please select an advertising source."
1230     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1231   return $error if $error;
1232
1233   return "Unknown agent"
1234     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1235
1236   return "Unknown refnum"
1237     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1238
1239   return "Unknown referring custnum: ". $self->referral_custnum
1240     unless ! $self->referral_custnum
1241            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1242
1243   if ( $self->ss eq '' ) {
1244     $self->ss('');
1245   } else {
1246     my $ss = $self->ss;
1247     $ss =~ s/\D//g;
1248     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1249       or return "Illegal social security number: ". $self->ss;
1250     $self->ss("$1-$2-$3");
1251   }
1252
1253
1254 # bad idea to disable, causes billing to fail because of no tax rates later
1255 #  unless ( $import ) {
1256     unless ( qsearch('cust_main_county', {
1257       'country' => $self->country,
1258       'state'   => '',
1259      } ) ) {
1260       return "Unknown state/county/country: ".
1261         $self->state. "/". $self->county. "/". $self->country
1262         unless qsearch('cust_main_county',{
1263           'state'   => $self->state,
1264           'county'  => $self->county,
1265           'country' => $self->country,
1266         } );
1267     }
1268 #  }
1269
1270   $error =
1271     $self->ut_phonen('daytime', $self->country)
1272     || $self->ut_phonen('night', $self->country)
1273     || $self->ut_phonen('fax', $self->country)
1274     || $self->ut_zip('zip', $self->country)
1275   ;
1276   return $error if $error;
1277
1278   if ( $conf->exists('cust_main-require_phone')
1279        && ! length($self->daytime) && ! length($self->night)
1280      ) {
1281
1282     my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1283                           ? 'Day Phone'
1284                           : FS::Msgcat::_gettext('daytime');
1285     my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1286                         ? 'Night Phone'
1287                         : FS::Msgcat::_gettext('night');
1288
1289     return "$daytime_label or $night_label is required"
1290
1291   }
1292
1293   if ( $self->has_ship_address
1294        && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1295                         $self->addr_fields )
1296      )
1297   {
1298     my $error =
1299       $self->ut_name('ship_last')
1300       || $self->ut_name('ship_first')
1301       || $self->ut_textn('ship_company')
1302       || $self->ut_text('ship_address1')
1303       || $self->ut_textn('ship_address2')
1304       || $self->ut_text('ship_city')
1305       || $self->ut_textn('ship_county')
1306       || $self->ut_textn('ship_state')
1307       || $self->ut_country('ship_country')
1308     ;
1309     return $error if $error;
1310
1311     #false laziness with above
1312     unless ( qsearchs('cust_main_county', {
1313       'country' => $self->ship_country,
1314       'state'   => '',
1315      } ) ) {
1316       return "Unknown ship_state/ship_county/ship_country: ".
1317         $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1318         unless qsearch('cust_main_county',{
1319           'state'   => $self->ship_state,
1320           'county'  => $self->ship_county,
1321           'country' => $self->ship_country,
1322         } );
1323     }
1324     #eofalse
1325
1326     $error =
1327       $self->ut_phonen('ship_daytime', $self->ship_country)
1328       || $self->ut_phonen('ship_night', $self->ship_country)
1329       || $self->ut_phonen('ship_fax', $self->ship_country)
1330       || $self->ut_zip('ship_zip', $self->ship_country)
1331     ;
1332     return $error if $error;
1333
1334     return "Unit # is required."
1335       if $self->ship_address2 =~ /^\s*$/
1336       && $conf->exists('cust_main-require_address2');
1337
1338   } else { # ship_ info eq billing info, so don't store dup info in database
1339
1340     $self->setfield("ship_$_", '')
1341       foreach $self->addr_fields;
1342
1343     return "Unit # is required."
1344       if $self->address2 =~ /^\s*$/
1345       && $conf->exists('cust_main-require_address2');
1346
1347   }
1348
1349   #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1350   #  or return "Illegal payby: ". $self->payby;
1351   #$self->payby($1);
1352   FS::payby->can_payby($self->table, $self->payby)
1353     or return "Illegal payby: ". $self->payby;
1354
1355   $error =    $self->ut_numbern('paystart_month')
1356            || $self->ut_numbern('paystart_year')
1357            || $self->ut_numbern('payissue')
1358            || $self->ut_textn('paytype')
1359   ;
1360   return $error if $error;
1361
1362   if ( $self->payip eq '' ) {
1363     $self->payip('');
1364   } else {
1365     $error = $self->ut_ip('payip');
1366     return $error if $error;
1367   }
1368
1369   # If it is encrypted and the private key is not availaible then we can't
1370   # check the credit card.
1371
1372   my $check_payinfo = 1;
1373
1374   if ($self->is_encrypted($self->payinfo)) {
1375     $check_payinfo = 0;
1376   }
1377
1378   if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1379
1380     my $payinfo = $self->payinfo;
1381     $payinfo =~ s/\D//g;
1382     $payinfo =~ /^(\d{13,16})$/
1383       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1384     $payinfo = $1;
1385     $self->payinfo($payinfo);
1386     validate($payinfo)
1387       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1388
1389     return gettext('unknown_card_type')
1390       if cardtype($self->payinfo) eq "Unknown";
1391
1392     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1393     if ( $ban ) {
1394       return 'Banned credit card: banned on '.
1395              time2str('%a %h %o at %r', $ban->_date).
1396              ' by '. $ban->otaker.
1397              ' (ban# '. $ban->bannum. ')';
1398     }
1399
1400     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1401       if ( cardtype($self->payinfo) eq 'American Express card' ) {
1402         $self->paycvv =~ /^(\d{4})$/
1403           or return "CVV2 (CID) for American Express cards is four digits.";
1404         $self->paycvv($1);
1405       } else {
1406         $self->paycvv =~ /^(\d{3})$/
1407           or return "CVV2 (CVC2/CID) is three digits.";
1408         $self->paycvv($1);
1409       }
1410     } else {
1411       $self->paycvv('');
1412     }
1413
1414     my $cardtype = cardtype($payinfo);
1415     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1416
1417       return "Start date or issue number is required for $cardtype cards"
1418         unless $self->paystart_month && $self->paystart_year or $self->payissue;
1419
1420       return "Start month must be between 1 and 12"
1421         if $self->paystart_month
1422            and $self->paystart_month < 1 || $self->paystart_month > 12;
1423
1424       return "Start year must be 1990 or later"
1425         if $self->paystart_year
1426            and $self->paystart_year < 1990;
1427
1428       return "Issue number must be beween 1 and 99"
1429         if $self->payissue
1430           and $self->payissue < 1 || $self->payissue > 99;
1431
1432     } else {
1433       $self->paystart_month('');
1434       $self->paystart_year('');
1435       $self->payissue('');
1436     }
1437
1438   } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1439
1440     my $payinfo = $self->payinfo;
1441     $payinfo =~ s/[^\d\@]//g;
1442     if ( $conf->exists('echeck-nonus') ) {
1443       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1444       $payinfo = "$1\@$2";
1445     } else {
1446       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1447       $payinfo = "$1\@$2";
1448     }
1449     $self->payinfo($payinfo);
1450     $self->paycvv('');
1451
1452     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1453     if ( $ban ) {
1454       return 'Banned ACH account: banned on '.
1455              time2str('%a %h %o at %r', $ban->_date).
1456              ' by '. $ban->otaker.
1457              ' (ban# '. $ban->bannum. ')';
1458     }
1459
1460   } elsif ( $self->payby eq 'LECB' ) {
1461
1462     my $payinfo = $self->payinfo;
1463     $payinfo =~ s/\D//g;
1464     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1465     $payinfo = $1;
1466     $self->payinfo($payinfo);
1467     $self->paycvv('');
1468
1469   } elsif ( $self->payby eq 'BILL' ) {
1470
1471     $error = $self->ut_textn('payinfo');
1472     return "Illegal P.O. number: ". $self->payinfo if $error;
1473     $self->paycvv('');
1474
1475   } elsif ( $self->payby eq 'COMP' ) {
1476
1477     my $curuser = $FS::CurrentUser::CurrentUser;
1478     if (    ! $self->custnum
1479          && ! $curuser->access_right('Complimentary customer')
1480        )
1481     {
1482       return "You are not permitted to create complimentary accounts."
1483     }
1484
1485     $error = $self->ut_textn('payinfo');
1486     return "Illegal comp account issuer: ". $self->payinfo if $error;
1487     $self->paycvv('');
1488
1489   } elsif ( $self->payby eq 'PREPAY' ) {
1490
1491     my $payinfo = $self->payinfo;
1492     $payinfo =~ s/\W//g; #anything else would just confuse things
1493     $self->payinfo($payinfo);
1494     $error = $self->ut_alpha('payinfo');
1495     return "Illegal prepayment identifier: ". $self->payinfo if $error;
1496     return "Unknown prepayment identifier"
1497       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1498     $self->paycvv('');
1499
1500   }
1501
1502   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1503     return "Expiration date required"
1504       unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1505     $self->paydate('');
1506   } else {
1507     my( $m, $y );
1508     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1509       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1510     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1511       ( $m, $y ) = ( $3, "20$2" );
1512     } else {
1513       return "Illegal expiration date: ". $self->paydate;
1514     }
1515     $self->paydate("$y-$m-01");
1516     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1517     return gettext('expired_card')
1518       if !$import
1519       && !$ignore_expired_card
1520       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1521   }
1522
1523   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1524        ( ! $conf->exists('require_cardname')
1525          || $self->payby !~ /^(CARD|DCRD)$/  )
1526   ) {
1527     $self->payname( $self->first. " ". $self->getfield('last') );
1528   } else {
1529     $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1530       or return gettext('illegal_name'). " payname: ". $self->payname;
1531     $self->payname($1);
1532   }
1533
1534   foreach my $flag (qw( tax spool_cdr )) {
1535     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1536     $self->$flag($1);
1537   }
1538
1539   $self->otaker(getotaker) unless $self->otaker;
1540
1541   warn "$me check AFTER: \n". $self->_dump
1542     if $DEBUG > 2;
1543
1544   $self->SUPER::check;
1545 }
1546
1547 =item addr_fields
1548
1549 Returns a list of fields which have ship_ duplicates.
1550
1551 =cut
1552
1553 sub addr_fields {
1554   qw( last first company
1555       address1 address2 city county state zip country
1556       daytime night fax
1557     );
1558 }
1559
1560 =item has_ship_address
1561
1562 Returns true if this customer record has a separate shipping address.
1563
1564 =cut
1565
1566 sub has_ship_address {
1567   my $self = shift;
1568   scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1569 }
1570
1571 =item all_pkgs
1572
1573 Returns all packages (see L<FS::cust_pkg>) for this customer.
1574
1575 =cut
1576
1577 sub all_pkgs {
1578   my $self = shift;
1579
1580   return $self->num_pkgs unless wantarray;
1581
1582   my @cust_pkg = ();
1583   if ( $self->{'_pkgnum'} ) {
1584     @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
1585   } else {
1586     @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1587   }
1588
1589   sort sort_packages @cust_pkg;
1590 }
1591
1592 =item cust_pkg
1593
1594 Synonym for B<all_pkgs>.
1595
1596 =cut
1597
1598 sub cust_pkg {
1599   shift->all_pkgs(@_);
1600 }
1601
1602 =item ncancelled_pkgs
1603
1604 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1605
1606 =cut
1607
1608 sub ncancelled_pkgs {
1609   my $self = shift;
1610
1611   return $self->num_ncancelled_pkgs unless wantarray;
1612
1613   my @cust_pkg = ();
1614   if ( $self->{'_pkgnum'} ) {
1615
1616     warn "$me ncancelled_pkgs: returning cached objects"
1617       if $DEBUG > 1;
1618
1619     @cust_pkg = grep { ! $_->getfield('cancel') }
1620                 values %{ $self->{'_pkgnum'}->cache };
1621
1622   } else {
1623
1624     warn "$me ncancelled_pkgs: searching for packages with custnum ".
1625          $self->custnum. "\n"
1626       if $DEBUG > 1;
1627
1628     @cust_pkg =
1629       qsearch( 'cust_pkg', {
1630                              'custnum' => $self->custnum,
1631                              'cancel'  => '',
1632                            });
1633     push @cust_pkg,
1634       qsearch( 'cust_pkg', {
1635                              'custnum' => $self->custnum,
1636                              'cancel'  => 0,
1637                            });
1638   }
1639
1640   sort sort_packages @cust_pkg;
1641
1642 }
1643
1644 # This should be generalized to use config options to determine order.
1645 sub sort_packages {
1646   if ( $a->get('cancel') and $b->get('cancel') ) {
1647     $a->pkgnum <=> $b->pkgnum;
1648   } elsif ( $a->get('cancel') or $b->get('cancel') ) {
1649     return -1 if $b->get('cancel');
1650     return  1 if $a->get('cancel');
1651     return 0;
1652   } else {
1653     $a->pkgnum <=> $b->pkgnum;
1654   }
1655 }
1656
1657 =item suspended_pkgs
1658
1659 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1660
1661 =cut
1662
1663 sub suspended_pkgs {
1664   my $self = shift;
1665   grep { $_->susp } $self->ncancelled_pkgs;
1666 }
1667
1668 =item unflagged_suspended_pkgs
1669
1670 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1671 customer (thouse packages without the `manual_flag' set).
1672
1673 =cut
1674
1675 sub unflagged_suspended_pkgs {
1676   my $self = shift;
1677   return $self->suspended_pkgs
1678     unless dbdef->table('cust_pkg')->column('manual_flag');
1679   grep { ! $_->manual_flag } $self->suspended_pkgs;
1680 }
1681
1682 =item unsuspended_pkgs
1683
1684 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1685 this customer.
1686
1687 =cut
1688
1689 sub unsuspended_pkgs {
1690   my $self = shift;
1691   grep { ! $_->susp } $self->ncancelled_pkgs;
1692 }
1693
1694 =item num_cancelled_pkgs
1695
1696 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1697 customer.
1698
1699 =cut
1700
1701 sub num_cancelled_pkgs {
1702   shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
1703 }
1704
1705 sub num_ncancelled_pkgs {
1706   shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
1707 }
1708
1709 sub num_pkgs {
1710   my( $self ) = shift;
1711   my $sql = scalar(@_) ? shift : '';
1712   $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
1713   my $sth = dbh->prepare(
1714     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
1715   ) or die dbh->errstr;
1716   $sth->execute($self->custnum) or die $sth->errstr;
1717   $sth->fetchrow_arrayref->[0];
1718 }
1719
1720 =item unsuspend
1721
1722 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1723 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
1724 on success or a list of errors.
1725
1726 =cut
1727
1728 sub unsuspend {
1729   my $self = shift;
1730   grep { $_->unsuspend } $self->suspended_pkgs;
1731 }
1732
1733 =item suspend
1734
1735 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1736
1737 Returns a list: an empty list on success or a list of errors.
1738
1739 =cut
1740
1741 sub suspend {
1742   my $self = shift;
1743   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
1744 }
1745
1746 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
1747
1748 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1749 PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref instead
1750 of a list of pkgparts; the hashref has the following keys:
1751
1752 =over 4
1753
1754 =item pkgparts - listref of pkgparts
1755
1756 =item (other options are passed to the suspend method)
1757
1758 =back
1759
1760
1761 Returns a list: an empty list on success or a list of errors.
1762
1763 =cut
1764
1765 sub suspend_if_pkgpart {
1766   my $self = shift;
1767   my (@pkgparts, %opt);
1768   if (ref($_[0]) eq 'HASH'){
1769     @pkgparts = @{$_[0]{pkgparts}};
1770     %opt      = %{$_[0]};
1771   }else{
1772     @pkgparts = @_;
1773   }
1774   grep { $_->suspend(%opt) }
1775     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1776       $self->unsuspended_pkgs;
1777 }
1778
1779 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
1780
1781 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1782 given PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref
1783 instead of a list of pkgparts; the hashref has the following keys:
1784
1785 =over 4
1786
1787 =item pkgparts - listref of pkgparts
1788
1789 =item (other options are passed to the suspend method)
1790
1791 =back
1792
1793 Returns a list: an empty list on success or a list of errors.
1794
1795 =cut
1796
1797 sub suspend_unless_pkgpart {
1798   my $self = shift;
1799   my (@pkgparts, %opt);
1800   if (ref($_[0]) eq 'HASH'){
1801     @pkgparts = @{$_[0]{pkgparts}};
1802     %opt      = %{$_[0]};
1803   }else{
1804     @pkgparts = @_;
1805   }
1806   grep { $_->suspend(%opt) }
1807     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1808       $self->unsuspended_pkgs;
1809 }
1810
1811 =item cancel [ OPTION => VALUE ... ]
1812
1813 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1814
1815 Available options are:
1816
1817 =over 4
1818
1819 =item quiet - can be set true to supress email cancellation notices.
1820
1821 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason.  The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
1822
1823 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
1824
1825 =back
1826
1827 Always returns a list: an empty list on success or a list of errors.
1828
1829 =cut
1830
1831 sub cancel {
1832   my( $self, %opt ) = @_;
1833
1834   warn "$me cancel called on customer ". $self->custnum. " with options ".
1835        join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
1836     if $DEBUG;
1837
1838   return ( 'access denied' )
1839     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
1840
1841   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1842
1843     #should try decryption (we might have the private key)
1844     # and if not maybe queue a job for the server that does?
1845     return ( "Can't (yet) ban encrypted credit cards" )
1846       if $self->is_encrypted($self->payinfo);
1847
1848     my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1849     my $error = $ban->insert;
1850     return ( $error ) if $error;
1851
1852   }
1853
1854   my @pkgs = $self->ncancelled_pkgs;
1855
1856   warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
1857        scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
1858     if $DEBUG;
1859
1860   grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
1861 }
1862
1863 sub _banned_pay_hashref {
1864   my $self = shift;
1865
1866   my %payby2ban = (
1867     'CARD' => 'CARD',
1868     'DCRD' => 'CARD',
1869     'CHEK' => 'CHEK',
1870     'DCHK' => 'CHEK'
1871   );
1872
1873   {
1874     'payby'   => $payby2ban{$self->payby},
1875     'payinfo' => md5_base64($self->payinfo),
1876     #don't ever *search* on reason! #'reason'  =>
1877   };
1878 }
1879
1880 =item notes
1881
1882 Returns all notes (see L<FS::cust_main_note>) for this customer.
1883
1884 =cut
1885
1886 sub notes {
1887   my $self = shift;
1888   #order by?
1889   qsearch( 'cust_main_note',
1890            { 'custnum' => $self->custnum },
1891            '',
1892            'ORDER BY _DATE DESC'
1893          );
1894 }
1895
1896 =item agent
1897
1898 Returns the agent (see L<FS::agent>) for this customer.
1899
1900 =cut
1901
1902 sub agent {
1903   my $self = shift;
1904   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1905 }
1906
1907 =item bill_and_collect
1908
1909 Cancels and suspends any packages due, generates bills, applies payments and
1910 cred
1911
1912 Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.)
1913
1914 Options are passed as name-value pairs.  Currently available options are:
1915
1916 =over 4
1917
1918 =item time
1919
1920 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:
1921
1922  use Date::Parse;
1923  ...
1924  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1925
1926 =item invoice_time
1927
1928 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.
1929
1930 =item check_freq
1931
1932 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1933
1934 =item resetup
1935
1936 If set true, re-charges setup fees.
1937
1938 =item debug
1939
1940 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
1941
1942 =back
1943
1944 =cut
1945
1946 sub bill_and_collect {
1947   my( $self, %options ) = @_;
1948
1949   ###
1950   # cancel packages
1951   ###
1952
1953   #$options{actual_time} not $options{time} because freeside-daily -d is for
1954   #pre-printing invoices
1955   my @cancel_pkgs = grep { $_->expire && $_->expire <= $options{actual_time} }
1956                          $self->ncancelled_pkgs;
1957
1958   foreach my $cust_pkg ( @cancel_pkgs ) {
1959     my $error = $cust_pkg->cancel;
1960     warn "Error cancelling expired pkg ". $cust_pkg->pkgnum.
1961          " for custnum ". $self->custnum. ": $error"
1962       if $error;
1963   }
1964
1965   ###
1966   # suspend packages
1967   ###
1968
1969   #$options{actual_time} not $options{time} because freeside-daily -d is for
1970   #pre-printing invoices
1971   my @susp_pkgs =
1972     grep { ! $_->susp
1973            && (    (    $_->part_pkg->is_prepaid
1974                      && $_->bill
1975                      && $_->bill < $options{actual_time}
1976                    )
1977                 || (    $_->adjourn
1978                     && $_->adjourn <= $options{actual_time}
1979                   )
1980               )
1981          }
1982          $self->ncancelled_pkgs;
1983
1984   foreach my $cust_pkg ( @susp_pkgs ) {
1985     my $error = $cust_pkg->suspend;
1986     warn "Error suspending package ". $cust_pkg->pkgnum.
1987          " for custnum ". $self->custnum. ": $error"
1988       if $error;
1989   }
1990
1991   ###
1992   # bill and collect
1993   ###
1994
1995   my $error = $self->bill( %options );
1996   warn "Error billing, custnum ". $self->custnum. ": $error" if $error;
1997
1998   $self->apply_payments_and_credits;
1999
2000   $error = $self->collect( %options );
2001   warn "Error collecting, custnum". $self->custnum. ": $error" if $error;
2002
2003 }
2004
2005 =item bill OPTIONS
2006
2007 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
2008 conjunction with the collect method by calling B<bill_and_collect>.
2009
2010 If there is an error, returns the error, otherwise returns false.
2011
2012 Options are passed as name-value pairs.  Currently available options are:
2013
2014 =over 4
2015
2016 =item resetup
2017
2018 If set true, re-charges setup fees.
2019
2020 =item time
2021
2022 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:
2023
2024  use Date::Parse;
2025  ...
2026  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2027
2028 =item pkg_list
2029
2030 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
2031
2032  $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2033
2034 =item invoice_time
2035
2036 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.
2037
2038 =back
2039
2040 =cut
2041
2042 sub bill {
2043   my( $self, %options ) = @_;
2044   return '' if $self->payby eq 'COMP';
2045   warn "$me bill customer ". $self->custnum. "\n"
2046     if $DEBUG;
2047
2048   my $time = $options{'time'} || time;
2049
2050   #put below somehow?
2051   local $SIG{HUP} = 'IGNORE';
2052   local $SIG{INT} = 'IGNORE';
2053   local $SIG{QUIT} = 'IGNORE';
2054   local $SIG{TERM} = 'IGNORE';
2055   local $SIG{TSTP} = 'IGNORE';
2056   local $SIG{PIPE} = 'IGNORE';
2057
2058   my $oldAutoCommit = $FS::UID::AutoCommit;
2059   local $FS::UID::AutoCommit = 0;
2060   my $dbh = dbh;
2061
2062   $self->select_for_update; #mutex
2063
2064   my @cust_bill_pkg = ();
2065
2066   ###
2067   # find the packages which are due for billing, find out how much they are
2068   # & generate invoice database.
2069   ###
2070
2071   my( $total_setup, $total_recur ) = ( 0, 0 );
2072   my %tax;
2073   my %taxlisthash;
2074   my %taxname;
2075   my @precommit_hooks = ();
2076
2077   foreach my $cust_pkg (
2078     qsearch('cust_pkg', { 'custnum' => $self->custnum } )
2079   ) {
2080
2081     #NO!! next if $cust_pkg->cancel;
2082     next if $cust_pkg->getfield('cancel');
2083
2084     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2085
2086     #? to avoid use of uninitialized value errors... ?
2087     $cust_pkg->setfield('bill', '')
2088       unless defined($cust_pkg->bill);
2089
2090     #my $part_pkg = $cust_pkg->part_pkg;
2091
2092     my $real_pkgpart = $cust_pkg->pkgpart;
2093     my %hash = $cust_pkg->hash;
2094     my $old_cust_pkg = new FS::cust_pkg \%hash;
2095
2096     foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
2097
2098       $cust_pkg->pkgpart($part_pkg->pkgpart);
2099       $cust_pkg->set($_, $hash{$_}) foreach qw( setup last_bill bill );
2100
2101       my @details = ();
2102
2103       my $lineitems = 0;
2104
2105       ###
2106       # bill setup
2107       ###
2108
2109       my $setup = 0;
2110       if ( ! $cust_pkg->setup &&
2111            (
2112              ( $conf->exists('disable_setup_suspended_pkgs') &&
2113               ! $cust_pkg->getfield('susp')
2114             ) || ! $conf->exists('disable_setup_suspended_pkgs')
2115            )
2116         || $options{'resetup'}
2117       ) {
2118
2119         warn "    bill setup\n" if $DEBUG > 1;
2120         $lineitems++;
2121
2122         $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
2123         if ( $@ ) {
2124           $dbh->rollback if $oldAutoCommit;
2125           return "$@ running calc_setup for $cust_pkg\n";
2126         }
2127
2128         $cust_pkg->setfield('setup', $time)
2129           unless $cust_pkg->setup;
2130               #do need it, but it won't get written to the db
2131               #|| $cust_pkg->pkgpart != $real_pkgpart;
2132
2133       }
2134
2135       ###
2136       # bill recurring fee
2137       ###
2138
2139       my $recur = 0;
2140       my $sdate;
2141       if ( $part_pkg->getfield('freq') ne '0' &&
2142            ! $cust_pkg->getfield('susp') &&
2143            ( $cust_pkg->getfield('bill') || 0 ) <= $time
2144       ) {
2145
2146         # XXX should this be a package event?  probably.  events are called
2147         # at collection time at the moment, though...
2148         $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
2149           if $part_pkg->can('reset_usage');
2150           #don't want to reset usage just cause we want a line item??
2151           #&& $part_pkg->pkgpart == $real_pkgpart;
2152
2153         warn "    bill recur\n" if $DEBUG > 1;
2154         $lineitems++;
2155
2156         # XXX shared with $recur_prog
2157         $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2158
2159         #over two params!  lets at least switch to a hashref for the rest...
2160         my %param = ( 'precommit_hooks' => \@precommit_hooks, );
2161
2162         $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
2163         if ( $@ ) {
2164           $dbh->rollback if $oldAutoCommit;
2165           return "$@ running calc_recur for $cust_pkg\n";
2166         }
2167
2168
2169         #change this bit to use Date::Manip? CAREFUL with timezones (see
2170         # mailing list archive)
2171         my ($sec,$min,$hour,$mday,$mon,$year) =
2172           (localtime($sdate) )[0,1,2,3,4,5];
2173
2174         #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
2175         # only for figuring next bill date, nothing else, so, reset $sdate again
2176         # here
2177         $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2178         $cust_pkg->last_bill($sdate);
2179
2180         if ( $part_pkg->freq =~ /^\d+$/ ) {
2181           $mon += $part_pkg->freq;
2182           until ( $mon < 12 ) { $mon -= 12; $year++; }
2183         } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
2184           my $weeks = $1;
2185           $mday += $weeks * 7;
2186         } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
2187           my $days = $1;
2188           $mday += $days;
2189         } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
2190           my $hours = $1;
2191           $hour += $hours;
2192         } else {
2193           $dbh->rollback if $oldAutoCommit;
2194           return "unparsable frequency: ". $part_pkg->freq;
2195         }
2196         $cust_pkg->setfield('bill',
2197           timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
2198
2199       }
2200
2201       warn "\$setup is undefined" unless defined($setup);
2202       warn "\$recur is undefined" unless defined($recur);
2203       warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
2204
2205       ###
2206       # If there's line items, create em cust_bill_pkg records
2207       # If $cust_pkg has been modified, update it (if we're a real pkgpart)
2208       ###
2209
2210       if ( $lineitems ) {
2211
2212         if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
2213           # hmm.. and if just the options are modified in some weird price plan?
2214
2215           warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
2216             if $DEBUG >1;
2217
2218           my $error = $cust_pkg->replace( $old_cust_pkg,
2219                                           'options' => { $cust_pkg->options },
2220                                         );
2221           if ( $error ) { #just in case
2222             $dbh->rollback if $oldAutoCommit;
2223             return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
2224           }
2225         }
2226
2227         $setup = sprintf( "%.2f", $setup );
2228         $recur = sprintf( "%.2f", $recur );
2229         if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
2230           $dbh->rollback if $oldAutoCommit;
2231           return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
2232         }
2233         if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
2234           $dbh->rollback if $oldAutoCommit;
2235           return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
2236         }
2237
2238         if ( $setup != 0 || $recur != 0 ) {
2239
2240           warn "    charges (setup=$setup, recur=$recur); adding line items\n"
2241             if $DEBUG > 1;
2242           my $cust_bill_pkg = new FS::cust_bill_pkg {
2243             'pkgnum'  => $cust_pkg->pkgnum,
2244             'setup'   => $setup,
2245             'recur'   => $recur,
2246             'sdate'   => $sdate,
2247             'edate'   => $cust_pkg->bill,
2248             'details' => \@details,
2249           };
2250           $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
2251             unless $part_pkg->pkgpart == $real_pkgpart;
2252           push @cust_bill_pkg, $cust_bill_pkg;
2253
2254           $total_setup += $setup;
2255           $total_recur += $recur;
2256
2257           ###
2258           # handle taxes
2259           ###
2260
2261           unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
2262
2263             my @taxes = ();
2264             my @taxoverrides = $part_pkg->part_pkg_taxoverride;
2265
2266             my $prefix =
2267               ( $conf->exists('tax-ship_address') && length($self->ship_last) )
2268               ? 'ship_'
2269               : '';
2270
2271             if ( $conf->exists('enable_taxproducts')
2272                  && (scalar(@taxoverrides) || $part_pkg->taxproductnum )
2273                )
2274             {
2275
2276               my @taxclassnums = ();
2277               my $geocode = $self->geocode('cch');
2278
2279               if ( scalar( @taxoverrides ) ) {
2280                 @taxclassnums = map { $_->taxclassnum } @taxoverrides;
2281               }elsif ( $part_pkg->taxproductnum ) {
2282                 @taxclassnums = map { $_->taxclassnum }
2283                                 $part_pkg->part_pkg_taxrate('cch', $geocode);
2284               }
2285
2286               my $extra_sql =
2287                 "AND (".
2288                 join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
2289
2290               @taxes = qsearch({ 'table' => 'tax_rate',
2291                                  'hashref' => { 'geocode' => $geocode, },
2292                                  'extra_sql' => $extra_sql,
2293                               })
2294                 if scalar(@taxclassnums);
2295
2296
2297             }else{
2298
2299               my %taxhash = map { $_ => $self->get("$prefix$_") }
2300                                 qw( state county country );
2301
2302               $taxhash{'taxclass'} = $part_pkg->taxclass;
2303
2304               @taxes = qsearch( 'cust_main_county', \%taxhash );
2305
2306             unless ( @taxes ) {
2307               $taxhash{'taxclass'} = '';
2308               @taxes =  qsearch( 'cust_main_county', \%taxhash );
2309             }
2310
2311             #one more try at a whole-country tax rate
2312             unless ( @taxes ) {
2313               $taxhash{$_} = '' foreach qw( state county );
2314               @taxes =  qsearch( 'cust_main_county', \%taxhash );
2315             }
2316
2317             } #if $conf->exists('enable_taxproducts')
2318
2319             # maybe eliminate this entirely, along with all the 0% records
2320             unless ( @taxes ) {
2321               $dbh->rollback if $oldAutoCommit;
2322               my $error;
2323               if ( $conf->exists('enable_taxproducts') ) {
2324                 $error =
2325                   "fatal: can't find tax rate for zip/taxproduct/pkgpart ".
2326                   join('/', ( map $self->get("$prefix$_"),
2327                                   qw(zip)
2328                             ),
2329                             $part_pkg->taxproduct_description,
2330                             $part_pkg->pkgpart ). "\n";
2331               } else {
2332                 $error =
2333                   "fatal: can't find tax rate for state/county/country/taxclass ".
2334                   join('/', ( map $self->get("$prefix$_"),
2335                                   qw(state county country)
2336                             ),
2337                             $part_pkg->taxclass ). "\n";
2338               }
2339               return $error;
2340             }
2341
2342             foreach my $tax ( @taxes ) {
2343               my $taxname = ref( $tax ). ' '. $tax->taxnum;
2344               if ( exists( $taxlisthash{ $taxname } ) ) {
2345                 push @{ $taxlisthash{ $taxname  } }, $cust_bill_pkg;
2346               }else{
2347                 $taxlisthash{ $taxname } = [ $tax, $cust_bill_pkg ];
2348               }
2349             }
2350
2351
2352           } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
2353
2354         } #if $setup != 0 || $recur != 0
2355
2356       } #if $cust_pkg->modified
2357
2358     } #foreach my $part_pkg
2359
2360   } #foreach my $cust_pkg
2361
2362   unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items
2363     #but do commit any package date cycling that happened
2364     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2365     return '';
2366   }
2367
2368   warn "having a look at the taxes we found...\n" if $DEBUG > 2;
2369   foreach my $tax ( keys %taxlisthash ) {
2370     my $tax_object = shift @{ $taxlisthash{$tax} };
2371     warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
2372     my $listref_or_error = $tax_object->taxline( @{ $taxlisthash{$tax} } );
2373     unless (ref($listref_or_error)) {
2374       $dbh->rollback if $oldAutoCommit;
2375       return $listref_or_error;
2376     }
2377     unshift @{ $taxlisthash{$tax} }, $tax_object;
2378
2379     warn "adding ". $listref_or_error->[1].
2380          " as ". $listref_or_error->[0]. "\n"
2381       if $DEBUG > 2;
2382     $tax{ $tax_object->taxname } += $listref_or_error->[1];
2383     if ( $taxname{ $listref_or_error->[0] } ) {
2384       push @{ $taxname{ $listref_or_error->[0] } }, $tax_object->taxname;
2385     }else{
2386       $taxname{ $listref_or_error->[0] } = [ $tax_object->taxname ];
2387     }
2388
2389   }
2390
2391   #some taxes are taxed
2392   my %totlisthash;
2393
2394   warn "finding taxed taxes...\n" if $DEBUG > 2;
2395   foreach my $tax ( keys %taxlisthash ) {
2396     my $tax_object = shift @{ $taxlisthash{$tax} };
2397     warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
2398       if $DEBUG > 2;
2399     next unless $tax_object->can('tax_on_tax');
2400
2401     foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
2402       my $totname = ref( $tot ). ' '. $tot->taxnum;
2403
2404       warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
2405         if $DEBUG > 2;
2406       next unless exists( $taxlisthash{ $totname } ); # only increase
2407                                                       # existing taxes
2408       warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
2409       if ( exists( $totlisthash{ $totname } ) ) {
2410         push @{ $totlisthash{ $totname  } }, $tax{ $tax_object->taxname };
2411       }else{
2412         $totlisthash{ $totname } = [ $tot, $tax{ $tax_object->taxname } ];
2413       }
2414     }
2415   }
2416
2417   warn "having a look at taxed taxes...\n" if $DEBUG > 2;
2418   foreach my $tax ( keys %totlisthash ) {
2419     my $tax_object = shift @{ $totlisthash{$tax} };
2420     warn "found previously found taxed tax ". $tax_object->taxname. "\n"
2421       if $DEBUG > 2;
2422     my $listref_or_error = $tax_object->taxline( @{ $totlisthash{$tax} } );
2423     unless (ref($listref_or_error)) {
2424       $dbh->rollback if $oldAutoCommit;
2425       return $listref_or_error;
2426     }
2427
2428     warn "adding taxed tax amount ". $listref_or_error->[1].
2429          " as ". $tax_object->taxname. "\n"
2430       if $DEBUG;
2431     $tax{ $tax_object->taxname } += $listref_or_error->[1];
2432   }
2433
2434   #consolidate and create tax line items
2435   warn "consolidating and generating...\n" if $DEBUG > 2;
2436   foreach my $taxname ( keys %taxname ) {
2437     my $tax = 0;
2438     my %seen = ();
2439     warn "adding $taxname\n" if $DEBUG > 1;
2440     foreach my $taxitem ( @{ $taxname{$taxname} } ) {
2441       $tax += $tax{$taxitem} unless $seen{$taxitem};
2442       warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
2443     }
2444     next unless $tax;
2445
2446     $tax = sprintf('%.2f', $tax );
2447     $total_setup = sprintf('%.2f', $total_setup+$tax );
2448
2449     push @cust_bill_pkg, new FS::cust_bill_pkg {
2450       'pkgnum'   => 0,
2451       'setup'    => $tax,
2452       'recur'    => 0,
2453       'sdate'    => '',
2454       'edate'    => '',
2455       'itemdesc' => $taxname,
2456     };
2457
2458   }
2459
2460   my $charged = sprintf('%.2f', $total_setup + $total_recur );
2461
2462   #create the new invoice
2463   my $cust_bill = new FS::cust_bill ( {
2464     'custnum' => $self->custnum,
2465     '_date'   => ( $options{'invoice_time'} || $time ),
2466     'charged' => $charged,
2467   } );
2468   my $error = $cust_bill->insert;
2469   if ( $error ) {
2470     $dbh->rollback if $oldAutoCommit;
2471     return "can't create invoice for customer #". $self->custnum. ": $error";
2472   }
2473
2474   foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
2475     $cust_bill_pkg->invnum($cust_bill->invnum);
2476     my $error = $cust_bill_pkg->insert;
2477     if ( $error ) {
2478       $dbh->rollback if $oldAutoCommit;
2479       return "can't create invoice line item: $error";
2480     }
2481   }
2482
2483
2484   foreach my $hook ( @precommit_hooks ) {
2485     eval {
2486       &{$hook}; #($self) ?
2487     };
2488     if ( $@ ) {
2489       $dbh->rollback if $oldAutoCommit;
2490       return "$@ running precommit hook $hook\n";
2491     }
2492   }
2493
2494   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2495   ''; #no error
2496 }
2497
2498 =item collect OPTIONS
2499
2500 (Attempt to) collect money for this customer's outstanding invoices (see
2501 L<FS::cust_bill>).  Usually used after the bill method.
2502
2503 Actions are now triggered by billing events; see L<FS::part_event> and the
2504 billing events web interface.  Old-style invoice events (see
2505 L<FS::part_bill_event>) have been deprecated.
2506
2507 If there is an error, returns the error, otherwise returns false.
2508
2509 Options are passed as name-value pairs.
2510
2511 Currently available options are:
2512
2513 =over 4
2514
2515 =item invoice_time
2516
2517 Use this time when deciding when to print invoices and 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> for conversion functions.
2518
2519 =item retry
2520
2521 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
2522
2523 =item quiet
2524
2525 set true to surpress email card/ACH decline notices.
2526
2527 =item check_freq
2528
2529 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2530
2531 =item payby
2532
2533 allows for one time override of normal customer billing method
2534
2535 =item debug
2536
2537 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
2538
2539
2540 =back
2541
2542 =cut
2543
2544 sub collect {
2545   my( $self, %options ) = @_;
2546   my $invoice_time = $options{'invoice_time'} || time;
2547
2548   #put below somehow?
2549   local $SIG{HUP} = 'IGNORE';
2550   local $SIG{INT} = 'IGNORE';
2551   local $SIG{QUIT} = 'IGNORE';
2552   local $SIG{TERM} = 'IGNORE';
2553   local $SIG{TSTP} = 'IGNORE';
2554   local $SIG{PIPE} = 'IGNORE';
2555
2556   my $oldAutoCommit = $FS::UID::AutoCommit;
2557   local $FS::UID::AutoCommit = 0;
2558   my $dbh = dbh;
2559
2560   $self->select_for_update; #mutex
2561
2562   if ( $DEBUG ) {
2563     my $balance = $self->balance;
2564     warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2565   }
2566
2567   if ( exists($options{'retry_card'}) ) {
2568     carp 'retry_card option passed to collect is deprecated; use retry';
2569     $options{'retry'} ||= $options{'retry_card'};
2570   }
2571   if ( exists($options{'retry'}) && $options{'retry'} ) {
2572     my $error = $self->retry_realtime;
2573     if ( $error ) {
2574       $dbh->rollback if $oldAutoCommit;
2575       return $error;
2576     }
2577   }
2578
2579   # false laziness w/pay_batch::import_results
2580
2581   my $due_cust_event = $self->due_cust_event(
2582     'debug'      => ( $options{'debug'} || 0 ),
2583     'time'       => $invoice_time,
2584     'check_freq' => $options{'check_freq'},
2585   );
2586   unless( ref($due_cust_event) ) {
2587     $dbh->rollback if $oldAutoCommit;
2588     return $due_cust_event;
2589   }
2590
2591   foreach my $cust_event ( @$due_cust_event ) {
2592
2593     #XXX lock event
2594
2595     #re-eval event conditions (a previous event could have changed things)
2596     unless ( $cust_event->test_conditions( 'time' => $invoice_time ) ) {
2597       #don't leave stray "new/locked" records around
2598       my $error = $cust_event->delete;
2599       if ( $error ) {
2600         #gah, even with transactions
2601         $dbh->commit if $oldAutoCommit; #well.
2602         return $error;
2603       }
2604       next;
2605     }
2606
2607     {
2608       local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2609       warn "  running cust_event ". $cust_event->eventnum. "\n"
2610         if $DEBUG > 1;
2611
2612
2613       #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
2614       if ( my $error = $cust_event->do_event() ) {
2615         #XXX wtf is this?  figure out a proper dealio with return value
2616         #from do_event
2617           # gah, even with transactions.
2618           $dbh->commit if $oldAutoCommit; #well.
2619           return $error;
2620         }
2621     }
2622
2623   }
2624
2625   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2626   '';
2627
2628 }
2629
2630 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
2631
2632 Inserts database records for and returns an ordered listref of new events due
2633 for this customer, as FS::cust_event objects (see L<FS::cust_event>).  If no
2634 events are due, an empty listref is returned.  If there is an error, returns a
2635 scalar error message.
2636
2637 To actually run the events, call each event's test_condition method, and if
2638 still true, call the event's do_event method.
2639
2640 Options are passed as a hashref or as a list of name-value pairs.  Available
2641 options are:
2642
2643 =over 4
2644
2645 =item check_freq
2646
2647 Search only for events of this check frequency (how often events of this type are checked); currently "1d" (daily, the default) and "1m" (monthly) are recognized.
2648
2649 =item time
2650
2651 "Current time" for the events.
2652
2653 =item debug
2654
2655 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
2656
2657 =item eventtable
2658
2659 Only return events for the specified eventtable (by default, events of all eventtables are returned)
2660
2661 =item objects
2662
2663 Explicitly pass the objects to be tested (typically used with eventtable).
2664
2665 =back
2666
2667 =cut
2668
2669 sub due_cust_event {
2670   my $self = shift;
2671   my %opt = ref($_[0]) ? %{ $_[0] } : @_;
2672
2673   #???
2674   #my $DEBUG = $opt{'debug'}
2675   local($DEBUG) = $opt{'debug'}
2676     if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
2677
2678   warn "$me due_cust_event called with options ".
2679        join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
2680     if $DEBUG;
2681
2682   $opt{'time'} ||= time;
2683
2684   local $SIG{HUP} = 'IGNORE';
2685   local $SIG{INT} = 'IGNORE';
2686   local $SIG{QUIT} = 'IGNORE';
2687   local $SIG{TERM} = 'IGNORE';
2688   local $SIG{TSTP} = 'IGNORE';
2689   local $SIG{PIPE} = 'IGNORE';
2690
2691   my $oldAutoCommit = $FS::UID::AutoCommit;
2692   local $FS::UID::AutoCommit = 0;
2693   my $dbh = dbh;
2694
2695   $self->select_for_update; #mutex
2696
2697   ###
2698   # 1: find possible events (initial search)
2699   ###
2700
2701   my @cust_event = ();
2702
2703   my @eventtable = $opt{'eventtable'}
2704                      ? ( $opt{'eventtable'} )
2705                      : FS::part_event->eventtables_runorder;
2706
2707   foreach my $eventtable ( @eventtable ) {
2708
2709     my @objects;
2710     if ( $opt{'objects'} ) {
2711
2712       @objects = @{ $opt{'objects'} };
2713
2714     } else {
2715
2716       #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
2717       @objects = ( $eventtable eq 'cust_main' )
2718                    ? ( $self )
2719                    : ( $self->$eventtable() );
2720
2721     }
2722
2723     my @e_cust_event = ();
2724
2725     my $cross = "CROSS JOIN $eventtable";
2726     $cross .= ' LEFT JOIN cust_main USING ( custnum )'
2727       unless $eventtable eq 'cust_main';
2728
2729     foreach my $object ( @objects ) {
2730
2731       #this first search uses the condition_sql magic for optimization.
2732       #the more possible events we can eliminate in this step the better
2733
2734       my $cross_where = '';
2735       my $pkey = $object->primary_key;
2736       $cross_where = "$eventtable.$pkey = ". $object->$pkey();
2737
2738       my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
2739       my $extra_sql =
2740         FS::part_event_condition->where_conditions_sql( $eventtable,
2741                                                         'time'=>$opt{'time'}
2742                                                       );
2743       my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
2744
2745       $extra_sql = "AND $extra_sql" if $extra_sql;
2746
2747       #here is the agent virtualization
2748       $extra_sql .= " AND (    part_event.agentnum IS NULL
2749                             OR part_event.agentnum = ". $self->agentnum. ' )';
2750
2751       $extra_sql .= " $order";
2752
2753       warn "searching for events for $eventtable ". $object->$pkey. "\n"
2754         if $opt{'debug'} > 2;
2755       my @part_event = qsearch( {
2756         'debug'     => ( $opt{'debug'} > 3 ? 1 : 0 ),
2757         'select'    => 'part_event.*',
2758         'table'     => 'part_event',
2759         'addl_from' => "$cross $join",
2760         'hashref'   => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
2761                          'eventtable' => $eventtable,
2762                          'disabled'   => '',
2763                        },
2764         'extra_sql' => "AND $cross_where $extra_sql",
2765       } );
2766
2767       if ( $DEBUG > 2 ) {
2768         my $pkey = $object->primary_key;
2769         warn "      ". scalar(@part_event).
2770              " possible events found for $eventtable ". $object->$pkey(). "\n";
2771       }
2772
2773       push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
2774
2775     }
2776
2777     warn "    ". scalar(@e_cust_event).
2778          " subtotal possible cust events found for $eventtable\n"
2779       if $DEBUG > 1;
2780
2781     push @cust_event, @e_cust_event;
2782
2783   }
2784
2785   warn "  ". scalar(@cust_event).
2786        " total possible cust events found in initial search\n"
2787     if $DEBUG; # > 1;
2788
2789   ##
2790   # 2: test conditions
2791   ##
2792
2793   my %unsat = ();
2794
2795   @cust_event = grep $_->test_conditions( 'time'          => $opt{'time'},
2796                                           'stats_hashref' => \%unsat ),
2797                      @cust_event;
2798
2799   warn "  ". scalar(@cust_event). " cust events left satisfying conditions\n"
2800     if $DEBUG; # > 1;
2801
2802   warn "    invalid conditions not eliminated with condition_sql:\n".
2803        join('', map "      $_: ".$unsat{$_}."\n", keys %unsat )
2804     if $DEBUG; # > 1;
2805
2806   ##
2807   # 3: insert
2808   ##
2809
2810   foreach my $cust_event ( @cust_event ) {
2811
2812     my $error = $cust_event->insert();
2813     if ( $error ) {
2814       $dbh->rollback if $oldAutoCommit;
2815       return $error;
2816     }
2817
2818   }
2819
2820   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2821
2822   ##
2823   # 4: return
2824   ##
2825
2826   warn "  returning events: ". Dumper(@cust_event). "\n"
2827     if $DEBUG > 2;
2828
2829   \@cust_event;
2830
2831 }
2832
2833 =item retry_realtime
2834
2835 Schedules realtime / batch  credit card / electronic check / LEC billing
2836 events for for retry.  Useful if card information has changed or manual
2837 retry is desired.  The 'collect' method must be called to actually retry
2838 the transaction.
2839
2840 Implementation details: For either this customer, or for each of this
2841 customer's open invoices, changes the status of the first "done" (with
2842 statustext error) realtime processing event to "failed".
2843
2844 =cut
2845
2846 sub retry_realtime {
2847   my $self = shift;
2848
2849   local $SIG{HUP} = 'IGNORE';
2850   local $SIG{INT} = 'IGNORE';
2851   local $SIG{QUIT} = 'IGNORE';
2852   local $SIG{TERM} = 'IGNORE';
2853   local $SIG{TSTP} = 'IGNORE';
2854   local $SIG{PIPE} = 'IGNORE';
2855
2856   my $oldAutoCommit = $FS::UID::AutoCommit;
2857   local $FS::UID::AutoCommit = 0;
2858   my $dbh = dbh;
2859
2860   #a little false laziness w/due_cust_event (not too bad, really)
2861
2862   my $join = FS::part_event_condition->join_conditions_sql;
2863   my $order = FS::part_event_condition->order_conditions_sql;
2864   my $mine =
2865   '( '
2866    . join ( ' OR ' , map {
2867     "( part_event.eventtable = " . dbh->quote($_)
2868     . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
2869    } FS::part_event->eventtables)
2870    . ') ';
2871
2872   #here is the agent virtualization
2873   my $agent_virt = " (    part_event.agentnum IS NULL
2874                        OR part_event.agentnum = ". $self->agentnum. ' )';
2875
2876   #XXX this shouldn't be hardcoded, actions should declare it...
2877   my @realtime_events = qw(
2878     cust_bill_realtime_card
2879     cust_bill_realtime_check
2880     cust_bill_realtime_lec
2881     cust_bill_batch
2882   );
2883
2884   my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
2885                                                   @realtime_events
2886                                      ).
2887                           ' ) ';
2888
2889   my @cust_event = qsearchs({
2890     'table'     => 'cust_event',
2891     'select'    => 'cust_event.*',
2892     'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
2893     'hashref'   => { 'status' => 'done' },
2894     'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
2895                    " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
2896   });
2897
2898   my %seen_invnum = ();
2899   foreach my $cust_event (@cust_event) {
2900
2901     #max one for the customer, one for each open invoice
2902     my $cust_X = $cust_event->cust_X;
2903     next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
2904                           ? $cust_X->invnum
2905                           : 0
2906                         }++
2907          or $cust_event->part_event->eventtable eq 'cust_bill'
2908             && ! $cust_X->owed;
2909
2910     my $error = $cust_event->retry;
2911     if ( $error ) {
2912       $dbh->rollback if $oldAutoCommit;
2913       return "error scheduling event for retry: $error";
2914     }
2915
2916   }
2917
2918   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2919   '';
2920
2921 }
2922
2923 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
2924
2925 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
2926 via a Business::OnlinePayment realtime gateway.  See
2927 L<http://420.am/business-onlinepayment> for supported gateways.
2928
2929 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2930
2931 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
2932
2933 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2934 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2935 if set, will override the value from the customer record.
2936
2937 I<description> is a free-text field passed to the gateway.  It defaults to
2938 "Internet services".
2939
2940 If an I<invnum> is specified, this payment (if successful) is applied to the
2941 specified invoice.  If you don't specify an I<invnum> you might want to
2942 call the B<apply_payments> method.
2943
2944 I<quiet> can be set true to surpress email decline notices.
2945
2946 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
2947 resulting paynum, if any.
2948
2949 I<payunique> is a unique identifier for this payment.
2950
2951 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
2952
2953 =cut
2954
2955 sub realtime_bop {
2956   my( $self, $method, $amount, %options ) = @_;
2957   if ( $DEBUG ) {
2958     warn "$me realtime_bop: $method $amount\n";
2959     warn "  $_ => $options{$_}\n" foreach keys %options;
2960   }
2961
2962   $options{'description'} ||= 'Internet services';
2963
2964   return $self->fake_bop($method, $amount, %options) if $options{'fake'};
2965
2966   eval "use Business::OnlinePayment";
2967   die $@ if $@;
2968
2969   my $payinfo = exists($options{'payinfo'})
2970                   ? $options{'payinfo'}
2971                   : $self->payinfo;
2972
2973   my %method2payby = (
2974     'CC'     => 'CARD',
2975     'ECHECK' => 'CHEK',
2976     'LEC'    => 'LECB',
2977   );
2978
2979   ###
2980   # check for banned credit card/ACH
2981   ###
2982
2983   my $ban = qsearchs('banned_pay', {
2984     'payby'   => $method2payby{$method},
2985     'payinfo' => md5_base64($payinfo),
2986   } );
2987   return "Banned credit card" if $ban;
2988
2989   ###
2990   # select a gateway
2991   ###
2992
2993   my $taxclass = '';
2994   if ( $options{'invnum'} ) {
2995     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
2996     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
2997     my @taxclasses =
2998       map  { $_->part_pkg->taxclass }
2999       grep { $_ }
3000       map  { $_->cust_pkg }
3001       $cust_bill->cust_bill_pkg;
3002     unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
3003                                                            #different taxclasses
3004       $taxclass = $taxclasses[0];
3005     }
3006   }
3007
3008   #look for an agent gateway override first
3009   my $cardtype;
3010   if ( $method eq 'CC' ) {
3011     $cardtype = cardtype($payinfo);
3012   } elsif ( $method eq 'ECHECK' ) {
3013     $cardtype = 'ACH';
3014   } else {
3015     $cardtype = $method;
3016   }
3017
3018   my $override =
3019        qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3020                                            cardtype => $cardtype,
3021                                            taxclass => $taxclass,       } )
3022     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3023                                            cardtype => '',
3024                                            taxclass => $taxclass,       } )
3025     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3026                                            cardtype => $cardtype,
3027                                            taxclass => '',              } )
3028     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3029                                            cardtype => '',
3030                                            taxclass => '',              } );
3031
3032   my $payment_gateway = '';
3033   my( $processor, $login, $password, $action, @bop_options );
3034   if ( $override ) { #use a payment gateway override
3035
3036     $payment_gateway = $override->payment_gateway;
3037
3038     $processor   = $payment_gateway->gateway_module;
3039     $login       = $payment_gateway->gateway_username;
3040     $password    = $payment_gateway->gateway_password;
3041     $action      = $payment_gateway->gateway_action;
3042     @bop_options = $payment_gateway->options;
3043
3044   } else { #use the standard settings from the config
3045
3046     ( $processor, $login, $password, $action, @bop_options ) =
3047       $self->default_payment_gateway($method);
3048
3049   }
3050
3051   ###
3052   # massage data
3053   ###
3054
3055   my $address = exists($options{'address1'})
3056                     ? $options{'address1'}
3057                     : $self->address1;
3058   my $address2 = exists($options{'address2'})
3059                     ? $options{'address2'}
3060                     : $self->address2;
3061   $address .= ", ". $address2 if length($address2);
3062
3063   my $o_payname = exists($options{'payname'})
3064                     ? $options{'payname'}
3065                     : $self->payname;
3066   my($payname, $payfirst, $paylast);
3067   if ( $o_payname && $method ne 'ECHECK' ) {
3068     ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3069       or return "Illegal payname $payname";
3070     ($payfirst, $paylast) = ($1, $2);
3071   } else {
3072     $payfirst = $self->getfield('first');
3073     $paylast = $self->getfield('last');
3074     $payname =  "$payfirst $paylast";
3075   }
3076
3077   my @invoicing_list = $self->invoicing_list_emailonly;
3078   if ( $conf->exists('emailinvoiceautoalways')
3079        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3080        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3081     push @invoicing_list, $self->all_emails;
3082   }
3083
3084   my $email = ($conf->exists('business-onlinepayment-email-override'))
3085               ? $conf->config('business-onlinepayment-email-override')
3086               : $invoicing_list[0];
3087
3088   my %content = ();
3089
3090   my $payip = exists($options{'payip'})
3091                 ? $options{'payip'}
3092                 : $self->payip;
3093   $content{customer_ip} = $payip
3094     if length($payip);
3095
3096   $content{invoice_number} = $options{'invnum'}
3097     if exists($options{'invnum'}) && length($options{'invnum'});
3098
3099   $content{email_customer} =
3100     (    $conf->exists('business-onlinepayment-email_customer')
3101       || $conf->exists('business-onlinepayment-email-override') );
3102
3103   my $paydate = '';
3104   if ( $method eq 'CC' ) {
3105
3106     $content{card_number} = $payinfo;
3107     $paydate = exists($options{'paydate'})
3108                     ? $options{'paydate'}
3109                     : $self->paydate;
3110     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3111     $content{expiration} = "$2/$1";
3112
3113     my $paycvv = exists($options{'paycvv'})
3114                    ? $options{'paycvv'}
3115                    : $self->paycvv;
3116     $content{cvv2} = $paycvv
3117       if length($paycvv);
3118
3119     my $paystart_month = exists($options{'paystart_month'})
3120                            ? $options{'paystart_month'}
3121                            : $self->paystart_month;
3122
3123     my $paystart_year  = exists($options{'paystart_year'})
3124                            ? $options{'paystart_year'}
3125                            : $self->paystart_year;
3126
3127     $content{card_start} = "$paystart_month/$paystart_year"
3128       if $paystart_month && $paystart_year;
3129
3130     my $payissue       = exists($options{'payissue'})
3131                            ? $options{'payissue'}
3132                            : $self->payissue;
3133     $content{issue_number} = $payissue if $payissue;
3134
3135     $content{recurring_billing} = 'YES'
3136       if qsearch('cust_pay', { 'custnum' => $self->custnum,
3137                                'payby'   => 'CARD',
3138                                'payinfo' => $payinfo,
3139                              } )
3140       || qsearch('cust_pay', { 'custnum' => $self->custnum,
3141                                'payby'   => 'CARD',
3142                                'paymask' => $self->mask_payinfo('CARD', $payinfo),
3143                              } );
3144
3145
3146   } elsif ( $method eq 'ECHECK' ) {
3147     ( $content{account_number}, $content{routing_code} ) =
3148       split('@', $payinfo);
3149     $content{bank_name} = $o_payname;
3150     $content{bank_state} = exists($options{'paystate'})
3151                              ? $options{'paystate'}
3152                              : $self->getfield('paystate');
3153     $content{account_type} = exists($options{'paytype'})
3154                                ? uc($options{'paytype'}) || 'CHECKING'
3155                                : uc($self->getfield('paytype')) || 'CHECKING';
3156     $content{account_name} = $payname;
3157     $content{customer_org} = $self->company ? 'B' : 'I';
3158     $content{state_id}       = exists($options{'stateid'})
3159                                  ? $options{'stateid'}
3160                                  : $self->getfield('stateid');
3161     $content{state_id_state} = exists($options{'stateid_state'})
3162                                  ? $options{'stateid_state'}
3163                                  : $self->getfield('stateid_state');
3164     $content{customer_ssn} = exists($options{'ss'})
3165                                ? $options{'ss'}
3166                                : $self->ss;
3167   } elsif ( $method eq 'LEC' ) {
3168     $content{phone} = $payinfo;
3169   }
3170
3171   ###
3172   # run transaction(s)
3173   ###
3174
3175   my $balance = exists( $options{'balance'} )
3176                   ? $options{'balance'}
3177                   : $self->balance;
3178
3179   $self->select_for_update; #mutex ... just until we get our pending record in
3180
3181   #the checks here are intended to catch concurrent payments
3182   #double-form-submission prevention is taken care of in cust_pay_pending::check
3183
3184   #check the balance
3185   return "The customer's balance has changed; $method transaction aborted."
3186     if $self->balance < $balance;
3187     #&& $self->balance < $amount; #might as well anyway?
3188
3189   #also check and make sure there aren't *other* pending payments for this cust
3190
3191   my @pending = qsearch('cust_pay_pending', {
3192     'custnum' => $self->custnum,
3193     'status'  => { op=>'!=', value=>'done' }
3194   });
3195   return "A payment is already being processed for this customer (".
3196          join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
3197          "); $method transaction aborted."
3198     if scalar(@pending);
3199
3200   #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
3201
3202   my $cust_pay_pending = new FS::cust_pay_pending {
3203     'custnum'    => $self->custnum,
3204     #'invnum'     => $options{'invnum'},
3205     'paid'       => $amount,
3206     '_date'      => '',
3207     'payby'      => $method2payby{$method},
3208     'payinfo'    => $payinfo,
3209     'paydate'    => $paydate,
3210     'status'     => 'new',
3211     'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
3212   };
3213   $cust_pay_pending->payunique( $options{payunique} )
3214     if defined($options{payunique}) && length($options{payunique});
3215   my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
3216   return $cpp_new_err if $cpp_new_err;
3217
3218   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
3219
3220   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
3221   $transaction->content(
3222     'type'           => $method,
3223     'login'          => $login,
3224     'password'       => $password,
3225     'action'         => $action1,
3226     'description'    => $options{'description'},
3227     'amount'         => $amount,
3228     #'invoice_number' => $options{'invnum'},
3229     'customer_id'    => $self->custnum,
3230     'last_name'      => $paylast,
3231     'first_name'     => $payfirst,
3232     'name'           => $payname,
3233     'address'        => $address,
3234     'city'           => ( exists($options{'city'})
3235                             ? $options{'city'}
3236                             : $self->city          ),
3237     'state'          => ( exists($options{'state'})
3238                             ? $options{'state'}
3239                             : $self->state          ),
3240     'zip'            => ( exists($options{'zip'})
3241                             ? $options{'zip'}
3242                             : $self->zip          ),
3243     'country'        => ( exists($options{'country'})
3244                             ? $options{'country'}
3245                             : $self->country          ),
3246     'referer'        => 'http://cleanwhisker.420.am/',
3247     'email'          => $email,
3248     'phone'          => $self->daytime || $self->night,
3249     %content, #after
3250   );
3251
3252   $cust_pay_pending->status('pending');
3253   my $cpp_pending_err = $cust_pay_pending->replace;
3254   return $cpp_pending_err if $cpp_pending_err;
3255
3256   #config?
3257   my $BOP_TESTING = 0;
3258   my $BOP_TESTING_SUCCESS = 1;
3259
3260   unless ( $BOP_TESTING ) {
3261     $transaction->submit();
3262   } else {
3263     if ( $BOP_TESTING_SUCCESS ) {
3264       $transaction->is_success(1);
3265       $transaction->authorization('fake auth');
3266     } else {
3267       $transaction->is_success(0);
3268       $transaction->error_message('fake failure');
3269     }
3270   }
3271
3272   if ( $transaction->is_success() && $action2 ) {
3273
3274     $cust_pay_pending->status('authorized');
3275     my $cpp_authorized_err = $cust_pay_pending->replace;
3276     return $cpp_authorized_err if $cpp_authorized_err;
3277
3278     my $auth = $transaction->authorization;
3279     my $ordernum = $transaction->can('order_number')
3280                    ? $transaction->order_number
3281                    : '';
3282
3283     my $capture =
3284       new Business::OnlinePayment( $processor, @bop_options );
3285
3286     my %capture = (
3287       %content,
3288       type           => $method,
3289       action         => $action2,
3290       login          => $login,
3291       password       => $password,
3292       order_number   => $ordernum,
3293       amount         => $amount,
3294       authorization  => $auth,
3295       description    => $options{'description'},
3296     );
3297
3298     foreach my $field (qw( authorization_source_code returned_ACI
3299                            transaction_identifier validation_code
3300                            transaction_sequence_num local_transaction_date
3301                            local_transaction_time AVS_result_code          )) {
3302       $capture{$field} = $transaction->$field() if $transaction->can($field);
3303     }
3304
3305     $capture->content( %capture );
3306
3307     $capture->submit();
3308
3309     unless ( $capture->is_success ) {
3310       my $e = "Authorization successful but capture failed, custnum #".
3311               $self->custnum. ': '.  $capture->result_code.
3312               ": ". $capture->error_message;
3313       warn $e;
3314       return $e;
3315     }
3316
3317   }
3318
3319   $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
3320   my $cpp_captured_err = $cust_pay_pending->replace;
3321   return $cpp_captured_err if $cpp_captured_err;
3322
3323   ###
3324   # remove paycvv after initial transaction
3325   ###
3326
3327   #false laziness w/misc/process/payment.cgi - check both to make sure working
3328   # correctly
3329   if ( defined $self->dbdef_table->column('paycvv')
3330        && length($self->paycvv)
3331        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
3332   ) {
3333     my $error = $self->remove_cvv;
3334     if ( $error ) {
3335       warn "WARNING: error removing cvv: $error\n";
3336     }
3337   }
3338
3339   ###
3340   # result handling
3341   ###
3342
3343   if ( $transaction->is_success() ) {
3344
3345     my $paybatch = '';
3346     if ( $payment_gateway ) { # agent override
3347       $paybatch = $payment_gateway->gatewaynum. '-';
3348     }
3349
3350     $paybatch .= "$processor:". $transaction->authorization;
3351
3352     $paybatch .= ':'. $transaction->order_number
3353       if $transaction->can('order_number')
3354       && length($transaction->order_number);
3355
3356     my $cust_pay = new FS::cust_pay ( {
3357        'custnum'  => $self->custnum,
3358        'invnum'   => $options{'invnum'},
3359        'paid'     => $amount,
3360        '_date'    => '',
3361        'payby'    => $method2payby{$method},
3362        'payinfo'  => $payinfo,
3363        'paybatch' => $paybatch,
3364        'paydate'  => $paydate,
3365     } );
3366     #doesn't hurt to know, even though the dup check is in cust_pay_pending now
3367     $cust_pay->payunique( $options{payunique} )
3368       if defined($options{payunique}) && length($options{payunique});
3369
3370     my $oldAutoCommit = $FS::UID::AutoCommit;
3371     local $FS::UID::AutoCommit = 0;
3372     my $dbh = dbh;
3373
3374     #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
3375
3376     my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3377
3378     if ( $error ) {
3379       $cust_pay->invnum(''); #try again with no specific invnum
3380       my $error2 = $cust_pay->insert( $options{'manual'} ?
3381                                       ( 'manual' => 1 ) : ()
3382                                     );
3383       if ( $error2 ) {
3384         # gah.  but at least we have a record of the state we had to abort in
3385         # from cust_pay_pending now.
3386         my $e = "WARNING: $method captured but payment not recorded - ".
3387                 "error inserting payment ($processor): $error2".
3388                 " (previously tried insert with invnum #$options{'invnum'}" .
3389                 ": $error ) - pending payment saved as paypendingnum ".
3390                 $cust_pay_pending->paypendingnum. "\n";
3391         warn $e;
3392         return $e;
3393       }
3394     }
3395
3396     if ( $options{'paynum_ref'} ) {
3397       ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3398     }
3399
3400     $cust_pay_pending->status('done');
3401     $cust_pay_pending->statustext('captured');
3402     my $cpp_done_err = $cust_pay_pending->replace;
3403
3404     if ( $cpp_done_err ) {
3405
3406       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
3407       my $e = "WARNING: $method captured but payment not recorded - ".
3408               "error updating status for paypendingnum ".
3409               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3410       warn $e;
3411       return $e;
3412
3413     } else {
3414
3415       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3416       return ''; #no error
3417
3418     }
3419
3420   } else {
3421
3422     my $perror = "$processor error: ". $transaction->error_message;
3423
3424     unless ( $transaction->error_message ) {
3425
3426       my $t_response;
3427       if ( $transaction->can('response_page') ) {
3428         $t_response = {
3429                         'page'    => ( $transaction->can('response_page')
3430                                          ? $transaction->response_page
3431                                          : ''
3432                                      ),
3433                         'code'    => ( $transaction->can('response_code')
3434                                          ? $transaction->response_code
3435                                          : ''
3436                                      ),
3437                         'headers' => ( $transaction->can('response_headers')
3438                                          ? $transaction->response_headers
3439                                          : ''
3440                                      ),
3441                       };
3442       } else {
3443         $t_response .=
3444           "No additional debugging information available for $processor";
3445       }
3446
3447       $perror .= "No error_message returned from $processor -- ".
3448                  ( ref($t_response) ? Dumper($t_response) : $t_response );
3449
3450     }
3451
3452     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
3453          && $conf->exists('emaildecline')
3454          && grep { $_ ne 'POST' } $self->invoicing_list
3455          && ! grep { $transaction->error_message =~ /$_/ }
3456                    $conf->config('emaildecline-exclude')
3457     ) {
3458       my @templ = $conf->config('declinetemplate');
3459       my $template = new Text::Template (
3460         TYPE   => 'ARRAY',
3461         SOURCE => [ map "$_\n", @templ ],
3462       ) or return "($perror) can't create template: $Text::Template::ERROR";
3463       $template->compile()
3464         or return "($perror) can't compile template: $Text::Template::ERROR";
3465
3466       my $templ_hash = { error => $transaction->error_message };
3467
3468       my $error = send_email(
3469         'from'    => $conf->config('invoice_from'),
3470         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
3471         'subject' => 'Your payment could not be processed',
3472         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
3473       );
3474
3475       $perror .= " (also received error sending decline notification: $error)"
3476         if $error;
3477
3478     }
3479
3480     $cust_pay_pending->status('done');
3481     $cust_pay_pending->statustext("declined: $perror");
3482     my $cpp_done_err = $cust_pay_pending->replace;
3483     if ( $cpp_done_err ) {
3484       my $e = "WARNING: $method declined but pending payment not resolved - ".
3485               "error updating status for paypendingnum ".
3486               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3487       warn $e;
3488       $perror = "$e ($perror)";
3489     }
3490
3491     return $perror;
3492   }
3493
3494 }
3495
3496 =item fake_bop
3497
3498 =cut
3499
3500 sub fake_bop {
3501   my( $self, $method, $amount, %options ) = @_;
3502
3503   if ( $options{'fake_failure'} ) {
3504      return "Error: No error; test failure requested with fake_failure";
3505   }
3506
3507   my %method2payby = (
3508     'CC'     => 'CARD',
3509     'ECHECK' => 'CHEK',
3510     'LEC'    => 'LECB',
3511   );
3512
3513   #my $paybatch = '';
3514   #if ( $payment_gateway ) { # agent override
3515   #  $paybatch = $payment_gateway->gatewaynum. '-';
3516   #}
3517   #
3518   #$paybatch .= "$processor:". $transaction->authorization;
3519   #
3520   #$paybatch .= ':'. $transaction->order_number
3521   #  if $transaction->can('order_number')
3522   #  && length($transaction->order_number);
3523
3524   my $paybatch = 'FakeProcessor:54:32';
3525
3526   my $cust_pay = new FS::cust_pay ( {
3527      'custnum'  => $self->custnum,
3528      'invnum'   => $options{'invnum'},
3529      'paid'     => $amount,
3530      '_date'    => '',
3531      'payby'    => $method2payby{$method},
3532      #'payinfo'  => $payinfo,
3533      'payinfo'  => '4111111111111111',
3534      'paybatch' => $paybatch,
3535      #'paydate'  => $paydate,
3536      'paydate'  => '2012-05-01',
3537   } );
3538   $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
3539
3540   my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3541
3542   if ( $error ) {
3543     $cust_pay->invnum(''); #try again with no specific invnum
3544     my $error2 = $cust_pay->insert( $options{'manual'} ?
3545                                     ( 'manual' => 1 ) : ()
3546                                   );
3547     if ( $error2 ) {
3548       # gah, even with transactions.
3549       my $e = 'WARNING: Card/ACH debited but database not updated - '.
3550               "error inserting (fake!) payment: $error2".
3551               " (previously tried insert with invnum #$options{'invnum'}" .
3552               ": $error )";
3553       warn $e;
3554       return $e;
3555     }
3556   }
3557
3558   if ( $options{'paynum_ref'} ) {
3559     ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3560   }
3561
3562   return ''; #no error
3563
3564 }
3565
3566 =item default_payment_gateway
3567
3568 =cut
3569
3570 sub default_payment_gateway {
3571   my( $self, $method ) = @_;
3572
3573   die "Real-time processing not enabled\n"
3574     unless $conf->exists('business-onlinepayment');
3575
3576   #load up config
3577   my $bop_config = 'business-onlinepayment';
3578   $bop_config .= '-ach'
3579     if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
3580   my ( $processor, $login, $password, $action, @bop_options ) =
3581     $conf->config($bop_config);
3582   $action ||= 'normal authorization';
3583   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
3584   die "No real-time processor is enabled - ".
3585       "did you set the business-onlinepayment configuration value?\n"
3586     unless $processor;
3587
3588   ( $processor, $login, $password, $action, @bop_options )
3589 }
3590
3591 =item remove_cvv
3592
3593 Removes the I<paycvv> field from the database directly.
3594
3595 If there is an error, returns the error, otherwise returns false.
3596
3597 =cut
3598
3599 sub remove_cvv {
3600   my $self = shift;
3601   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
3602     or return dbh->errstr;
3603   $sth->execute($self->custnum)
3604     or return $sth->errstr;
3605   $self->paycvv('');
3606   '';
3607 }
3608
3609 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
3610
3611 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
3612 via a Business::OnlinePayment realtime gateway.  See
3613 L<http://420.am/business-onlinepayment> for supported gateways.
3614
3615 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3616
3617 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
3618
3619 Most gateways require a reference to an original payment transaction to refund,
3620 so you probably need to specify a I<paynum>.
3621
3622 I<amount> defaults to the original amount of the payment if not specified.
3623
3624 I<reason> specifies a reason for the refund.
3625
3626 I<paydate> specifies the expiration date for a credit card overriding the
3627 value from the customer record or the payment record. Specified as yyyy-mm-dd
3628
3629 Implementation note: If I<amount> is unspecified or equal to the amount of the
3630 orignal payment, first an attempt is made to "void" the transaction via
3631 the gateway (to cancel a not-yet settled transaction) and then if that fails,
3632 the normal attempt is made to "refund" ("credit") the transaction via the
3633 gateway is attempted.
3634
3635 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3636 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
3637 #if set, will override the value from the customer record.
3638
3639 #If an I<invnum> is specified, this payment (if successful) is applied to the
3640 #specified invoice.  If you don't specify an I<invnum> you might want to
3641 #call the B<apply_payments> method.
3642
3643 =cut
3644
3645 #some false laziness w/realtime_bop, not enough to make it worth merging
3646 #but some useful small subs should be pulled out
3647 sub realtime_refund_bop {
3648   my( $self, $method, %options ) = @_;
3649   if ( $DEBUG ) {
3650     warn "$me realtime_refund_bop: $method refund\n";
3651     warn "  $_ => $options{$_}\n" foreach keys %options;
3652   }
3653
3654   eval "use Business::OnlinePayment";
3655   die $@ if $@;
3656
3657   ###
3658   # look up the original payment and optionally a gateway for that payment
3659   ###
3660
3661   my $cust_pay = '';
3662   my $amount = $options{'amount'};
3663
3664   my( $processor, $login, $password, @bop_options ) ;
3665   my( $auth, $order_number ) = ( '', '', '' );
3666
3667   if ( $options{'paynum'} ) {
3668
3669     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
3670     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
3671       or return "Unknown paynum $options{'paynum'}";
3672     $amount ||= $cust_pay->paid;
3673
3674     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
3675       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
3676                 $cust_pay->paybatch;
3677     my $gatewaynum = '';
3678     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
3679
3680     if ( $gatewaynum ) { #gateway for the payment to be refunded
3681
3682       my $payment_gateway =
3683         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
3684       die "payment gateway $gatewaynum not found"
3685         unless $payment_gateway;
3686
3687       $processor   = $payment_gateway->gateway_module;
3688       $login       = $payment_gateway->gateway_username;
3689       $password    = $payment_gateway->gateway_password;
3690       @bop_options = $payment_gateway->options;
3691
3692     } else { #try the default gateway
3693
3694       my( $conf_processor, $unused_action );
3695       ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
3696         $self->default_payment_gateway($method);
3697
3698       return "processor of payment $options{'paynum'} $processor does not".
3699              " match default processor $conf_processor"
3700         unless $processor eq $conf_processor;
3701
3702     }
3703
3704
3705   } else { # didn't specify a paynum, so look for agent gateway overrides
3706            # like a normal transaction
3707
3708     my $cardtype;
3709     if ( $method eq 'CC' ) {
3710       $cardtype = cardtype($self->payinfo);
3711     } elsif ( $method eq 'ECHECK' ) {
3712       $cardtype = 'ACH';
3713     } else {
3714       $cardtype = $method;
3715     }
3716     my $override =
3717            qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3718                                                cardtype => $cardtype,
3719                                                taxclass => '',              } )
3720         || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3721                                                cardtype => '',
3722                                                taxclass => '',              } );
3723
3724     if ( $override ) { #use a payment gateway override
3725
3726       my $payment_gateway = $override->payment_gateway;
3727
3728       $processor   = $payment_gateway->gateway_module;
3729       $login       = $payment_gateway->gateway_username;
3730       $password    = $payment_gateway->gateway_password;
3731       #$action      = $payment_gateway->gateway_action;
3732       @bop_options = $payment_gateway->options;
3733
3734     } else { #use the standard settings from the config
3735
3736       my $unused_action;
3737       ( $processor, $login, $password, $unused_action, @bop_options ) =
3738         $self->default_payment_gateway($method);
3739
3740     }
3741
3742   }
3743   return "neither amount nor paynum specified" unless $amount;
3744
3745   my %content = (
3746     'type'           => $method,
3747     'login'          => $login,
3748     'password'       => $password,
3749     'order_number'   => $order_number,
3750     'amount'         => $amount,
3751     'referer'        => 'http://cleanwhisker.420.am/',
3752   );
3753   $content{authorization} = $auth
3754     if length($auth); #echeck/ACH transactions have an order # but no auth
3755                       #(at least with authorize.net)
3756
3757   my $disable_void_after;
3758   if ($conf->exists('disable_void_after')
3759       && $conf->config('disable_void_after') =~ /^(\d+)$/) {
3760     $disable_void_after = $1;
3761   }
3762
3763   #first try void if applicable
3764   if ( $cust_pay && $cust_pay->paid == $amount
3765     && (
3766       ( not defined($disable_void_after) )
3767       || ( time < ($cust_pay->_date + $disable_void_after ) )
3768     )
3769   ) {
3770     warn "  attempting void\n" if $DEBUG > 1;
3771     my $void = new Business::OnlinePayment( $processor, @bop_options );
3772     $void->content( 'action' => 'void', %content );
3773     $void->submit();
3774     if ( $void->is_success ) {
3775       my $error = $cust_pay->void($options{'reason'});
3776       if ( $error ) {
3777         # gah, even with transactions.
3778         my $e = 'WARNING: Card/ACH voided but database not updated - '.
3779                 "error voiding payment: $error";
3780         warn $e;
3781         return $e;
3782       }
3783       warn "  void successful\n" if $DEBUG > 1;
3784       return '';
3785     }
3786   }
3787
3788   warn "  void unsuccessful, trying refund\n"
3789     if $DEBUG > 1;
3790
3791   #massage data
3792   my $address = $self->address1;
3793   $address .= ", ". $self->address2 if $self->address2;
3794
3795   my($payname, $payfirst, $paylast);
3796   if ( $self->payname && $method ne 'ECHECK' ) {
3797     $payname = $self->payname;
3798     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3799       or return "Illegal payname $payname";
3800     ($payfirst, $paylast) = ($1, $2);
3801   } else {
3802     $payfirst = $self->getfield('first');
3803     $paylast = $self->getfield('last');
3804     $payname =  "$payfirst $paylast";
3805   }
3806
3807   my @invoicing_list = $self->invoicing_list_emailonly;
3808   if ( $conf->exists('emailinvoiceautoalways')
3809        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3810        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3811     push @invoicing_list, $self->all_emails;
3812   }
3813
3814   my $email = ($conf->exists('business-onlinepayment-email-override'))
3815               ? $conf->config('business-onlinepayment-email-override')
3816               : $invoicing_list[0];
3817
3818   my $payip = exists($options{'payip'})
3819                 ? $options{'payip'}
3820                 : $self->payip;
3821   $content{customer_ip} = $payip
3822     if length($payip);
3823
3824   my $payinfo = '';
3825   if ( $method eq 'CC' ) {
3826
3827     if ( $cust_pay ) {
3828       $content{card_number} = $payinfo = $cust_pay->payinfo;
3829       (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
3830         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
3831         ($content{expiration} = "$2/$1");  # where available
3832     } else {
3833       $content{card_number} = $payinfo = $self->payinfo;
3834       (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
3835         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3836       $content{expiration} = "$2/$1";
3837     }
3838
3839   } elsif ( $method eq 'ECHECK' ) {
3840
3841     if ( $cust_pay ) {
3842       $payinfo = $cust_pay->payinfo;
3843     } else {
3844       $payinfo = $self->payinfo;
3845     }
3846     ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
3847     $content{bank_name} = $self->payname;
3848     $content{account_type} = 'CHECKING';
3849     $content{account_name} = $payname;
3850     $content{customer_org} = $self->company ? 'B' : 'I';
3851     $content{customer_ssn} = $self->ss;
3852   } elsif ( $method eq 'LEC' ) {
3853     $content{phone} = $payinfo = $self->payinfo;
3854   }
3855
3856   #then try refund
3857   my $refund = new Business::OnlinePayment( $processor, @bop_options );
3858   my %sub_content = $refund->content(
3859     'action'         => 'credit',
3860     'customer_id'    => $self->custnum,
3861     'last_name'      => $paylast,
3862     'first_name'     => $payfirst,
3863     'name'           => $payname,
3864     'address'        => $address,
3865     'city'           => $self->city,
3866     'state'          => $self->state,
3867     'zip'            => $self->zip,
3868     'country'        => $self->country,
3869     'email'          => $email,
3870     'phone'          => $self->daytime || $self->night,
3871     %content, #after
3872   );
3873   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
3874     if $DEBUG > 1;
3875   $refund->submit();
3876
3877   return "$processor error: ". $refund->error_message
3878     unless $refund->is_success();
3879
3880   my %method2payby = (
3881     'CC'     => 'CARD',
3882     'ECHECK' => 'CHEK',
3883     'LEC'    => 'LECB',
3884   );
3885
3886   my $paybatch = "$processor:". $refund->authorization;
3887   $paybatch .= ':'. $refund->order_number
3888     if $refund->can('order_number') && $refund->order_number;
3889
3890   while ( $cust_pay && $cust_pay->unapplied < $amount ) {
3891     my @cust_bill_pay = $cust_pay->cust_bill_pay;
3892     last unless @cust_bill_pay;
3893     my $cust_bill_pay = pop @cust_bill_pay;
3894     my $error = $cust_bill_pay->delete;
3895     last if $error;
3896   }
3897
3898   my $cust_refund = new FS::cust_refund ( {
3899     'custnum'  => $self->custnum,
3900     'paynum'   => $options{'paynum'},
3901     'refund'   => $amount,
3902     '_date'    => '',
3903     'payby'    => $method2payby{$method},
3904     'payinfo'  => $payinfo,
3905     'paybatch' => $paybatch,
3906     'reason'   => $options{'reason'} || 'card or ACH refund',
3907   } );
3908   my $error = $cust_refund->insert;
3909   if ( $error ) {
3910     $cust_refund->paynum(''); #try again with no specific paynum
3911     my $error2 = $cust_refund->insert;
3912     if ( $error2 ) {
3913       # gah, even with transactions.
3914       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
3915               "error inserting refund ($processor): $error2".
3916               " (previously tried insert with paynum #$options{'paynum'}" .
3917               ": $error )";
3918       warn $e;
3919       return $e;
3920     }
3921   }
3922
3923   ''; #no error
3924
3925 }
3926
3927 =item batch_card OPTION => VALUE...
3928
3929 Adds a payment for this invoice to the pending credit card batch (see
3930 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
3931 runs the payment using a realtime gateway.
3932
3933 =cut
3934
3935 sub batch_card {
3936   my ($self, %options) = @_;
3937
3938   my $amount;
3939   if (exists($options{amount})) {
3940     $amount = $options{amount};
3941   }else{
3942     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
3943   }
3944   return '' unless $amount > 0;
3945
3946   my $invnum = delete $options{invnum};
3947   my $payby = $options{invnum} || $self->payby;  #dubious
3948
3949   if ($options{'realtime'}) {
3950     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
3951                                 $amount,
3952                                 %options,
3953                               );
3954   }
3955
3956   my $oldAutoCommit = $FS::UID::AutoCommit;
3957   local $FS::UID::AutoCommit = 0;
3958   my $dbh = dbh;
3959
3960   #this needs to handle mysql as well as Pg, like svc_acct.pm
3961   #(make it into a common function if folks need to do batching with mysql)
3962   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
3963     or return "Cannot lock pay_batch: " . $dbh->errstr;
3964
3965   my %pay_batch = (
3966     'status' => 'O',
3967     'payby'  => FS::payby->payby2payment($payby),
3968   );
3969
3970   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
3971
3972   unless ( $pay_batch ) {
3973     $pay_batch = new FS::pay_batch \%pay_batch;
3974     my $error = $pay_batch->insert;
3975     if ( $error ) {
3976       $dbh->rollback if $oldAutoCommit;
3977       die "error creating new batch: $error\n";
3978     }
3979   }
3980
3981   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
3982       'batchnum' => $pay_batch->batchnum,
3983       'custnum'  => $self->custnum,
3984   } );
3985
3986   foreach (qw( address1 address2 city state zip country payby payinfo paydate
3987                payname )) {
3988     $options{$_} = '' unless exists($options{$_});
3989   }
3990
3991   my $cust_pay_batch = new FS::cust_pay_batch ( {
3992     'batchnum' => $pay_batch->batchnum,
3993     'invnum'   => $invnum || 0,                    # is there a better value?
3994                                                    # this field should be
3995                                                    # removed...
3996                                                    # cust_bill_pay_batch now
3997     'custnum'  => $self->custnum,
3998     'last'     => $self->getfield('last'),
3999     'first'    => $self->getfield('first'),
4000     'address1' => $options{address1} || $self->address1,
4001     'address2' => $options{address2} || $self->address2,
4002     'city'     => $options{city}     || $self->city,
4003     'state'    => $options{state}    || $self->state,
4004     'zip'      => $options{zip}      || $self->zip,
4005     'country'  => $options{country}  || $self->country,
4006     'payby'    => $options{payby}    || $self->payby,
4007     'payinfo'  => $options{payinfo}  || $self->payinfo,
4008     'exp'      => $options{paydate}  || $self->paydate,
4009     'payname'  => $options{payname}  || $self->payname,
4010     'amount'   => $amount,                         # consolidating
4011   } );
4012
4013   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
4014     if $old_cust_pay_batch;
4015
4016   my $error;
4017   if ($old_cust_pay_batch) {
4018     $error = $cust_pay_batch->replace($old_cust_pay_batch)
4019   } else {
4020     $error = $cust_pay_batch->insert;
4021   }
4022
4023   if ( $error ) {
4024     $dbh->rollback if $oldAutoCommit;
4025     die $error;
4026   }
4027
4028   my $unapplied = $self->total_credited + $self->total_unapplied_payments + $self->in_transit_payments;
4029   foreach my $cust_bill ($self->open_cust_bill) {
4030     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
4031     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
4032       'invnum' => $cust_bill->invnum,
4033       'paybatchnum' => $cust_pay_batch->paybatchnum,
4034       'amount' => $cust_bill->owed,
4035       '_date' => time,
4036     };
4037     if ($unapplied >= $cust_bill_pay_batch->amount){
4038       $unapplied -= $cust_bill_pay_batch->amount;
4039       next;
4040     }else{
4041       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
4042                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
4043     }
4044     $error = $cust_bill_pay_batch->insert;
4045     if ( $error ) {
4046       $dbh->rollback if $oldAutoCommit;
4047       die $error;
4048     }
4049   }
4050
4051   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4052   '';
4053 }
4054
4055 =item total_owed
4056
4057 Returns the total owed for this customer on all invoices
4058 (see L<FS::cust_bill/owed>).
4059
4060 =cut
4061
4062 sub total_owed {
4063   my $self = shift;
4064   $self->total_owed_date(2145859200); #12/31/2037
4065 }
4066
4067 =item total_owed_date TIME
4068
4069 Returns the total owed for this customer on all invoices with date earlier than
4070 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
4071 see L<Time::Local> and L<Date::Parse> for conversion functions.
4072
4073 =cut
4074
4075 sub total_owed_date {
4076   my $self = shift;
4077   my $time = shift;
4078   my $total_bill = 0;
4079   foreach my $cust_bill (
4080     grep { $_->_date <= $time }
4081       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4082   ) {
4083     $total_bill += $cust_bill->owed;
4084   }
4085   sprintf( "%.2f", $total_bill );
4086 }
4087
4088 =item apply_payments_and_credits
4089
4090 Applies unapplied payments and credits.
4091
4092 In most cases, this new method should be used in place of sequential
4093 apply_payments and apply_credits methods.
4094
4095 If there is an error, returns the error, otherwise returns false.
4096
4097 =cut
4098
4099 sub apply_payments_and_credits {
4100   my $self = shift;
4101
4102   local $SIG{HUP} = 'IGNORE';
4103   local $SIG{INT} = 'IGNORE';
4104   local $SIG{QUIT} = 'IGNORE';
4105   local $SIG{TERM} = 'IGNORE';
4106   local $SIG{TSTP} = 'IGNORE';
4107   local $SIG{PIPE} = 'IGNORE';
4108
4109   my $oldAutoCommit = $FS::UID::AutoCommit;
4110   local $FS::UID::AutoCommit = 0;
4111   my $dbh = dbh;
4112
4113   $self->select_for_update; #mutex
4114
4115   foreach my $cust_bill ( $self->open_cust_bill ) {
4116     my $error = $cust_bill->apply_payments_and_credits;
4117     if ( $error ) {
4118       $dbh->rollback if $oldAutoCommit;
4119       return "Error applying: $error";
4120     }
4121   }
4122
4123   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4124   ''; #no error
4125
4126 }
4127
4128 =item apply_credits OPTION => VALUE ...
4129
4130 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
4131 to outstanding invoice balances in chronological order (or reverse
4132 chronological order if the I<order> option is set to B<newest>) and returns the
4133 value of any remaining unapplied credits available for refund (see
4134 L<FS::cust_refund>).
4135
4136 Dies if there is an error.
4137
4138 =cut
4139
4140 sub apply_credits {
4141   my $self = shift;
4142   my %opt = @_;
4143
4144   local $SIG{HUP} = 'IGNORE';
4145   local $SIG{INT} = 'IGNORE';
4146   local $SIG{QUIT} = 'IGNORE';
4147   local $SIG{TERM} = 'IGNORE';
4148   local $SIG{TSTP} = 'IGNORE';
4149   local $SIG{PIPE} = 'IGNORE';
4150
4151   my $oldAutoCommit = $FS::UID::AutoCommit;
4152   local $FS::UID::AutoCommit = 0;
4153   my $dbh = dbh;
4154
4155   $self->select_for_update; #mutex
4156
4157   unless ( $self->total_credited ) {
4158     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4159     return 0;
4160   }
4161
4162   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
4163       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
4164
4165   my @invoices = $self->open_cust_bill;
4166   @invoices = sort { $b->_date <=> $a->_date } @invoices
4167     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
4168
4169   my $credit;
4170   foreach my $cust_bill ( @invoices ) {
4171     my $amount;
4172
4173     if ( !defined($credit) || $credit->credited == 0) {
4174       $credit = pop @credits or last;
4175     }
4176
4177     if ($cust_bill->owed >= $credit->credited) {
4178       $amount=$credit->credited;
4179     }else{
4180       $amount=$cust_bill->owed;
4181     }
4182
4183     my $cust_credit_bill = new FS::cust_credit_bill ( {
4184       'crednum' => $credit->crednum,
4185       'invnum'  => $cust_bill->invnum,
4186       'amount'  => $amount,
4187     } );
4188     my $error = $cust_credit_bill->insert;
4189     if ( $error ) {
4190       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4191       die $error;
4192     }
4193
4194     redo if ($cust_bill->owed > 0);
4195
4196   }
4197
4198   my $total_credited = $self->total_credited;
4199
4200   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4201
4202   return $total_credited;
4203 }
4204
4205 =item apply_payments
4206
4207 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
4208 to outstanding invoice balances in chronological order.
4209
4210  #and returns the value of any remaining unapplied payments.
4211
4212 Dies if there is an error.
4213
4214 =cut
4215
4216 sub apply_payments {
4217   my $self = shift;
4218
4219   local $SIG{HUP} = 'IGNORE';
4220   local $SIG{INT} = 'IGNORE';
4221   local $SIG{QUIT} = 'IGNORE';
4222   local $SIG{TERM} = 'IGNORE';
4223   local $SIG{TSTP} = 'IGNORE';
4224   local $SIG{PIPE} = 'IGNORE';
4225
4226   my $oldAutoCommit = $FS::UID::AutoCommit;
4227   local $FS::UID::AutoCommit = 0;
4228   my $dbh = dbh;
4229
4230   $self->select_for_update; #mutex
4231
4232   #return 0 unless
4233
4234   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
4235       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
4236
4237   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
4238       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
4239
4240   my $payment;
4241
4242   foreach my $cust_bill ( @invoices ) {
4243     my $amount;
4244
4245     if ( !defined($payment) || $payment->unapplied == 0 ) {
4246       $payment = pop @payments or last;
4247     }
4248
4249     if ( $cust_bill->owed >= $payment->unapplied ) {
4250       $amount = $payment->unapplied;
4251     } else {
4252       $amount = $cust_bill->owed;
4253     }
4254
4255     my $cust_bill_pay = new FS::cust_bill_pay ( {
4256       'paynum' => $payment->paynum,
4257       'invnum' => $cust_bill->invnum,
4258       'amount' => $amount,
4259     } );
4260     my $error = $cust_bill_pay->insert;
4261     if ( $error ) {
4262       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4263       die $error;
4264     }
4265
4266     redo if ( $cust_bill->owed > 0);
4267
4268   }
4269
4270   my $total_unapplied_payments = $self->total_unapplied_payments;
4271
4272   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4273
4274   return $total_unapplied_payments;
4275 }
4276
4277 =item total_credited
4278
4279 Returns the total outstanding credit (see L<FS::cust_credit>) for this
4280 customer.  See L<FS::cust_credit/credited>.
4281
4282 =cut
4283
4284 sub total_credited {
4285   my $self = shift;
4286   my $total_credit = 0;
4287   foreach my $cust_credit ( qsearch('cust_credit', {
4288     'custnum' => $self->custnum,
4289   } ) ) {
4290     $total_credit += $cust_credit->credited;
4291   }
4292   sprintf( "%.2f", $total_credit );
4293 }
4294
4295 =item total_unapplied_payments
4296
4297 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
4298 See L<FS::cust_pay/unapplied>.
4299
4300 =cut
4301
4302 sub total_unapplied_payments {
4303   my $self = shift;
4304   my $total_unapplied = 0;
4305   foreach my $cust_pay ( qsearch('cust_pay', {
4306     'custnum' => $self->custnum,
4307   } ) ) {
4308     $total_unapplied += $cust_pay->unapplied;
4309   }
4310   sprintf( "%.2f", $total_unapplied );
4311 }
4312
4313 =item total_unapplied_refunds
4314
4315 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
4316 customer.  See L<FS::cust_refund/unapplied>.
4317
4318 =cut
4319
4320 sub total_unapplied_refunds {
4321   my $self = shift;
4322   my $total_unapplied = 0;
4323   foreach my $cust_refund ( qsearch('cust_refund', {
4324     'custnum' => $self->custnum,
4325   } ) ) {
4326     $total_unapplied += $cust_refund->unapplied;
4327   }
4328   sprintf( "%.2f", $total_unapplied );
4329 }
4330
4331 =item balance
4332
4333 Returns the balance for this customer (total_owed plus total_unrefunded, minus
4334 total_credited minus total_unapplied_payments).
4335
4336 =cut
4337
4338 sub balance {
4339   my $self = shift;
4340   sprintf( "%.2f",
4341       $self->total_owed
4342     + $self->total_unapplied_refunds
4343     - $self->total_credited
4344     - $self->total_unapplied_payments
4345   );
4346 }
4347
4348 =item balance_date TIME
4349
4350 Returns the balance for this customer, only considering invoices with date
4351 earlier than TIME (total_owed_date minus total_credited minus
4352 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
4353 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
4354 functions.
4355
4356 =cut
4357
4358 sub balance_date {
4359   my $self = shift;
4360   my $time = shift;
4361   sprintf( "%.2f",
4362         $self->total_owed_date($time)
4363       + $self->total_unapplied_refunds
4364       - $self->total_credited
4365       - $self->total_unapplied_payments
4366   );
4367 }
4368
4369 =item in_transit_payments
4370
4371 Returns the total of requests for payments for this customer pending in
4372 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
4373
4374 =cut
4375
4376 sub in_transit_payments {
4377   my $self = shift;
4378   my $in_transit_payments = 0;
4379   foreach my $pay_batch ( qsearch('pay_batch', {
4380     'status' => 'I',
4381   } ) ) {
4382     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
4383       'batchnum' => $pay_batch->batchnum,
4384       'custnum' => $self->custnum,
4385     } ) ) {
4386       $in_transit_payments += $cust_pay_batch->amount;
4387     }
4388   }
4389   sprintf( "%.2f", $in_transit_payments );
4390 }
4391
4392 =item paydate_monthyear
4393
4394 Returns a two-element list consisting of the month and year of this customer's
4395 paydate (credit card expiration date for CARD customers)
4396
4397 =cut
4398
4399 sub paydate_monthyear {
4400   my $self = shift;
4401   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
4402     ( $2, $1 );
4403   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
4404     ( $1, $3 );
4405   } else {
4406     ('', '');
4407   }
4408 }
4409
4410 =item invoicing_list [ ARRAYREF ]
4411
4412 If an arguement is given, sets these email addresses as invoice recipients
4413 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
4414 (except as warnings), so use check_invoicing_list first.
4415
4416 Returns a list of email addresses (with svcnum entries expanded).
4417
4418 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
4419 check it without disturbing anything by passing nothing.
4420
4421 This interface may change in the future.
4422
4423 =cut
4424
4425 sub invoicing_list {
4426   my( $self, $arrayref ) = @_;
4427
4428   if ( $arrayref ) {
4429     my @cust_main_invoice;
4430     if ( $self->custnum ) {
4431       @cust_main_invoice =
4432         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4433     } else {
4434       @cust_main_invoice = ();
4435     }
4436     foreach my $cust_main_invoice ( @cust_main_invoice ) {
4437       #warn $cust_main_invoice->destnum;
4438       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
4439         #warn $cust_main_invoice->destnum;
4440         my $error = $cust_main_invoice->delete;
4441         warn $error if $error;
4442       }
4443     }
4444     if ( $self->custnum ) {
4445       @cust_main_invoice =
4446         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4447     } else {
4448       @cust_main_invoice = ();
4449     }
4450     my %seen = map { $_->address => 1 } @cust_main_invoice;
4451     foreach my $address ( @{$arrayref} ) {
4452       next if exists $seen{$address} && $seen{$address};
4453       $seen{$address} = 1;
4454       my $cust_main_invoice = new FS::cust_main_invoice ( {
4455         'custnum' => $self->custnum,
4456         'dest'    => $address,
4457       } );
4458       my $error = $cust_main_invoice->insert;
4459       warn $error if $error;
4460     }
4461   }
4462
4463   if ( $self->custnum ) {
4464     map { $_->address }
4465       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4466   } else {
4467     ();
4468   }
4469
4470 }
4471
4472 =item check_invoicing_list ARRAYREF
4473
4474 Checks these arguements as valid input for the invoicing_list method.  If there
4475 is an error, returns the error, otherwise returns false.
4476
4477 =cut
4478
4479 sub check_invoicing_list {
4480   my( $self, $arrayref ) = @_;
4481
4482   foreach my $address ( @$arrayref ) {
4483
4484     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
4485       return 'Can\'t add FAX invoice destination with a blank FAX number.';
4486     }
4487
4488     my $cust_main_invoice = new FS::cust_main_invoice ( {
4489       'custnum' => $self->custnum,
4490       'dest'    => $address,
4491     } );
4492     my $error = $self->custnum
4493                 ? $cust_main_invoice->check
4494                 : $cust_main_invoice->checkdest
4495     ;
4496     return $error if $error;
4497
4498   }
4499
4500   return "Email address required"
4501     if $conf->exists('cust_main-require_invoicing_list_email')
4502     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
4503
4504   '';
4505 }
4506
4507 =item set_default_invoicing_list
4508
4509 Sets the invoicing list to all accounts associated with this customer,
4510 overwriting any previous invoicing list.
4511
4512 =cut
4513
4514 sub set_default_invoicing_list {
4515   my $self = shift;
4516   $self->invoicing_list($self->all_emails);
4517 }
4518
4519 =item all_emails
4520
4521 Returns the email addresses of all accounts provisioned for this customer.
4522
4523 =cut
4524
4525 sub all_emails {
4526   my $self = shift;
4527   my %list;
4528   foreach my $cust_pkg ( $self->all_pkgs ) {
4529     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
4530     my @svc_acct =
4531       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
4532         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
4533           @cust_svc;
4534     $list{$_}=1 foreach map { $_->email } @svc_acct;
4535   }
4536   keys %list;
4537 }
4538
4539 =item invoicing_list_addpost
4540
4541 Adds postal invoicing to this customer.  If this customer is already configured
4542 to receive postal invoices, does nothing.
4543
4544 =cut
4545
4546 sub invoicing_list_addpost {
4547   my $self = shift;
4548   return if grep { $_ eq 'POST' } $self->invoicing_list;
4549   my @invoicing_list = $self->invoicing_list;
4550   push @invoicing_list, 'POST';
4551   $self->invoicing_list(\@invoicing_list);
4552 }
4553
4554 =item invoicing_list_emailonly
4555
4556 Returns the list of email invoice recipients (invoicing_list without non-email
4557 destinations such as POST and FAX).
4558
4559 =cut
4560
4561 sub invoicing_list_emailonly {
4562   my $self = shift;
4563   warn "$me invoicing_list_emailonly called"
4564     if $DEBUG;
4565   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
4566 }
4567
4568 =item invoicing_list_emailonly_scalar
4569
4570 Returns the list of email invoice recipients (invoicing_list without non-email
4571 destinations such as POST and FAX) as a comma-separated scalar.
4572
4573 =cut
4574
4575 sub invoicing_list_emailonly_scalar {
4576   my $self = shift;
4577   warn "$me invoicing_list_emailonly_scalar called"
4578     if $DEBUG;
4579   join(', ', $self->invoicing_list_emailonly);
4580 }
4581
4582 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
4583
4584 Returns an array of customers referred by this customer (referral_custnum set
4585 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
4586 customers referred by customers referred by this customer and so on, inclusive.
4587 The default behavior is DEPTH 1 (no recursion).
4588
4589 =cut
4590
4591 sub referral_cust_main {
4592   my $self = shift;
4593   my $depth = @_ ? shift : 1;
4594   my $exclude = @_ ? shift : {};
4595
4596   my @cust_main =
4597     map { $exclude->{$_->custnum}++; $_; }
4598       grep { ! $exclude->{ $_->custnum } }
4599         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
4600
4601   if ( $depth > 1 ) {
4602     push @cust_main,
4603       map { $_->referral_cust_main($depth-1, $exclude) }
4604         @cust_main;
4605   }
4606
4607   @cust_main;
4608 }
4609
4610 =item referral_cust_main_ncancelled
4611
4612 Same as referral_cust_main, except only returns customers with uncancelled
4613 packages.
4614
4615 =cut
4616
4617 sub referral_cust_main_ncancelled {
4618   my $self = shift;
4619   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
4620 }
4621
4622 =item referral_cust_pkg [ DEPTH ]
4623
4624 Like referral_cust_main, except returns a flat list of all unsuspended (and
4625 uncancelled) packages for each customer.  The number of items in this list may
4626 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
4627
4628 =cut
4629
4630 sub referral_cust_pkg {
4631   my $self = shift;
4632   my $depth = @_ ? shift : 1;
4633
4634   map { $_->unsuspended_pkgs }
4635     grep { $_->unsuspended_pkgs }
4636       $self->referral_cust_main($depth);
4637 }
4638
4639 =item referring_cust_main
4640
4641 Returns the single cust_main record for the customer who referred this customer
4642 (referral_custnum), or false.
4643
4644 =cut
4645
4646 sub referring_cust_main {
4647   my $self = shift;
4648   return '' unless $self->referral_custnum;
4649   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
4650 }
4651
4652 =item credit AMOUNT, REASON
4653
4654 Applies a credit to this customer.  If there is an error, returns the error,
4655 otherwise returns false.
4656
4657 =cut
4658
4659 sub credit {
4660   my( $self, $amount, $reason, %options ) = @_;
4661   my $cust_credit = new FS::cust_credit {
4662     'custnum' => $self->custnum,
4663     'amount'  => $amount,
4664     'reason'  => $reason,
4665   };
4666   $cust_credit->insert(%options);
4667 }
4668
4669 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
4670
4671 Creates a one-time charge for this customer.  If there is an error, returns
4672 the error, otherwise returns false.
4673
4674 =cut
4675
4676 sub charge {
4677   my $self = shift;
4678   my ( $amount, $pkg, $comment, $taxclass, $additional, $classnum );
4679   if ( ref( $_[0] ) ) {
4680     $amount     = $_[0]->{amount};
4681     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
4682     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
4683                                            : '$'. sprintf("%.2f",$amount);
4684     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
4685     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
4686     $additional = $_[0]->{additional};
4687   }else{
4688     $amount     = shift;
4689     $pkg        = @_ ? shift : 'One-time charge';
4690     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
4691     $taxclass   = @_ ? shift : '';
4692     $additional = [];
4693   }
4694
4695   local $SIG{HUP} = 'IGNORE';
4696   local $SIG{INT} = 'IGNORE';
4697   local $SIG{QUIT} = 'IGNORE';
4698   local $SIG{TERM} = 'IGNORE';
4699   local $SIG{TSTP} = 'IGNORE';
4700   local $SIG{PIPE} = 'IGNORE';
4701
4702   my $oldAutoCommit = $FS::UID::AutoCommit;
4703   local $FS::UID::AutoCommit = 0;
4704   my $dbh = dbh;
4705
4706   my $part_pkg = new FS::part_pkg ( {
4707     'pkg'      => $pkg,
4708     'comment'  => $comment,
4709     'plan'     => 'flat',
4710     'freq'     => 0,
4711     'disabled' => 'Y',
4712     'classnum' => $classnum ? $classnum : '',
4713     'taxclass' => $taxclass,
4714   } );
4715
4716   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
4717                         ( 0 .. @$additional - 1 )
4718                   ),
4719                   'additional_count' => scalar(@$additional),
4720                   'setup_fee' => $amount,
4721                 );
4722
4723   my $error = $part_pkg->insert( options => \%options );
4724   if ( $error ) {
4725     $dbh->rollback if $oldAutoCommit;
4726     return $error;
4727   }
4728
4729   my $pkgpart = $part_pkg->pkgpart;
4730   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
4731   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
4732     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
4733     $error = $type_pkgs->insert;
4734     if ( $error ) {
4735       $dbh->rollback if $oldAutoCommit;
4736       return $error;
4737     }
4738   }
4739
4740   my $cust_pkg = new FS::cust_pkg ( {
4741     'custnum' => $self->custnum,
4742     'pkgpart' => $pkgpart,
4743   } );
4744
4745   $error = $cust_pkg->insert;
4746   if ( $error ) {
4747     $dbh->rollback if $oldAutoCommit;
4748     return $error;
4749   }
4750
4751   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4752   '';
4753
4754 }
4755
4756 =item cust_bill
4757
4758 Returns all the invoices (see L<FS::cust_bill>) for this customer.
4759
4760 =cut
4761
4762 sub cust_bill {
4763   my $self = shift;
4764   sort { $a->_date <=> $b->_date }
4765     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4766 }
4767
4768 =item open_cust_bill
4769
4770 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
4771 customer.
4772
4773 =cut
4774
4775 sub open_cust_bill {
4776   my $self = shift;
4777   grep { $_->owed > 0 } $self->cust_bill;
4778 }
4779
4780 =item cust_credit
4781
4782 Returns all the credits (see L<FS::cust_credit>) for this customer.
4783
4784 =cut
4785
4786 sub cust_credit {
4787   my $self = shift;
4788   sort { $a->_date <=> $b->_date }
4789     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
4790 }
4791
4792 =item cust_pay
4793
4794 Returns all the payments (see L<FS::cust_pay>) for this customer.
4795
4796 =cut
4797
4798 sub cust_pay {
4799   my $self = shift;
4800   sort { $a->_date <=> $b->_date }
4801     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
4802 }
4803
4804 =item cust_pay_void
4805
4806 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
4807
4808 =cut
4809
4810 sub cust_pay_void {
4811   my $self = shift;
4812   sort { $a->_date <=> $b->_date }
4813     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
4814 }
4815
4816 =item cust_pay_batch
4817
4818 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
4819
4820 =cut
4821
4822 sub cust_pay_batch {
4823   my $self = shift;
4824   sort { $a->_date <=> $b->_date }
4825     qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
4826 }
4827
4828 =item cust_refund
4829
4830 Returns all the refunds (see L<FS::cust_refund>) for this customer.
4831
4832 =cut
4833
4834 sub cust_refund {
4835   my $self = shift;
4836   sort { $a->_date <=> $b->_date }
4837     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
4838 }
4839
4840 =item name
4841
4842 Returns a name string for this customer, either "Company (Last, First)" or
4843 "Last, First".
4844
4845 =cut
4846
4847 sub name {
4848   my $self = shift;
4849   my $name = $self->contact;
4850   $name = $self->company. " ($name)" if $self->company;
4851   $name;
4852 }
4853
4854 =item ship_name
4855
4856 Returns a name string for this (service/shipping) contact, either
4857 "Company (Last, First)" or "Last, First".
4858
4859 =cut
4860
4861 sub ship_name {
4862   my $self = shift;
4863   if ( $self->get('ship_last') ) {
4864     my $name = $self->ship_contact;
4865     $name = $self->ship_company. " ($name)" if $self->ship_company;
4866     $name;
4867   } else {
4868     $self->name;
4869   }
4870 }
4871
4872 =item contact
4873
4874 Returns this customer's full (billing) contact name only, "Last, First"
4875
4876 =cut
4877
4878 sub contact {
4879   my $self = shift;
4880   $self->get('last'). ', '. $self->first;
4881 }
4882
4883 =item ship_contact
4884
4885 Returns this customer's full (shipping) contact name only, "Last, First"
4886
4887 =cut
4888
4889 sub ship_contact {
4890   my $self = shift;
4891   $self->get('ship_last')
4892     ? $self->get('ship_last'). ', '. $self->ship_first
4893     : $self->contact;
4894 }
4895
4896 =item country_full
4897
4898 Returns this customer's full country name
4899
4900 =cut
4901
4902 sub country_full {
4903   my $self = shift;
4904   code2country($self->country);
4905 }
4906
4907 =item geocode DATA_VENDOR
4908
4909 Returns a value for the customer location as encoded by DATA_VENDOR.
4910 Currently this only makes sense for "CCH" as DATA_VENDOR.
4911
4912 =cut
4913
4914 sub geocode {
4915   my ($self, $data_vendor) = (shift, shift);  #always cch for now
4916
4917   my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
4918                ? 'ship_'
4919                : '';
4920
4921   my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
4922     if $self->country eq 'US';
4923
4924   #CCH specific location stuff
4925   my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
4926
4927   my $geocode = '';
4928   my $cust_tax_location =
4929     qsearchs( {
4930                 'table'     => 'cust_tax_location',
4931                 'hashref'   => { 'zip' => $zip, 'data_vendor' => $data_vendor },
4932                 'extra_sql' => $extra_sql,
4933               }
4934             );
4935   $geocode = $cust_tax_location->geocode
4936     if $cust_tax_location;
4937
4938   $geocode;
4939 }
4940
4941 =item cust_status
4942
4943 =item status
4944
4945 Returns a status string for this customer, currently:
4946
4947 =over 4
4948
4949 =item prospect - No packages have ever been ordered
4950
4951 =item active - One or more recurring packages is active
4952
4953 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4954
4955 =item suspended - All non-cancelled recurring packages are suspended
4956
4957 =item cancelled - All recurring packages are cancelled
4958
4959 =back
4960
4961 =cut
4962
4963 sub status { shift->cust_status(@_); }
4964
4965 sub cust_status {
4966   my $self = shift;
4967   for my $status (qw( prospect active inactive suspended cancelled )) {
4968     my $method = $status.'_sql';
4969     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4970     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4971     $sth->execute( ($self->custnum) x $numnum )
4972       or die "Error executing 'SELECT $sql': ". $sth->errstr;
4973     return $status if $sth->fetchrow_arrayref->[0];
4974   }
4975 }
4976
4977 =item ucfirst_cust_status
4978
4979 =item ucfirst_status
4980
4981 Returns the status with the first character capitalized.
4982
4983 =cut
4984
4985 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4986
4987 sub ucfirst_cust_status {
4988   my $self = shift;
4989   ucfirst($self->cust_status);
4990 }
4991
4992 =item statuscolor
4993
4994 Returns a hex triplet color string for this customer's status.
4995
4996 =cut
4997
4998 use vars qw(%statuscolor);
4999 tie my %statuscolor, 'Tie::IxHash',
5000   'prospect'  => '7e0079', #'000000', #black?  naw, purple
5001   'active'    => '00CC00', #green
5002   'inactive'  => '0000CC', #blue
5003   'suspended' => 'FF9900', #yellow
5004   'cancelled' => 'FF0000', #red
5005 ;
5006
5007 sub statuscolor { shift->cust_statuscolor(@_); }
5008
5009 sub cust_statuscolor {
5010   my $self = shift;
5011   $statuscolor{$self->cust_status};
5012 }
5013
5014 =item tickets
5015
5016 Returns an array of hashes representing the customer's RT tickets.
5017
5018 =cut
5019
5020 sub tickets {
5021   my $self = shift;
5022
5023   my $num = $conf->config('cust_main-max_tickets') || 10;
5024   my @tickets = ();
5025
5026   unless ( $conf->config('ticket_system-custom_priority_field') ) {
5027
5028     @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
5029
5030   } else {
5031
5032     foreach my $priority (
5033       $conf->config('ticket_system-custom_priority_field-values'), ''
5034     ) {
5035       last if scalar(@tickets) >= $num;
5036       push @tickets,
5037         @{ FS::TicketSystem->customer_tickets( $self->custnum,
5038                                                $num - scalar(@tickets),
5039                                                $priority,
5040                                              )
5041          };
5042     }
5043   }
5044   (@tickets);
5045 }
5046
5047 # Return services representing svc_accts in customer support packages
5048 sub support_services {
5049   my $self = shift;
5050   my %packages = map { $_ => 1 } $conf->config('support_packages');
5051
5052   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
5053     grep { $_->part_svc->svcdb eq 'svc_acct' }
5054     map { $_->cust_svc }
5055     grep { exists $packages{ $_->pkgpart } }
5056     $self->ncancelled_pkgs;
5057
5058 }
5059
5060 =back
5061
5062 =head1 CLASS METHODS
5063
5064 =over 4
5065
5066 =item statuses
5067
5068 Class method that returns the list of possible status strings for customers
5069 (see L<the status method|/status>).  For example:
5070
5071   @statuses = FS::cust_main->statuses();
5072
5073 =cut
5074
5075 sub statuses {
5076   #my $self = shift; #could be class...
5077   keys %statuscolor;
5078 }
5079
5080 =item prospect_sql
5081
5082 Returns an SQL expression identifying prospective cust_main records (customers
5083 with no packages ever ordered)
5084
5085 =cut
5086
5087 use vars qw($select_count_pkgs);
5088 $select_count_pkgs =
5089   "SELECT COUNT(*) FROM cust_pkg
5090     WHERE cust_pkg.custnum = cust_main.custnum";
5091
5092 sub select_count_pkgs_sql {
5093   $select_count_pkgs;
5094 }
5095
5096 sub prospect_sql { "
5097   0 = ( $select_count_pkgs )
5098 "; }
5099
5100 =item active_sql
5101
5102 Returns an SQL expression identifying active cust_main records (customers with
5103 active recurring packages).
5104
5105 =cut
5106
5107 sub active_sql { "
5108   0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
5109       )
5110 "; }
5111
5112 =item inactive_sql
5113
5114 Returns an SQL expression identifying inactive cust_main records (customers with
5115 no active recurring packages, but otherwise unsuspended/uncancelled).
5116
5117 =cut
5118
5119 sub inactive_sql { "
5120   0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
5121   AND
5122   0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
5123 "; }
5124
5125 =item susp_sql
5126 =item suspended_sql
5127
5128 Returns an SQL expression identifying suspended cust_main records.
5129
5130 =cut
5131
5132
5133 sub suspended_sql { susp_sql(@_); }
5134 sub susp_sql { "
5135     0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
5136     AND
5137     0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
5138 "; }
5139
5140 =item cancel_sql
5141 =item cancelled_sql
5142
5143 Returns an SQL expression identifying cancelled cust_main records.
5144
5145 =cut
5146
5147 sub cancelled_sql { cancel_sql(@_); }
5148 sub cancel_sql {
5149
5150   my $recurring_sql = FS::cust_pkg->recurring_sql;
5151   my $cancelled_sql = FS::cust_pkg->cancelled_sql;
5152
5153   "
5154         0 < ( $select_count_pkgs )
5155     AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql   )
5156     AND 0 = ( $select_count_pkgs AND $recurring_sql
5157                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
5158             )
5159   ";
5160
5161 }
5162
5163 =item uncancel_sql
5164 =item uncancelled_sql
5165
5166 Returns an SQL expression identifying un-cancelled cust_main records.
5167
5168 =cut
5169
5170 sub uncancelled_sql { uncancel_sql(@_); }
5171 sub uncancel_sql { "
5172   ( 0 < ( $select_count_pkgs
5173                    AND ( cust_pkg.cancel IS NULL
5174                          OR cust_pkg.cancel = 0
5175                        )
5176         )
5177     OR 0 = ( $select_count_pkgs )
5178   )
5179 "; }
5180
5181 =item balance_sql
5182
5183 Returns an SQL fragment to retreive the balance.
5184
5185 =cut
5186
5187 sub balance_sql { "
5188     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
5189         WHERE cust_bill.custnum   = cust_main.custnum     )
5190   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
5191         WHERE cust_pay.custnum    = cust_main.custnum     )
5192   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
5193         WHERE cust_credit.custnum = cust_main.custnum     )
5194   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
5195         WHERE cust_refund.custnum = cust_main.custnum     )
5196 "; }
5197
5198 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5199
5200 Returns an SQL fragment to retreive the balance for this customer, only
5201 considering invoices with date earlier than START_TIME, and optionally not
5202 later than END_TIME (total_owed_date minus total_credited minus
5203 total_unapplied_payments).
5204
5205 Times are specified as SQL fragments or numeric
5206 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
5207 L<Date::Parse> for conversion functions.  The empty string can be passed
5208 to disable that time constraint completely.
5209
5210 Available options are:
5211
5212 =over 4
5213
5214 =item unapplied_date - set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering)
5215
5216 =item total - set to true to remove all customer comparison clauses, for totals
5217
5218 =item where - WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
5219
5220 =item join - JOIN clause (typically used with the total option)
5221
5222 =item
5223
5224 =back
5225
5226 =cut
5227
5228 sub balance_date_sql {
5229   my( $class, $start, $end, %opt ) = @_;
5230
5231   my $owed         = FS::cust_bill->owed_sql;
5232   my $unapp_refund = FS::cust_refund->unapplied_sql;
5233   my $unapp_credit = FS::cust_credit->unapplied_sql;
5234   my $unapp_pay    = FS::cust_pay->unapplied_sql;
5235
5236   my $j = $opt{'join'} || '';
5237
5238   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
5239   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
5240   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
5241   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
5242
5243   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
5244     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
5245     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
5246     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
5247   ";
5248
5249 }
5250
5251 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5252
5253 Helper method for balance_date_sql; name (and usage) subject to change
5254 (suggestions welcome).
5255
5256 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
5257 cust_refund, cust_credit or cust_pay).
5258
5259 If TABLE is "cust_bill" or the unapplied_date option is true, only
5260 considers records with date earlier than START_TIME, and optionally not
5261 later than END_TIME .
5262
5263 =cut
5264
5265 sub _money_table_where {
5266   my( $class, $table, $start, $end, %opt ) = @_;
5267
5268   my @where = ();
5269   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
5270   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
5271     push @where, "$table._date <= $start" if defined($start) && length($start);
5272     push @where, "$table._date >  $end"   if defined($end)   && length($end);
5273   }
5274   push @where, @{$opt{'where'}} if $opt{'where'};
5275   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5276
5277   $where;
5278
5279 }
5280
5281 =item search_sql HASHREF
5282
5283 (Class method)
5284
5285 Returns a qsearch hash expression to search for parameters specified in HREF.
5286 Valid parameters are
5287
5288 =over 4
5289
5290 =item agentnum
5291
5292 =item status
5293
5294 =item cancelled_pkgs
5295
5296 bool
5297
5298 =item signupdate
5299
5300 listref of start date, end date
5301
5302 =item payby
5303
5304 listref
5305
5306 =item current_balance
5307
5308 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
5309
5310 =item cust_fields
5311
5312 =item flattened_pkgs
5313
5314 bool
5315
5316 =back
5317
5318 =cut
5319
5320 sub search_sql {
5321   my ($class, $params) = @_;
5322
5323   my $dbh = dbh;
5324
5325   my @where = ();
5326   my $orderby;
5327
5328   ##
5329   # parse agent
5330   ##
5331
5332   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
5333     push @where,
5334       "cust_main.agentnum = $1";
5335   }
5336
5337   ##
5338   # parse status
5339   ##
5340
5341   #prospect active inactive suspended cancelled
5342   if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
5343     my $method = $params->{'status'}. '_sql';
5344     #push @where, $class->$method();
5345     push @where, FS::cust_main->$method();
5346   }
5347
5348   ##
5349   # parse cancelled package checkbox
5350   ##
5351
5352   my $pkgwhere = "";
5353
5354   $pkgwhere .= "AND (cancel = 0 or cancel is null)"
5355     unless $params->{'cancelled_pkgs'};
5356
5357   ##
5358   # dates
5359   ##
5360
5361   foreach my $field (qw( signupdate )) {
5362
5363     next unless exists($params->{$field});
5364
5365     my($beginning, $ending) = @{$params->{$field}};
5366
5367     push @where,
5368       "cust_main.$field IS NOT NULL",
5369       "cust_main.$field >= $beginning",
5370       "cust_main.$field <= $ending";
5371
5372     $orderby ||= "ORDER BY cust_main.$field";
5373
5374   }
5375
5376   ###
5377   # payby
5378   ###
5379
5380   my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
5381   if ( @payby ) {
5382     push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
5383   }
5384
5385   ##
5386   # amounts
5387   ##
5388
5389   #my $balance_sql = $class->balance_sql();
5390   my $balance_sql = FS::cust_main->balance_sql();
5391
5392   push @where, map { s/current_balance/$balance_sql/; $_ }
5393                    @{ $params->{'current_balance'} };
5394
5395   ##
5396   # setup queries, subs, etc. for the search
5397   ##
5398
5399   $orderby ||= 'ORDER BY custnum';
5400
5401   # here is the agent virtualization
5402   push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
5403
5404   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
5405
5406   my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum  ) ';
5407
5408   my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
5409
5410   my $select = join(', ',
5411                  'cust_main.custnum',
5412                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
5413                );
5414
5415   my(@extra_headers) = ();
5416   my(@extra_fields)  = ();
5417
5418   if ($params->{'flattened_pkgs'}) {
5419
5420     if ($dbh->{Driver}->{Name} eq 'Pg') {
5421
5422       $select .= ", array_to_string(array(select pkg from cust_pkg left join part_pkg using ( pkgpart ) where cust_main.custnum = cust_pkg.custnum $pkgwhere),'|') as magic";
5423
5424     }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
5425       $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
5426       $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
5427     }else{
5428       warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
5429            "omitting packing information from report.";
5430     }
5431
5432     my $header_query = "SELECT COUNT(cust_pkg.custnum = cust_main.custnum) AS count FROM cust_main $addl_from $extra_sql $pkgwhere group by cust_main.custnum order by count desc limit 1";
5433
5434     my $sth = dbh->prepare($header_query) or die dbh->errstr;
5435     $sth->execute() or die $sth->errstr;
5436     my $headerrow = $sth->fetchrow_arrayref;
5437     my $headercount = $headerrow ? $headerrow->[0] : 0;
5438     while($headercount) {
5439       unshift @extra_headers, "Package ". $headercount;
5440       unshift @extra_fields, eval q!sub {my $c = shift;
5441                                          my @a = split '\|', $c->magic;
5442                                          my $p = $a[!.--$headercount. q!];
5443                                          $p;
5444                                         };!;
5445     }
5446
5447   }
5448
5449   my $sql_query = {
5450     'table'         => 'cust_main',
5451     'select'        => $select,
5452     'hashref'       => {},
5453     'extra_sql'     => $extra_sql,
5454     'order_by'      => $orderby,
5455     'count_query'   => $count_query,
5456     'extra_headers' => \@extra_headers,
5457     'extra_fields'  => \@extra_fields,
5458   };
5459
5460 }
5461
5462 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
5463
5464 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
5465 records.  Currently, I<first>, I<last> and/or I<company> may be specified (the
5466 appropriate ship_ field is also searched).
5467
5468 Additional options are the same as FS::Record::qsearch
5469
5470 =cut
5471
5472 sub fuzzy_search {
5473   my( $self, $fuzzy, $hash, @opt) = @_;
5474   #$self
5475   $hash ||= {};
5476   my @cust_main = ();
5477
5478   check_and_rebuild_fuzzyfiles();
5479   foreach my $field ( keys %$fuzzy ) {
5480
5481     my $all = $self->all_X($field);
5482     next unless scalar(@$all);
5483
5484     my %match = ();
5485     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
5486
5487     my @fcust = ();
5488     foreach ( keys %match ) {
5489       push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
5490       push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
5491     }
5492     my %fsaw = ();
5493     push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
5494   }
5495
5496   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
5497   my %saw = ();
5498   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
5499
5500   @cust_main;
5501
5502 }
5503
5504 =item masked FIELD
5505
5506 Returns a masked version of the named field
5507
5508 =cut
5509
5510 sub masked {
5511 my ($self,$field) = @_;
5512
5513 # Show last four
5514
5515 'x'x(length($self->getfield($field))-4).
5516   substr($self->getfield($field), (length($self->getfield($field))-4));
5517
5518 }
5519
5520 =back
5521
5522 =head1 SUBROUTINES
5523
5524 =over 4
5525
5526 =item smart_search OPTION => VALUE ...
5527
5528 Accepts the following options: I<search>, the string to search for.  The string
5529 will be searched for as a customer number, phone number, name or company name,
5530 as an exact, or, in some cases, a substring or fuzzy match (see the source code
5531 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
5532 skip fuzzy matching when an exact match is found.
5533
5534 Any additional options are treated as an additional qualifier on the search
5535 (i.e. I<agentnum>).
5536
5537 Returns a (possibly empty) array of FS::cust_main objects.
5538
5539 =cut
5540
5541 sub smart_search {
5542   my %options = @_;
5543
5544   #here is the agent virtualization
5545   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
5546
5547   my @cust_main = ();
5548
5549   my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
5550   my $search = delete $options{'search'};
5551   ( my $alphanum_search = $search ) =~ s/\W//g;
5552
5553   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
5554
5555     #false laziness w/Record::ut_phone
5556     my $phonen = "$1-$2-$3";
5557     $phonen .= " x$4" if $4;
5558
5559     push @cust_main, qsearch( {
5560       'table'   => 'cust_main',
5561       'hashref' => { %options },
5562       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
5563                      ' ( '.
5564                          join(' OR ', map "$_ = '$phonen'",
5565                                           qw( daytime night fax
5566                                               ship_daytime ship_night ship_fax )
5567                              ).
5568                      ' ) '.
5569                      " AND $agentnums_sql", #agent virtualization
5570     } );
5571
5572     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
5573       #try looking for matches with extensions unless one was specified
5574
5575       push @cust_main, qsearch( {
5576         'table'   => 'cust_main',
5577         'hashref' => { %options },
5578         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
5579                        ' ( '.
5580                            join(' OR ', map "$_ LIKE '$phonen\%'",
5581                                             qw( daytime night
5582                                                 ship_daytime ship_night )
5583                                ).
5584                        ' ) '.
5585                        " AND $agentnums_sql", #agent virtualization
5586       } );
5587
5588     }
5589
5590   # custnum search (also try agent_custid), with some tweaking options if your
5591   # legacy cust "numbers" have letters
5592   } elsif ( $search =~ /^\s*(\d+)\s*$/
5593             || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
5594                  && $search =~ /^\s*(\w\w?\d+)\s*$/
5595                )
5596           )
5597   {
5598
5599     push @cust_main, qsearch( {
5600       'table'     => 'cust_main',
5601       'hashref'   => { 'custnum' => $1, %options },
5602       'extra_sql' => " AND $agentnums_sql", #agent virtualization
5603     } );
5604
5605     push @cust_main, qsearch( {
5606       'table'     => 'cust_main',
5607       'hashref'   => { 'agent_custid' => $1, %options },
5608       'extra_sql' => " AND $agentnums_sql", #agent virtualization
5609     } );
5610
5611   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
5612
5613     my($company, $last, $first) = ( $1, $2, $3 );
5614
5615     # "Company (Last, First)"
5616     #this is probably something a browser remembered,
5617     #so just do an exact search
5618
5619     foreach my $prefix ( '', 'ship_' ) {
5620       push @cust_main, qsearch( {
5621         'table'     => 'cust_main',
5622         'hashref'   => { $prefix.'first'   => $first,
5623                          $prefix.'last'    => $last,
5624                          $prefix.'company' => $company,
5625                          %options,
5626                        },
5627         'extra_sql' => " AND $agentnums_sql",
5628       } );
5629     }
5630
5631   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
5632                                               # try (ship_){last,company}
5633
5634     my $value = lc($1);
5635
5636     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
5637     # # full strings the browser remembers won't work
5638     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
5639
5640     use Lingua::EN::NameParse;
5641     my $NameParse = new Lingua::EN::NameParse(
5642              auto_clean     => 1,
5643              allow_reversed => 1,
5644     );
5645
5646     my($last, $first) = ( '', '' );
5647     #maybe disable this too and just rely on NameParse?
5648     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
5649
5650       ($last, $first) = ( $1, $2 );
5651
5652     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
5653     } elsif ( ! $NameParse->parse($value) ) {
5654
5655       my %name = $NameParse->components;
5656       $first = $name{'given_name_1'};
5657       $last  = $name{'surname_1'};
5658
5659     }
5660
5661     if ( $first && $last ) {
5662
5663       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
5664
5665       #exact
5666       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
5667       $sql .= "
5668         (     ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
5669            OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
5670         )";
5671
5672       push @cust_main, qsearch( {
5673         'table'     => 'cust_main',
5674         'hashref'   => \%options,
5675         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
5676       } );
5677
5678       # or it just be something that was typed in... (try that in a sec)
5679
5680     }
5681
5682     my $q_value = dbh->quote($value);
5683
5684     #exact
5685     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
5686     $sql .= " (    LOWER(last)         = $q_value
5687                 OR LOWER(company)      = $q_value
5688                 OR LOWER(ship_last)    = $q_value
5689                 OR LOWER(ship_company) = $q_value
5690               )";
5691
5692     push @cust_main, qsearch( {
5693       'table'     => 'cust_main',
5694       'hashref'   => \%options,
5695       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
5696     } );
5697
5698     #no exact match, trying substring/fuzzy
5699     #always do substring & fuzzy (unless they're explicity config'ed off)
5700     #getting complaints searches are not returning enough
5701     unless ( @cust_main  && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
5702
5703       #still some false laziness w/search_sql (was search/cust_main.cgi)
5704
5705       #substring
5706
5707       my @hashrefs = (
5708         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
5709         { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
5710       );
5711
5712       if ( $first && $last ) {
5713
5714         push @hashrefs,
5715           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
5716             'last'         => { op=>'ILIKE', value=>"%$last%" },
5717           },
5718           { 'ship_first'   => { op=>'ILIKE', value=>"%$first%" },
5719             'ship_last'    => { op=>'ILIKE', value=>"%$last%" },
5720           },
5721         ;
5722
5723       } else {
5724
5725         push @hashrefs,
5726           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
5727           { 'ship_last'    => { op=>'ILIKE', value=>"%$value%" }, },
5728         ;
5729       }
5730
5731       foreach my $hashref ( @hashrefs ) {
5732
5733         push @cust_main, qsearch( {
5734           'table'     => 'cust_main',
5735           'hashref'   => { %$hashref,
5736                            %options,
5737                          },
5738           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
5739         } );
5740
5741       }
5742
5743       #fuzzy
5744       my @fuzopts = (
5745         \%options,                #hashref
5746         '',                       #select
5747         " AND $agentnums_sql",    #extra_sql  #agent virtualization
5748       );
5749
5750       if ( $first && $last ) {
5751         push @cust_main, FS::cust_main->fuzzy_search(
5752           { 'last'   => $last,    #fuzzy hashref
5753             'first'  => $first }, #
5754           @fuzopts
5755         );
5756       }
5757       foreach my $field ( 'last', 'company' ) {
5758         push @cust_main,
5759           FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
5760       }
5761
5762     }
5763
5764     #eliminate duplicates
5765     my %saw = ();
5766     @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
5767
5768   }
5769
5770   @cust_main;
5771
5772 }
5773
5774 =item email_search
5775
5776 Accepts the following options: I<email>, the email address to search for.  The
5777 email address will be searched for as an email invoice destination and as an
5778 svc_acct account.
5779
5780 #Any additional options are treated as an additional qualifier on the search
5781 #(i.e. I<agentnum>).
5782
5783 Returns a (possibly empty) array of FS::cust_main objects (but usually just
5784 none or one).
5785
5786 =cut
5787
5788 sub email_search {
5789   my %options = @_;
5790
5791   local($DEBUG) = 1;
5792
5793   my $email = delete $options{'email'};
5794
5795   #we're only being used by RT at the moment... no agent virtualization yet
5796   #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
5797
5798   my @cust_main = ();
5799
5800   if ( $email =~ /([^@]+)\@([^@]+)/ ) {
5801
5802     my ( $user, $domain ) = ( $1, $2 );
5803
5804     warn "$me smart_search: searching for $user in domain $domain"
5805       if $DEBUG;
5806
5807     push @cust_main,
5808       map $_->cust_main,
5809           qsearch( {
5810                      'table'     => 'cust_main_invoice',
5811                      'hashref'   => { 'dest' => $email },
5812                    }
5813                  );
5814
5815     push @cust_main,
5816       map  $_->cust_main,
5817       grep $_,
5818       map  $_->cust_svc->cust_pkg,
5819           qsearch( {
5820                      'table'     => 'svc_acct',
5821                      'hashref'   => { 'username' => $user, },
5822                      'extra_sql' =>
5823                        'AND ( SELECT domain FROM svc_domain
5824                                 WHERE svc_acct.domsvc = svc_domain.svcnum
5825                             ) = '. dbh->quote($domain),
5826                    }
5827                  );
5828   }
5829
5830   my %saw = ();
5831   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
5832
5833   warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
5834     if $DEBUG;
5835
5836   @cust_main;
5837
5838 }
5839
5840 =item check_and_rebuild_fuzzyfiles
5841
5842 =cut
5843
5844 use vars qw(@fuzzyfields);
5845 @fuzzyfields = ( 'last', 'first', 'company' );
5846
5847 sub check_and_rebuild_fuzzyfiles {
5848   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
5849   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
5850 }
5851
5852 =item rebuild_fuzzyfiles
5853
5854 =cut
5855
5856 sub rebuild_fuzzyfiles {
5857
5858   use Fcntl qw(:flock);
5859
5860   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
5861   mkdir $dir, 0700 unless -d $dir;
5862
5863   foreach my $fuzzy ( @fuzzyfields ) {
5864
5865     open(LOCK,">>$dir/cust_main.$fuzzy")
5866       or die "can't open $dir/cust_main.$fuzzy: $!";
5867     flock(LOCK,LOCK_EX)
5868       or die "can't lock $dir/cust_main.$fuzzy: $!";
5869
5870     open (CACHE,">$dir/cust_main.$fuzzy.tmp")
5871       or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
5872
5873     foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
5874       my $sth = dbh->prepare("SELECT $field FROM cust_main".
5875                              " WHERE $field != '' AND $field IS NOT NULL");
5876       $sth->execute or die $sth->errstr;
5877
5878       while ( my $row = $sth->fetchrow_arrayref ) {
5879         print CACHE $row->[0]. "\n";
5880       }
5881
5882     }
5883
5884     close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
5885
5886     rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
5887     close LOCK;
5888   }
5889
5890 }
5891
5892 =item all_X
5893
5894 =cut
5895
5896 sub all_X {
5897   my( $self, $field ) = @_;
5898   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
5899   open(CACHE,"<$dir/cust_main.$field")
5900     or die "can't open $dir/cust_main.$field: $!";
5901   my @array = map { chomp; $_; } <CACHE>;
5902   close CACHE;
5903   \@array;
5904 }
5905
5906 =item append_fuzzyfiles LASTNAME COMPANY
5907
5908 =cut
5909
5910 sub append_fuzzyfiles {
5911   #my( $first, $last, $company ) = @_;
5912
5913   &check_and_rebuild_fuzzyfiles;
5914
5915   use Fcntl qw(:flock);
5916
5917   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
5918
5919   foreach my $field (qw( first last company )) {
5920     my $value = shift;
5921
5922     if ( $value ) {
5923
5924       open(CACHE,">>$dir/cust_main.$field")
5925         or die "can't open $dir/cust_main.$field: $!";
5926       flock(CACHE,LOCK_EX)
5927         or die "can't lock $dir/cust_main.$field: $!";
5928
5929       print CACHE "$value\n";
5930
5931       flock(CACHE,LOCK_UN)
5932         or die "can't unlock $dir/cust_main.$field: $!";
5933       close CACHE;
5934     }
5935
5936   }
5937
5938   1;
5939 }
5940
5941 =item batch_import
5942
5943 =cut
5944
5945 sub batch_import {
5946   my $param = shift;
5947   #warn join('-',keys %$param);
5948   my $fh = $param->{filehandle};
5949   my $agentnum = $param->{agentnum};
5950
5951   my $refnum = $param->{refnum};
5952   my $pkgpart = $param->{pkgpart};
5953
5954   #my @fields = @{$param->{fields}};
5955   my $format = $param->{'format'};
5956   my @fields;
5957   my $payby;
5958   if ( $format eq 'simple' ) {
5959     @fields = qw( cust_pkg.setup dayphone first last
5960                   address1 address2 city state zip comments );
5961     $payby = 'BILL';
5962   } elsif ( $format eq 'extended' ) {
5963     @fields = qw( agent_custid refnum
5964                   last first address1 address2 city state zip country
5965                   daytime night
5966                   ship_last ship_first ship_address1 ship_address2
5967                   ship_city ship_state ship_zip ship_country
5968                   payinfo paycvv paydate
5969                   invoicing_list
5970                   cust_pkg.pkgpart
5971                   svc_acct.username svc_acct._password
5972                 );
5973     $payby = 'BILL';
5974  } elsif ( $format eq 'extended-plus_company' ) {
5975     @fields = qw( agent_custid refnum
5976                   last first company address1 address2 city state zip country
5977                   daytime night
5978                   ship_last ship_first ship_company ship_address1 ship_address2
5979                   ship_city ship_state ship_zip ship_country
5980                   payinfo paycvv paydate
5981                   invoicing_list
5982                   cust_pkg.pkgpart
5983                   svc_acct.username svc_acct._password
5984                 );
5985     $payby = 'BILL';
5986   } else {
5987     die "unknown format $format";
5988   }
5989
5990   eval "use Text::CSV_XS;";
5991   die $@ if $@;
5992
5993   my $csv = new Text::CSV_XS;
5994   #warn $csv;
5995   #warn $fh;
5996
5997   my $imported = 0;
5998   #my $columns;
5999
6000   local $SIG{HUP} = 'IGNORE';
6001   local $SIG{INT} = 'IGNORE';
6002   local $SIG{QUIT} = 'IGNORE';
6003   local $SIG{TERM} = 'IGNORE';
6004   local $SIG{TSTP} = 'IGNORE';
6005   local $SIG{PIPE} = 'IGNORE';
6006
6007   my $oldAutoCommit = $FS::UID::AutoCommit;
6008   local $FS::UID::AutoCommit = 0;
6009   my $dbh = dbh;
6010
6011   #while ( $columns = $csv->getline($fh) ) {
6012   my $line;
6013   while ( defined($line=<$fh>) ) {
6014
6015     $csv->parse($line) or do {
6016       $dbh->rollback if $oldAutoCommit;
6017       return "can't parse: ". $csv->error_input();
6018     };
6019
6020     my @columns = $csv->fields();
6021     #warn join('-',@columns);
6022
6023     my %cust_main = (
6024       agentnum => $agentnum,
6025       refnum   => $refnum,
6026       country  => $conf->config('countrydefault') || 'US',
6027       payby    => $payby, #default
6028       paydate  => '12/2037', #default
6029     );
6030     my $billtime = time;
6031     my %cust_pkg = ( pkgpart => $pkgpart );
6032     my %svc_acct = ();
6033     foreach my $field ( @fields ) {
6034
6035       if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|adjourn|expire|cancel)$/ ) {
6036
6037         #$cust_pkg{$1} = str2time( shift @$columns );
6038         if ( $1 eq 'pkgpart' ) {
6039           $cust_pkg{$1} = shift @columns;
6040         } elsif ( $1 eq 'setup' ) {
6041           $billtime = str2time(shift @columns);
6042         } else {
6043           $cust_pkg{$1} = str2time( shift @columns );
6044         }
6045
6046       } elsif ( $field =~ /^svc_acct\.(username|_password)$/ ) {
6047
6048         $svc_acct{$1} = shift @columns;
6049
6050       } else {
6051
6052         #refnum interception
6053         if ( $field eq 'refnum' && $columns[0] !~ /^\s*(\d+)\s*$/ ) {
6054
6055           my $referral = $columns[0];
6056           my %hash = ( 'referral' => $referral,
6057                        'agentnum' => $agentnum,
6058                        'disabled' => '',
6059                      );
6060
6061           my $part_referral = qsearchs('part_referral', \%hash )
6062                               || new FS::part_referral \%hash;
6063
6064           unless ( $part_referral->refnum ) {
6065             my $error = $part_referral->insert;
6066             if ( $error ) {
6067               $dbh->rollback if $oldAutoCommit;
6068               return "can't auto-insert advertising source: $referral: $error";
6069             }
6070           }
6071
6072           $columns[0] = $part_referral->refnum;
6073         }
6074
6075         #$cust_main{$field} = shift @$columns;
6076         $cust_main{$field} = shift @columns;
6077       }
6078     }
6079
6080     $cust_main{'payby'} = 'CARD' if length($cust_main{'payinfo'});
6081
6082     my $invoicing_list = $cust_main{'invoicing_list'}
6083                            ? [ delete $cust_main{'invoicing_list'} ]
6084                            : [];
6085
6086     my $cust_main = new FS::cust_main ( \%cust_main );
6087
6088     use Tie::RefHash;
6089     tie my %hash, 'Tie::RefHash'; #this part is important
6090
6091     if ( $cust_pkg{'pkgpart'} ) {
6092       my $cust_pkg = new FS::cust_pkg ( \%cust_pkg );
6093
6094       my @svc_acct = ();
6095       if ( $svc_acct{'username'} ) {
6096         my $part_pkg = $cust_pkg->part_pkg;
6097         unless ( $part_pkg ) {
6098           $dbh->rollback if $oldAutoCommit;
6099           return "unknown pkgpart: ". $cust_pkg{'pkgpart'};
6100         }
6101         $svc_acct{svcpart} = $part_pkg->svcpart( 'svc_acct' );
6102         push @svc_acct, new FS::svc_acct ( \%svc_acct )
6103       }
6104
6105       $hash{$cust_pkg} = \@svc_acct;
6106     }
6107
6108     my $error = $cust_main->insert( \%hash, $invoicing_list );
6109
6110     if ( $error ) {
6111       $dbh->rollback if $oldAutoCommit;
6112       return "can't insert customer for $line: $error";
6113     }
6114
6115     if ( $format eq 'simple' ) {
6116
6117       #false laziness w/bill.cgi
6118       $error = $cust_main->bill( 'time' => $billtime );
6119       if ( $error ) {
6120         $dbh->rollback if $oldAutoCommit;
6121         return "can't bill customer for $line: $error";
6122       }
6123
6124       $error = $cust_main->apply_payments_and_credits;
6125       if ( $error ) {
6126         $dbh->rollback if $oldAutoCommit;
6127         return "can't bill customer for $line: $error";
6128       }
6129
6130       $error = $cust_main->collect();
6131       if ( $error ) {
6132         $dbh->rollback if $oldAutoCommit;
6133         return "can't collect customer for $line: $error";
6134       }
6135
6136     }
6137
6138     $imported++;
6139   }
6140
6141   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6142
6143   return "Empty file!" unless $imported;
6144
6145   ''; #no error
6146
6147 }
6148
6149 =item batch_charge
6150
6151 =cut
6152
6153 sub batch_charge {
6154   my $param = shift;
6155   #warn join('-',keys %$param);
6156   my $fh = $param->{filehandle};
6157   my @fields = @{$param->{fields}};
6158
6159   eval "use Text::CSV_XS;";
6160   die $@ if $@;
6161
6162   my $csv = new Text::CSV_XS;
6163   #warn $csv;
6164   #warn $fh;
6165
6166   my $imported = 0;
6167   #my $columns;
6168
6169   local $SIG{HUP} = 'IGNORE';
6170   local $SIG{INT} = 'IGNORE';
6171   local $SIG{QUIT} = 'IGNORE';
6172   local $SIG{TERM} = 'IGNORE';
6173   local $SIG{TSTP} = 'IGNORE';
6174   local $SIG{PIPE} = 'IGNORE';
6175
6176   my $oldAutoCommit = $FS::UID::AutoCommit;
6177   local $FS::UID::AutoCommit = 0;
6178   my $dbh = dbh;
6179
6180   #while ( $columns = $csv->getline($fh) ) {
6181   my $line;
6182   while ( defined($line=<$fh>) ) {
6183
6184     $csv->parse($line) or do {
6185       $dbh->rollback if $oldAutoCommit;
6186       return "can't parse: ". $csv->error_input();
6187     };
6188
6189     my @columns = $csv->fields();
6190     #warn join('-',@columns);
6191
6192     my %row = ();
6193     foreach my $field ( @fields ) {
6194       $row{$field} = shift @columns;
6195     }
6196
6197     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
6198     unless ( $cust_main ) {
6199       $dbh->rollback if $oldAutoCommit;
6200       return "unknown custnum $row{'custnum'}";
6201     }
6202
6203     if ( $row{'amount'} > 0 ) {
6204       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
6205       if ( $error ) {
6206         $dbh->rollback if $oldAutoCommit;
6207         return $error;
6208       }
6209       $imported++;
6210     } elsif ( $row{'amount'} < 0 ) {
6211       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
6212                                       $row{'pkg'}                         );
6213       if ( $error ) {
6214         $dbh->rollback if $oldAutoCommit;
6215         return $error;
6216       }
6217       $imported++;
6218     } else {
6219       #hmm?
6220     }
6221
6222   }
6223
6224   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6225
6226   return "Empty file!" unless $imported;
6227
6228   ''; #no error
6229
6230 }
6231
6232 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
6233
6234 Sends a templated email notification to the customer (see L<Text::Template>).
6235
6236 OPTIONS is a hash and may include
6237
6238 I<from> - the email sender (default is invoice_from)
6239
6240 I<to> - comma-separated scalar or arrayref of recipients
6241    (default is invoicing_list)
6242
6243 I<subject> - The subject line of the sent email notification
6244    (default is "Notice from company_name")
6245
6246 I<extra_fields> - a hashref of name/value pairs which will be substituted
6247    into the template
6248
6249 The following variables are vavailable in the template.
6250
6251 I<$first> - the customer first name
6252 I<$last> - the customer last name
6253 I<$company> - the customer company
6254 I<$payby> - a description of the method of payment for the customer
6255             # would be nice to use FS::payby::shortname
6256 I<$payinfo> - the account information used to collect for this customer
6257 I<$expdate> - the expiration of the customer payment in seconds from epoch
6258
6259 =cut
6260
6261 sub notify {
6262   my ($customer, $template, %options) = @_;
6263
6264   return unless $conf->exists($template);
6265
6266   my $from = $conf->config('invoice_from') if $conf->exists('invoice_from');
6267   $from = $options{from} if exists($options{from});
6268
6269   my $to = join(',', $customer->invoicing_list_emailonly);
6270   $to = $options{to} if exists($options{to});
6271
6272   my $subject = "Notice from " . $conf->config('company_name')
6273     if $conf->exists('company_name');
6274   $subject = $options{subject} if exists($options{subject});
6275
6276   my $notify_template = new Text::Template (TYPE => 'ARRAY',
6277                                             SOURCE => [ map "$_\n",
6278                                               $conf->config($template)]
6279                                            )
6280     or die "can't create new Text::Template object: Text::Template::ERROR";
6281   $notify_template->compile()
6282     or die "can't compile template: Text::Template::ERROR";
6283
6284   $FS::notify_template::_template::company_name = $conf->config('company_name');
6285   $FS::notify_template::_template::company_address =
6286     join("\n", $conf->config('company_address') ). "\n";
6287
6288   my $paydate = $customer->paydate || '2037-12-31';
6289   $FS::notify_template::_template::first = $customer->first;
6290   $FS::notify_template::_template::last = $customer->last;
6291   $FS::notify_template::_template::company = $customer->company;
6292   $FS::notify_template::_template::payinfo = $customer->mask_payinfo;
6293   my $payby = $customer->payby;
6294   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6295   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6296
6297   #credit cards expire at the end of the month/year of their exp date
6298   if ($payby eq 'CARD' || $payby eq 'DCRD') {
6299     $FS::notify_template::_template::payby = 'credit card';
6300     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6301     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6302     $expire_time--;
6303   }elsif ($payby eq 'COMP') {
6304     $FS::notify_template::_template::payby = 'complimentary account';
6305   }else{
6306     $FS::notify_template::_template::payby = 'current method';
6307   }
6308   $FS::notify_template::_template::expdate = $expire_time;
6309
6310   for (keys %{$options{extra_fields}}){
6311     no strict "refs";
6312     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
6313   }
6314
6315   send_email(from => $from,
6316              to => $to,
6317              subject => $subject,
6318              body => $notify_template->fill_in( PACKAGE =>
6319                                                 'FS::notify_template::_template'                                              ),
6320             );
6321
6322 }
6323
6324 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
6325
6326 Generates a templated notification to the customer (see L<Text::Template>).
6327
6328 OPTIONS is a hash and may include
6329
6330 I<extra_fields> - a hashref of name/value pairs which will be substituted
6331    into the template.  These values may override values mentioned below
6332    and those from the customer record.
6333
6334 The following variables are available in the template instead of or in addition
6335 to the fields of the customer record.
6336
6337 I<$payby> - a description of the method of payment for the customer
6338             # would be nice to use FS::payby::shortname
6339 I<$payinfo> - the masked account information used to collect for this customer
6340 I<$expdate> - the expiration of the customer payment method in seconds from epoch
6341 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
6342
6343 =cut
6344
6345 sub generate_letter {
6346   my ($self, $template, %options) = @_;
6347
6348   return unless $conf->exists($template);
6349
6350   my $letter_template = new Text::Template
6351                         ( TYPE       => 'ARRAY',
6352                           SOURCE     => [ map "$_\n", $conf->config($template)],
6353                           DELIMITERS => [ '[@--', '--@]' ],
6354                         )
6355     or die "can't create new Text::Template object: Text::Template::ERROR";
6356
6357   $letter_template->compile()
6358     or die "can't compile template: Text::Template::ERROR";
6359
6360   my %letter_data = map { $_ => $self->$_ } $self->fields;
6361   $letter_data{payinfo} = $self->mask_payinfo;
6362
6363   #my $paydate = $self->paydate || '2037-12-31';
6364   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
6365
6366   my $payby = $self->payby;
6367   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6368   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6369
6370   #credit cards expire at the end of the month/year of their exp date
6371   if ($payby eq 'CARD' || $payby eq 'DCRD') {
6372     $letter_data{payby} = 'credit card';
6373     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6374     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6375     $expire_time--;
6376   }elsif ($payby eq 'COMP') {
6377     $letter_data{payby} = 'complimentary account';
6378   }else{
6379     $letter_data{payby} = 'current method';
6380   }
6381   $letter_data{expdate} = $expire_time;
6382
6383   for (keys %{$options{extra_fields}}){
6384     $letter_data{$_} = $options{extra_fields}->{$_};
6385   }
6386
6387   unless(exists($letter_data{returnaddress})){
6388     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
6389                                                   $self->agent_template)
6390                      );
6391     if ( length($retadd) ) {
6392       $letter_data{returnaddress} = $retadd;
6393     } elsif ( grep /\S/, $conf->config('company_address') ) {
6394       $letter_data{returnaddress} =
6395         join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
6396                           $conf->config('company_address')
6397         );
6398     } else {
6399       $letter_data{returnaddress} = '~';
6400     }
6401   }
6402
6403   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
6404
6405   $letter_data{company_name} = $conf->config('company_name');
6406
6407   my $dir = $FS::UID::conf_dir."cache.". $FS::UID::datasrc;
6408   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
6409                            DIR      => $dir,
6410                            SUFFIX   => '.tex',
6411                            UNLINK   => 0,
6412                          ) or die "can't open temp file: $!\n";
6413
6414   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
6415   close $fh;
6416   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
6417   return $1;
6418 }
6419
6420 =item print_ps TEMPLATE
6421
6422 Returns an postscript letter filled in from TEMPLATE, as a scalar.
6423
6424 =cut
6425
6426 sub print_ps {
6427   my $self = shift;
6428   my $file = $self->generate_letter(@_);
6429   FS::Misc::generate_ps($file);
6430 }
6431
6432 =item print TEMPLATE
6433
6434 Prints the filled in template.
6435
6436 TEMPLATE is the name of a L<Text::Template> to fill in and print.
6437
6438 =cut
6439
6440 sub queueable_print {
6441   my %opt = @_;
6442
6443   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
6444     or die "invalid customer number: " . $opt{custvnum};
6445
6446   my $error = $self->print( $opt{template} );
6447   die $error if $error;
6448 }
6449
6450 sub print {
6451   my ($self, $template) = (shift, shift);
6452   do_print [ $self->print_ps($template) ];
6453 }
6454
6455 sub agent_template {
6456   my $self = shift;
6457   $self->_agent_plandata('agent_templatename');
6458 }
6459
6460 sub agent_invoice_from {
6461   my $self = shift;
6462   $self->_agent_plandata('agent_invoice_from');
6463 }
6464
6465 sub _agent_plandata {
6466   my( $self, $option ) = @_;
6467
6468   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
6469   #agent-specific Conf
6470
6471   use FS::part_event::Condition;
6472
6473   my $agentnum = $self->agentnum;
6474
6475   my $regexp = '';
6476   if ( driver_name =~ /^Pg/i ) {
6477     $regexp = '~';
6478   } elsif ( driver_name =~ /^mysql/i ) {
6479     $regexp = 'REGEXP';
6480   } else {
6481     die "don't know how to use regular expressions in ". driver_name. " databases";
6482   }
6483
6484   my $part_event_option =
6485     qsearchs({
6486       'select'    => 'part_event_option.*',
6487       'table'     => 'part_event_option',
6488       'addl_from' => q{
6489         LEFT JOIN part_event USING ( eventpart )
6490         LEFT JOIN part_event_option AS peo_agentnum
6491           ON ( part_event.eventpart = peo_agentnum.eventpart
6492                AND peo_agentnum.optionname = 'agentnum'
6493                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
6494              )
6495         LEFT JOIN part_event_option AS peo_cust_bill_age
6496           ON ( part_event.eventpart = peo_cust_bill_age.eventpart
6497                AND peo_cust_bill_age.optionname = 'cust_bill_age'
6498              )
6499       },
6500       #'hashref'   => { 'optionname' => $option },
6501       #'hashref'   => { 'part_event_option.optionname' => $option },
6502       'extra_sql' =>
6503         " WHERE part_event_option.optionname = ". dbh->quote($option).
6504         " AND action = 'cust_bill_send_agent' ".
6505         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
6506         " AND peo_agentnum.optionname = 'agentnum' ".
6507         " AND agentnum IS NULL OR agentnum = $agentnum ".
6508         " ORDER BY
6509            CASE WHEN peo_cust_bill_age.optionname != 'cust_bill_age'
6510            THEN -1
6511            ELSE ". FS::part_event::Condition->age2seconds_sql('peo_cust_bill_age.optionvalue').
6512         " END
6513           , part_event.weight".
6514         " LIMIT 1"
6515     });
6516
6517   unless ( $part_event_option ) {
6518     return $self->agent->invoice_template || ''
6519       if $option eq 'agent_templatename';
6520     return '';
6521   }
6522
6523   $part_event_option->optionvalue;
6524
6525 }
6526
6527 sub queued_bill {
6528   ## actual sub, not a method, designed to be called from the queue.
6529   ## sets up the customer, and calls the bill_and_collect
6530   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
6531   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
6532       $cust_main->bill_and_collect(
6533         %args,
6534       );
6535 }
6536
6537 =back
6538
6539 =head1 BUGS
6540
6541 The delete method.
6542
6543 The delete method should possibly take an FS::cust_main object reference
6544 instead of a scalar customer number.
6545
6546 Bill and collect options should probably be passed as references instead of a
6547 list.
6548
6549 There should probably be a configuration file with a list of allowed credit
6550 card types.
6551
6552 No multiple currency support (probably a larger project than just this module).
6553
6554 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
6555
6556 Birthdates rely on negative epoch values.
6557
6558 The payby for card/check batches is broken.  With mixed batching, bad
6559 things will happen.
6560
6561 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
6562
6563 =head1 SEE ALSO
6564
6565 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
6566 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
6567 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
6568
6569 =cut
6570
6571 1;
6572