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