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