FS/FS/cust_main.pm

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