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