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