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