FS/FS/cust_main.pm

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