FS/FS/cust_main.pm

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