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