FS/FS/cust_main.pm

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