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