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