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/',
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     my $cpp_done_err = $cust_pay_pending->replace;
3851
3852     if ( $cpp_done_err ) {
3853
3854       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
3855       my $e = "WARNING: $method captured but payment not recorded - ".
3856               "error updating status for paypendingnum ".
3857               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3858       warn $e;
3859       return $e;
3860
3861     } else {
3862
3863       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3864       return ''; #no error
3865
3866     }
3867
3868   } else {
3869
3870     my $perror = "$processor error: ". $transaction->error_message;
3871
3872     unless ( $transaction->error_message ) {
3873
3874       my $t_response;
3875       if ( $transaction->can('response_page') ) {
3876         $t_response = {
3877                         'page'    => ( $transaction->can('response_page')
3878                                          ? $transaction->response_page
3879                                          : ''
3880                                      ),
3881                         'code'    => ( $transaction->can('response_code')
3882                                          ? $transaction->response_code
3883                                          : ''
3884                                      ),
3885                         'headers' => ( $transaction->can('response_headers')
3886                                          ? $transaction->response_headers
3887                                          : ''
3888                                      ),
3889                       };
3890       } else {
3891         $t_response .=
3892           "No additional debugging information available for $processor";
3893       }
3894
3895       $perror .= "No error_message returned from $processor -- ".
3896                  ( ref($t_response) ? Dumper($t_response) : $t_response );
3897
3898     }
3899
3900     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
3901          && $conf->exists('emaildecline')
3902          && grep { $_ ne 'POST' } $self->invoicing_list
3903          && ! grep { $transaction->error_message =~ /$_/ }
3904                    $conf->config('emaildecline-exclude')
3905     ) {
3906       my @templ = $conf->config('declinetemplate');
3907       my $template = new Text::Template (
3908         TYPE   => 'ARRAY',
3909         SOURCE => [ map "$_\n", @templ ],
3910       ) or return "($perror) can't create template: $Text::Template::ERROR";
3911       $template->compile()
3912         or return "($perror) can't compile template: $Text::Template::ERROR";
3913
3914       my $templ_hash = { error => $transaction->error_message };
3915
3916       my $error = send_email(
3917         'from'    => $conf->config('invoice_from', $self->agentnum ),
3918         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
3919         'subject' => 'Your payment could not be processed',
3920         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
3921       );
3922
3923       $perror .= " (also received error sending decline notification: $error)"
3924         if $error;
3925
3926     }
3927
3928     $cust_pay_pending->status('done');
3929     $cust_pay_pending->statustext("declined: $perror");
3930     my $cpp_done_err = $cust_pay_pending->replace;
3931     if ( $cpp_done_err ) {
3932       my $e = "WARNING: $method declined but pending payment not resolved - ".
3933               "error updating status for paypendingnum ".
3934               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3935       warn $e;
3936       $perror = "$e ($perror)";
3937     }
3938
3939     return $perror;
3940   }
3941
3942 }
3943
3944 =item fake_bop
3945
3946 =cut
3947
3948 sub fake_bop {
3949   my( $self, $method, $amount, %options ) = @_;
3950
3951   if ( $options{'fake_failure'} ) {
3952      return "Error: No error; test failure requested with fake_failure";
3953   }
3954
3955   my %method2payby = (
3956     'CC'     => 'CARD',
3957     'ECHECK' => 'CHEK',
3958     'LEC'    => 'LECB',
3959   );
3960
3961   #my $paybatch = '';
3962   #if ( $payment_gateway ) { # agent override
3963   #  $paybatch = $payment_gateway->gatewaynum. '-';
3964   #}
3965   #
3966   #$paybatch .= "$processor:". $transaction->authorization;
3967   #
3968   #$paybatch .= ':'. $transaction->order_number
3969   #  if $transaction->can('order_number')
3970   #  && length($transaction->order_number);
3971
3972   my $paybatch = 'FakeProcessor:54:32';
3973
3974   my $cust_pay = new FS::cust_pay ( {
3975      'custnum'  => $self->custnum,
3976      'invnum'   => $options{'invnum'},
3977      'paid'     => $amount,
3978      '_date'    => '',
3979      'payby'    => $method2payby{$method},
3980      #'payinfo'  => $payinfo,
3981      'payinfo'  => '4111111111111111',
3982      'paybatch' => $paybatch,
3983      #'paydate'  => $paydate,
3984      'paydate'  => '2012-05-01',
3985   } );
3986   $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
3987
3988   my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3989
3990   if ( $error ) {
3991     $cust_pay->invnum(''); #try again with no specific invnum
3992     my $error2 = $cust_pay->insert( $options{'manual'} ?
3993                                     ( 'manual' => 1 ) : ()
3994                                   );
3995     if ( $error2 ) {
3996       # gah, even with transactions.
3997       my $e = 'WARNING: Card/ACH debited but database not updated - '.
3998               "error inserting (fake!) payment: $error2".
3999               " (previously tried insert with invnum #$options{'invnum'}" .
4000               ": $error )";
4001       warn $e;
4002       return $e;
4003     }
4004   }
4005
4006   if ( $options{'paynum_ref'} ) {
4007     ${ $options{'paynum_ref'} } = $cust_pay->paynum;
4008   }
4009
4010   return ''; #no error
4011
4012 }
4013
4014 =item default_payment_gateway
4015
4016 =cut
4017
4018 sub default_payment_gateway {
4019   my( $self, $method ) = @_;
4020
4021   die "Real-time processing not enabled\n"
4022     unless $conf->exists('business-onlinepayment');
4023
4024   #load up config
4025   my $bop_config = 'business-onlinepayment';
4026   $bop_config .= '-ach'
4027     if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
4028   my ( $processor, $login, $password, $action, @bop_options ) =
4029     $conf->config($bop_config);
4030   $action ||= 'normal authorization';
4031   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
4032   die "No real-time processor is enabled - ".
4033       "did you set the business-onlinepayment configuration value?\n"
4034     unless $processor;
4035
4036   ( $processor, $login, $password, $action, @bop_options )
4037 }
4038
4039 =item remove_cvv
4040
4041 Removes the I<paycvv> field from the database directly.
4042
4043 If there is an error, returns the error, otherwise returns false.
4044
4045 =cut
4046
4047 sub remove_cvv {
4048   my $self = shift;
4049   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
4050     or return dbh->errstr;
4051   $sth->execute($self->custnum)
4052     or return $sth->errstr;
4053   $self->paycvv('');
4054   '';
4055 }
4056
4057 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
4058
4059 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
4060 via a Business::OnlinePayment realtime gateway.  See
4061 L<http://420.am/business-onlinepayment> for supported gateways.
4062
4063 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4064
4065 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
4066
4067 Most gateways require a reference to an original payment transaction to refund,
4068 so you probably need to specify a I<paynum>.
4069
4070 I<amount> defaults to the original amount of the payment if not specified.
4071
4072 I<reason> specifies a reason for the refund.
4073
4074 I<paydate> specifies the expiration date for a credit card overriding the
4075 value from the customer record or the payment record. Specified as yyyy-mm-dd
4076
4077 Implementation note: If I<amount> is unspecified or equal to the amount of the
4078 orignal payment, first an attempt is made to "void" the transaction via
4079 the gateway (to cancel a not-yet settled transaction) and then if that fails,
4080 the normal attempt is made to "refund" ("credit") the transaction via the
4081 gateway is attempted.
4082
4083 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4084 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
4085 #if set, will override the value from the customer record.
4086
4087 #If an I<invnum> is specified, this payment (if successful) is applied to the
4088 #specified invoice.  If you don't specify an I<invnum> you might want to
4089 #call the B<apply_payments> method.
4090
4091 =cut
4092
4093 #some false laziness w/realtime_bop, not enough to make it worth merging
4094 #but some useful small subs should be pulled out
4095 sub realtime_refund_bop {
4096   my( $self, $method, %options ) = @_;
4097   if ( $DEBUG ) {
4098     warn "$me realtime_refund_bop: $method refund\n";
4099     warn "  $_ => $options{$_}\n" foreach keys %options;
4100   }
4101
4102   eval "use Business::OnlinePayment";
4103   die $@ if $@;
4104
4105   ###
4106   # look up the original payment and optionally a gateway for that payment
4107   ###
4108
4109   my $cust_pay = '';
4110   my $amount = $options{'amount'};
4111
4112   my( $processor, $login, $password, @bop_options ) ;
4113   my( $auth, $order_number ) = ( '', '', '' );
4114
4115   if ( $options{'paynum'} ) {
4116
4117     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
4118     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
4119       or return "Unknown paynum $options{'paynum'}";
4120     $amount ||= $cust_pay->paid;
4121
4122     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
4123       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
4124                 $cust_pay->paybatch;
4125     my $gatewaynum = '';
4126     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
4127
4128     if ( $gatewaynum ) { #gateway for the payment to be refunded
4129
4130       my $payment_gateway =
4131         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
4132       die "payment gateway $gatewaynum not found"
4133         unless $payment_gateway;
4134
4135       $processor   = $payment_gateway->gateway_module;
4136       $login       = $payment_gateway->gateway_username;
4137       $password    = $payment_gateway->gateway_password;
4138       @bop_options = $payment_gateway->options;
4139
4140     } else { #try the default gateway
4141
4142       my( $conf_processor, $unused_action );
4143       ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
4144         $self->default_payment_gateway($method);
4145
4146       return "processor of payment $options{'paynum'} $processor does not".
4147              " match default processor $conf_processor"
4148         unless $processor eq $conf_processor;
4149
4150     }
4151
4152
4153   } else { # didn't specify a paynum, so look for agent gateway overrides
4154            # like a normal transaction
4155
4156     my $cardtype;
4157     if ( $method eq 'CC' ) {
4158       $cardtype = cardtype($self->payinfo);
4159     } elsif ( $method eq 'ECHECK' ) {
4160       $cardtype = 'ACH';
4161     } else {
4162       $cardtype = $method;
4163     }
4164     my $override =
4165            qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4166                                                cardtype => $cardtype,
4167                                                taxclass => '',              } )
4168         || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4169                                                cardtype => '',
4170                                                taxclass => '',              } );
4171
4172     if ( $override ) { #use a payment gateway override
4173
4174       my $payment_gateway = $override->payment_gateway;
4175
4176       $processor   = $payment_gateway->gateway_module;
4177       $login       = $payment_gateway->gateway_username;
4178       $password    = $payment_gateway->gateway_password;
4179       #$action      = $payment_gateway->gateway_action;
4180       @bop_options = $payment_gateway->options;
4181
4182     } else { #use the standard settings from the config
4183
4184       my $unused_action;
4185       ( $processor, $login, $password, $unused_action, @bop_options ) =
4186         $self->default_payment_gateway($method);
4187
4188     }
4189
4190   }
4191   return "neither amount nor paynum specified" unless $amount;
4192
4193   my %content = (
4194     'type'           => $method,
4195     'login'          => $login,
4196     'password'       => $password,
4197     'order_number'   => $order_number,
4198     'amount'         => $amount,
4199     'referer'        => 'http://cleanwhisker.420.am/',
4200   );
4201   $content{authorization} = $auth
4202     if length($auth); #echeck/ACH transactions have an order # but no auth
4203                       #(at least with authorize.net)
4204
4205   my $disable_void_after;
4206   if ($conf->exists('disable_void_after')
4207       && $conf->config('disable_void_after') =~ /^(\d+)$/) {
4208     $disable_void_after = $1;
4209   }
4210
4211   #first try void if applicable
4212   if ( $cust_pay && $cust_pay->paid == $amount
4213     && (
4214       ( not defined($disable_void_after) )
4215       || ( time < ($cust_pay->_date + $disable_void_after ) )
4216     )
4217   ) {
4218     warn "  attempting void\n" if $DEBUG > 1;
4219     my $void = new Business::OnlinePayment( $processor, @bop_options );
4220     $void->content( 'action' => 'void', %content );
4221     $void->submit();
4222     if ( $void->is_success ) {
4223       my $error = $cust_pay->void($options{'reason'});
4224       if ( $error ) {
4225         # gah, even with transactions.
4226         my $e = 'WARNING: Card/ACH voided but database not updated - '.
4227                 "error voiding payment: $error";
4228         warn $e;
4229         return $e;
4230       }
4231       warn "  void successful\n" if $DEBUG > 1;
4232       return '';
4233     }
4234   }
4235
4236   warn "  void unsuccessful, trying refund\n"
4237     if $DEBUG > 1;
4238
4239   #massage data
4240   my $address = $self->address1;
4241   $address .= ", ". $self->address2 if $self->address2;
4242
4243   my($payname, $payfirst, $paylast);
4244   if ( $self->payname && $method ne 'ECHECK' ) {
4245     $payname = $self->payname;
4246     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4247       or return "Illegal payname $payname";
4248     ($payfirst, $paylast) = ($1, $2);
4249   } else {
4250     $payfirst = $self->getfield('first');
4251     $paylast = $self->getfield('last');
4252     $payname =  "$payfirst $paylast";
4253   }
4254
4255   my @invoicing_list = $self->invoicing_list_emailonly;
4256   if ( $conf->exists('emailinvoiceautoalways')
4257        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4258        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4259     push @invoicing_list, $self->all_emails;
4260   }
4261
4262   my $email = ($conf->exists('business-onlinepayment-email-override'))
4263               ? $conf->config('business-onlinepayment-email-override')
4264               : $invoicing_list[0];
4265
4266   my $payip = exists($options{'payip'})
4267                 ? $options{'payip'}
4268                 : $self->payip;
4269   $content{customer_ip} = $payip
4270     if length($payip);
4271
4272   my $payinfo = '';
4273   if ( $method eq 'CC' ) {
4274
4275     if ( $cust_pay ) {
4276       $content{card_number} = $payinfo = $cust_pay->payinfo;
4277       (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
4278         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4279         ($content{expiration} = "$2/$1");  # where available
4280     } else {
4281       $content{card_number} = $payinfo = $self->payinfo;
4282       (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4283         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4284       $content{expiration} = "$2/$1";
4285     }
4286
4287   } elsif ( $method eq 'ECHECK' ) {
4288
4289     if ( $cust_pay ) {
4290       $payinfo = $cust_pay->payinfo;
4291     } else {
4292       $payinfo = $self->payinfo;
4293     }
4294     ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4295     $content{bank_name} = $self->payname;
4296     $content{account_type} = 'CHECKING';
4297     $content{account_name} = $payname;
4298     $content{customer_org} = $self->company ? 'B' : 'I';
4299     $content{customer_ssn} = $self->ss;
4300   } elsif ( $method eq 'LEC' ) {
4301     $content{phone} = $payinfo = $self->payinfo;
4302   }
4303
4304   #then try refund
4305   my $refund = new Business::OnlinePayment( $processor, @bop_options );
4306   my %sub_content = $refund->content(
4307     'action'         => 'credit',
4308     'customer_id'    => $self->custnum,
4309     'last_name'      => $paylast,
4310     'first_name'     => $payfirst,
4311     'name'           => $payname,
4312     'address'        => $address,
4313     'city'           => $self->city,
4314     'state'          => $self->state,
4315     'zip'            => $self->zip,
4316     'country'        => $self->country,
4317     'email'          => $email,
4318     'phone'          => $self->daytime || $self->night,
4319     %content, #after
4320   );
4321   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
4322     if $DEBUG > 1;
4323   $refund->submit();
4324
4325   return "$processor error: ". $refund->error_message
4326     unless $refund->is_success();
4327
4328   my %method2payby = (
4329     'CC'     => 'CARD',
4330     'ECHECK' => 'CHEK',
4331     'LEC'    => 'LECB',
4332   );
4333
4334   my $paybatch = "$processor:". $refund->authorization;
4335   $paybatch .= ':'. $refund->order_number
4336     if $refund->can('order_number') && $refund->order_number;
4337
4338   while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4339     my @cust_bill_pay = $cust_pay->cust_bill_pay;
4340     last unless @cust_bill_pay;
4341     my $cust_bill_pay = pop @cust_bill_pay;
4342     my $error = $cust_bill_pay->delete;
4343     last if $error;
4344   }
4345
4346   my $cust_refund = new FS::cust_refund ( {
4347     'custnum'  => $self->custnum,
4348     'paynum'   => $options{'paynum'},
4349     'refund'   => $amount,
4350     '_date'    => '',
4351     'payby'    => $method2payby{$method},
4352     'payinfo'  => $payinfo,
4353     'paybatch' => $paybatch,
4354     'reason'   => $options{'reason'} || 'card or ACH refund',
4355   } );
4356   my $error = $cust_refund->insert;
4357   if ( $error ) {
4358     $cust_refund->paynum(''); #try again with no specific paynum
4359     my $error2 = $cust_refund->insert;
4360     if ( $error2 ) {
4361       # gah, even with transactions.
4362       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4363               "error inserting refund ($processor): $error2".
4364               " (previously tried insert with paynum #$options{'paynum'}" .
4365               ": $error )";
4366       warn $e;
4367       return $e;
4368     }
4369   }
4370
4371   ''; #no error
4372
4373 }
4374
4375 =item batch_card OPTION => VALUE...
4376
4377 Adds a payment for this invoice to the pending credit card batch (see
4378 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
4379 runs the payment using a realtime gateway.
4380
4381 =cut
4382
4383 sub batch_card {
4384   my ($self, %options) = @_;
4385
4386   my $amount;
4387   if (exists($options{amount})) {
4388     $amount = $options{amount};
4389   }else{
4390     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
4391   }
4392   return '' unless $amount > 0;
4393
4394   my $invnum = delete $options{invnum};
4395   my $payby = $options{invnum} || $self->payby;  #dubious
4396
4397   if ($options{'realtime'}) {
4398     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
4399                                 $amount,
4400                                 %options,
4401                               );
4402   }
4403
4404   my $oldAutoCommit = $FS::UID::AutoCommit;
4405   local $FS::UID::AutoCommit = 0;
4406   my $dbh = dbh;
4407
4408   #this needs to handle mysql as well as Pg, like svc_acct.pm
4409   #(make it into a common function if folks need to do batching with mysql)
4410   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
4411     or return "Cannot lock pay_batch: " . $dbh->errstr;
4412
4413   my %pay_batch = (
4414     'status' => 'O',
4415     'payby'  => FS::payby->payby2payment($payby),
4416   );
4417
4418   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
4419
4420   unless ( $pay_batch ) {
4421     $pay_batch = new FS::pay_batch \%pay_batch;
4422     my $error = $pay_batch->insert;
4423     if ( $error ) {
4424       $dbh->rollback if $oldAutoCommit;
4425       die "error creating new batch: $error\n";
4426     }
4427   }
4428
4429   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
4430       'batchnum' => $pay_batch->batchnum,
4431       'custnum'  => $self->custnum,
4432   } );
4433
4434   foreach (qw( address1 address2 city state zip country payby payinfo paydate
4435                payname )) {
4436     $options{$_} = '' unless exists($options{$_});
4437   }
4438
4439   my $cust_pay_batch = new FS::cust_pay_batch ( {
4440     'batchnum' => $pay_batch->batchnum,
4441     'invnum'   => $invnum || 0,                    # is there a better value?
4442                                                    # this field should be
4443                                                    # removed...
4444                                                    # cust_bill_pay_batch now
4445     'custnum'  => $self->custnum,
4446     'last'     => $self->getfield('last'),
4447     'first'    => $self->getfield('first'),
4448     'address1' => $options{address1} || $self->address1,
4449     'address2' => $options{address2} || $self->address2,
4450     'city'     => $options{city}     || $self->city,
4451     'state'    => $options{state}    || $self->state,
4452     'zip'      => $options{zip}      || $self->zip,
4453     'country'  => $options{country}  || $self->country,
4454     'payby'    => $options{payby}    || $self->payby,
4455     'payinfo'  => $options{payinfo}  || $self->payinfo,
4456     'exp'      => $options{paydate}  || $self->paydate,
4457     'payname'  => $options{payname}  || $self->payname,
4458     'amount'   => $amount,                         # consolidating
4459   } );
4460
4461   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
4462     if $old_cust_pay_batch;
4463
4464   my $error;
4465   if ($old_cust_pay_batch) {
4466     $error = $cust_pay_batch->replace($old_cust_pay_batch)
4467   } else {
4468     $error = $cust_pay_batch->insert;
4469   }
4470
4471   if ( $error ) {
4472     $dbh->rollback if $oldAutoCommit;
4473     die $error;
4474   }
4475
4476   my $unapplied =   $self->total_unapplied_credits
4477                   + $self->total_unapplied_payments
4478                   + $self->in_transit_payments;
4479   foreach my $cust_bill ($self->open_cust_bill) {
4480     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
4481     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
4482       'invnum' => $cust_bill->invnum,
4483       'paybatchnum' => $cust_pay_batch->paybatchnum,
4484       'amount' => $cust_bill->owed,
4485       '_date' => time,
4486     };
4487     if ($unapplied >= $cust_bill_pay_batch->amount){
4488       $unapplied -= $cust_bill_pay_batch->amount;
4489       next;
4490     }else{
4491       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
4492                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
4493     }
4494     $error = $cust_bill_pay_batch->insert;
4495     if ( $error ) {
4496       $dbh->rollback if $oldAutoCommit;
4497       die $error;
4498     }
4499   }
4500
4501   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4502   '';
4503 }
4504
4505 =item apply_payments_and_credits
4506
4507 Applies unapplied payments and credits.
4508
4509 In most cases, this new method should be used in place of sequential
4510 apply_payments and apply_credits methods.
4511
4512 If there is an error, returns the error, otherwise returns false.
4513
4514 =cut
4515
4516 sub apply_payments_and_credits {
4517   my $self = shift;
4518
4519   local $SIG{HUP} = 'IGNORE';
4520   local $SIG{INT} = 'IGNORE';
4521   local $SIG{QUIT} = 'IGNORE';
4522   local $SIG{TERM} = 'IGNORE';
4523   local $SIG{TSTP} = 'IGNORE';
4524   local $SIG{PIPE} = 'IGNORE';
4525
4526   my $oldAutoCommit = $FS::UID::AutoCommit;
4527   local $FS::UID::AutoCommit = 0;
4528   my $dbh = dbh;
4529
4530   $self->select_for_update; #mutex
4531
4532   foreach my $cust_bill ( $self->open_cust_bill ) {
4533     my $error = $cust_bill->apply_payments_and_credits;
4534     if ( $error ) {
4535       $dbh->rollback if $oldAutoCommit;
4536       return "Error applying: $error";
4537     }
4538   }
4539
4540   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4541   ''; #no error
4542
4543 }
4544
4545 =item apply_credits OPTION => VALUE ...
4546
4547 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
4548 to outstanding invoice balances in chronological order (or reverse
4549 chronological order if the I<order> option is set to B<newest>) and returns the
4550 value of any remaining unapplied credits available for refund (see
4551 L<FS::cust_refund>).
4552
4553 Dies if there is an error.
4554
4555 =cut
4556
4557 sub apply_credits {
4558   my $self = shift;
4559   my %opt = @_;
4560
4561   local $SIG{HUP} = 'IGNORE';
4562   local $SIG{INT} = 'IGNORE';
4563   local $SIG{QUIT} = 'IGNORE';
4564   local $SIG{TERM} = 'IGNORE';
4565   local $SIG{TSTP} = 'IGNORE';
4566   local $SIG{PIPE} = 'IGNORE';
4567
4568   my $oldAutoCommit = $FS::UID::AutoCommit;
4569   local $FS::UID::AutoCommit = 0;
4570   my $dbh = dbh;
4571
4572   $self->select_for_update; #mutex
4573
4574   unless ( $self->total_unapplied_credits ) {
4575     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4576     return 0;
4577   }
4578
4579   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
4580       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
4581
4582   my @invoices = $self->open_cust_bill;
4583   @invoices = sort { $b->_date <=> $a->_date } @invoices
4584     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
4585
4586   my $credit;
4587   foreach my $cust_bill ( @invoices ) {
4588     my $amount;
4589
4590     if ( !defined($credit) || $credit->credited == 0) {
4591       $credit = pop @credits or last;
4592     }
4593
4594     if ($cust_bill->owed >= $credit->credited) {
4595       $amount=$credit->credited;
4596     }else{
4597       $amount=$cust_bill->owed;
4598     }
4599
4600     my $cust_credit_bill = new FS::cust_credit_bill ( {
4601       'crednum' => $credit->crednum,
4602       'invnum'  => $cust_bill->invnum,
4603       'amount'  => $amount,
4604     } );
4605     my $error = $cust_credit_bill->insert;
4606     if ( $error ) {
4607       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4608       die $error;
4609     }
4610
4611     redo if ($cust_bill->owed > 0);
4612
4613   }
4614
4615   my $total_unapplied_credits = $self->total_unapplied_credits;
4616
4617   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4618
4619   return $total_unapplied_credits;
4620 }
4621
4622 =item apply_payments
4623
4624 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
4625 to outstanding invoice balances in chronological order.
4626
4627  #and returns the value of any remaining unapplied payments.
4628
4629 Dies if there is an error.
4630
4631 =cut
4632
4633 sub apply_payments {
4634   my $self = shift;
4635
4636   local $SIG{HUP} = 'IGNORE';
4637   local $SIG{INT} = 'IGNORE';
4638   local $SIG{QUIT} = 'IGNORE';
4639   local $SIG{TERM} = 'IGNORE';
4640   local $SIG{TSTP} = 'IGNORE';
4641   local $SIG{PIPE} = 'IGNORE';
4642
4643   my $oldAutoCommit = $FS::UID::AutoCommit;
4644   local $FS::UID::AutoCommit = 0;
4645   my $dbh = dbh;
4646
4647   $self->select_for_update; #mutex
4648
4649   #return 0 unless
4650
4651   my @payments = sort { $b->_date <=> $a->_date }
4652                  grep { $_->unapplied > 0 }
4653                  $self->cust_pay;
4654
4655   my @invoices = sort { $a->_date <=> $b->_date}
4656                  grep { $_->owed > 0 }
4657                  $self->cust_bill;
4658
4659   my $payment;
4660
4661   foreach my $cust_bill ( @invoices ) {
4662     my $amount;
4663
4664     if ( !defined($payment) || $payment->unapplied == 0 ) {
4665       $payment = pop @payments or last;
4666     }
4667
4668     if ( $cust_bill->owed >= $payment->unapplied ) {
4669       $amount = $payment->unapplied;
4670     } else {
4671       $amount = $cust_bill->owed;
4672     }
4673
4674     my $cust_bill_pay = new FS::cust_bill_pay ( {
4675       'paynum' => $payment->paynum,
4676       'invnum' => $cust_bill->invnum,
4677       'amount' => $amount,
4678     } );
4679     my $error = $cust_bill_pay->insert;
4680     if ( $error ) {
4681       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4682       die $error;
4683     }
4684
4685     redo if ( $cust_bill->owed > 0);
4686
4687   }
4688
4689   my $total_unapplied_payments = $self->total_unapplied_payments;
4690
4691   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4692
4693   return $total_unapplied_payments;
4694 }
4695
4696 =item total_owed
4697
4698 Returns the total owed for this customer on all invoices
4699 (see L<FS::cust_bill/owed>).
4700
4701 =cut
4702
4703 sub total_owed {
4704   my $self = shift;
4705   $self->total_owed_date(2145859200); #12/31/2037
4706 }
4707
4708 =item total_owed_date TIME
4709
4710 Returns the total owed for this customer on all invoices with date earlier than
4711 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
4712 see L<Time::Local> and L<Date::Parse> for conversion functions.
4713
4714 =cut
4715
4716 sub total_owed_date {
4717   my $self = shift;
4718   my $time = shift;
4719   my $total_bill = 0;
4720   foreach my $cust_bill (
4721     grep { $_->_date <= $time }
4722       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4723   ) {
4724     $total_bill += $cust_bill->owed;
4725   }
4726   sprintf( "%.2f", $total_bill );
4727 }
4728
4729 =item total_paid
4730
4731 Returns the total amount of all payments.
4732
4733 =cut
4734
4735 sub total_paid {
4736   my $self = shift;
4737   my $total = 0;
4738   $total += $_->paid foreach $self->cust_pay;
4739   sprintf( "%.2f", $total );
4740 }
4741
4742 =item total_unapplied_credits
4743
4744 Returns the total outstanding credit (see L<FS::cust_credit>) for this
4745 customer.  See L<FS::cust_credit/credited>.
4746
4747 =item total_credited
4748
4749 Old name for total_unapplied_credits.  Don't use.
4750
4751 =cut
4752
4753 sub total_credited {
4754   #carp "total_credited deprecated, use total_unapplied_credits";
4755   shift->total_unapplied_credits(@_);
4756 }
4757
4758 sub total_unapplied_credits {
4759   my $self = shift;
4760   my $total_credit = 0;
4761   $total_credit += $_->credited foreach $self->cust_credit;
4762   sprintf( "%.2f", $total_credit );
4763 }
4764
4765 =item total_unapplied_payments
4766
4767 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
4768 See L<FS::cust_pay/unapplied>.
4769
4770 =cut
4771
4772 sub total_unapplied_payments {
4773   my $self = shift;
4774   my $total_unapplied = 0;
4775   $total_unapplied += $_->unapplied foreach $self->cust_pay;
4776   sprintf( "%.2f", $total_unapplied );
4777 }
4778
4779 =item total_unapplied_refunds
4780
4781 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
4782 customer.  See L<FS::cust_refund/unapplied>.
4783
4784 =cut
4785
4786 sub total_unapplied_refunds {
4787   my $self = shift;
4788   my $total_unapplied = 0;
4789   $total_unapplied += $_->unapplied foreach $self->cust_refund;
4790   sprintf( "%.2f", $total_unapplied );
4791 }
4792
4793 =item balance
4794
4795 Returns the balance for this customer (total_owed plus total_unrefunded, minus
4796 total_unapplied_credits minus total_unapplied_payments).
4797
4798 =cut
4799
4800 sub balance {
4801   my $self = shift;
4802   sprintf( "%.2f",
4803       $self->total_owed
4804     + $self->total_unapplied_refunds
4805     - $self->total_unapplied_credits
4806     - $self->total_unapplied_payments
4807   );
4808 }
4809
4810 =item balance_date TIME
4811
4812 Returns the balance for this customer, only considering invoices with date
4813 earlier than TIME (total_owed_date minus total_credited minus
4814 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
4815 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
4816 functions.
4817
4818 =cut
4819
4820 sub balance_date {
4821   my $self = shift;
4822   my $time = shift;
4823   sprintf( "%.2f",
4824         $self->total_owed_date($time)
4825       + $self->total_unapplied_refunds
4826       - $self->total_unapplied_credits
4827       - $self->total_unapplied_payments
4828   );
4829 }
4830
4831 =item in_transit_payments
4832
4833 Returns the total of requests for payments for this customer pending in
4834 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
4835
4836 =cut
4837
4838 sub in_transit_payments {
4839   my $self = shift;
4840   my $in_transit_payments = 0;
4841   foreach my $pay_batch ( qsearch('pay_batch', {
4842     'status' => 'I',
4843   } ) ) {
4844     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
4845       'batchnum' => $pay_batch->batchnum,
4846       'custnum' => $self->custnum,
4847     } ) ) {
4848       $in_transit_payments += $cust_pay_batch->amount;
4849     }
4850   }
4851   sprintf( "%.2f", $in_transit_payments );
4852 }
4853
4854 =item paydate_monthyear
4855
4856 Returns a two-element list consisting of the month and year of this customer's
4857 paydate (credit card expiration date for CARD customers)
4858
4859 =cut
4860
4861 sub paydate_monthyear {
4862   my $self = shift;
4863   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
4864     ( $2, $1 );
4865   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
4866     ( $1, $3 );
4867   } else {
4868     ('', '');
4869   }
4870 }
4871
4872 =item invoicing_list [ ARRAYREF ]
4873
4874 If an arguement is given, sets these email addresses as invoice recipients
4875 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
4876 (except as warnings), so use check_invoicing_list first.
4877
4878 Returns a list of email addresses (with svcnum entries expanded).
4879
4880 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
4881 check it without disturbing anything by passing nothing.
4882
4883 This interface may change in the future.
4884
4885 =cut
4886
4887 sub invoicing_list {
4888   my( $self, $arrayref ) = @_;
4889
4890   if ( $arrayref ) {
4891     my @cust_main_invoice;
4892     if ( $self->custnum ) {
4893       @cust_main_invoice =
4894         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4895     } else {
4896       @cust_main_invoice = ();
4897     }
4898     foreach my $cust_main_invoice ( @cust_main_invoice ) {
4899       #warn $cust_main_invoice->destnum;
4900       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
4901         #warn $cust_main_invoice->destnum;
4902         my $error = $cust_main_invoice->delete;
4903         warn $error if $error;
4904       }
4905     }
4906     if ( $self->custnum ) {
4907       @cust_main_invoice =
4908         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4909     } else {
4910       @cust_main_invoice = ();
4911     }
4912     my %seen = map { $_->address => 1 } @cust_main_invoice;
4913     foreach my $address ( @{$arrayref} ) {
4914       next if exists $seen{$address} && $seen{$address};
4915       $seen{$address} = 1;
4916       my $cust_main_invoice = new FS::cust_main_invoice ( {
4917         'custnum' => $self->custnum,
4918         'dest'    => $address,
4919       } );
4920       my $error = $cust_main_invoice->insert;
4921       warn $error if $error;
4922     }
4923   }
4924
4925   if ( $self->custnum ) {
4926     map { $_->address }
4927       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4928   } else {
4929     ();
4930   }
4931
4932 }
4933
4934 =item check_invoicing_list ARRAYREF
4935
4936 Checks these arguements as valid input for the invoicing_list method.  If there
4937 is an error, returns the error, otherwise returns false.
4938
4939 =cut
4940
4941 sub check_invoicing_list {
4942   my( $self, $arrayref ) = @_;
4943
4944   foreach my $address ( @$arrayref ) {
4945
4946     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
4947       return 'Can\'t add FAX invoice destination with a blank FAX number.';
4948     }
4949
4950     my $cust_main_invoice = new FS::cust_main_invoice ( {
4951       'custnum' => $self->custnum,
4952       'dest'    => $address,
4953     } );
4954     my $error = $self->custnum
4955                 ? $cust_main_invoice->check
4956                 : $cust_main_invoice->checkdest
4957     ;
4958     return $error if $error;
4959
4960   }
4961
4962   return "Email address required"
4963     if $conf->exists('cust_main-require_invoicing_list_email')
4964     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
4965
4966   '';
4967 }
4968
4969 =item set_default_invoicing_list
4970
4971 Sets the invoicing list to all accounts associated with this customer,
4972 overwriting any previous invoicing list.
4973
4974 =cut
4975
4976 sub set_default_invoicing_list {
4977   my $self = shift;
4978   $self->invoicing_list($self->all_emails);
4979 }
4980
4981 =item all_emails
4982
4983 Returns the email addresses of all accounts provisioned for this customer.
4984
4985 =cut
4986
4987 sub all_emails {
4988   my $self = shift;
4989   my %list;
4990   foreach my $cust_pkg ( $self->all_pkgs ) {
4991     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
4992     my @svc_acct =
4993       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
4994         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
4995           @cust_svc;
4996     $list{$_}=1 foreach map { $_->email } @svc_acct;
4997   }
4998   keys %list;
4999 }
5000
5001 =item invoicing_list_addpost
5002
5003 Adds postal invoicing to this customer.  If this customer is already configured
5004 to receive postal invoices, does nothing.
5005
5006 =cut
5007
5008 sub invoicing_list_addpost {
5009   my $self = shift;
5010   return if grep { $_ eq 'POST' } $self->invoicing_list;
5011   my @invoicing_list = $self->invoicing_list;
5012   push @invoicing_list, 'POST';
5013   $self->invoicing_list(\@invoicing_list);
5014 }
5015
5016 =item invoicing_list_emailonly
5017
5018 Returns the list of email invoice recipients (invoicing_list without non-email
5019 destinations such as POST and FAX).
5020
5021 =cut
5022
5023 sub invoicing_list_emailonly {
5024   my $self = shift;
5025   warn "$me invoicing_list_emailonly called"
5026     if $DEBUG;
5027   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
5028 }
5029
5030 =item invoicing_list_emailonly_scalar
5031
5032 Returns the list of email invoice recipients (invoicing_list without non-email
5033 destinations such as POST and FAX) as a comma-separated scalar.
5034
5035 =cut
5036
5037 sub invoicing_list_emailonly_scalar {
5038   my $self = shift;
5039   warn "$me invoicing_list_emailonly_scalar called"
5040     if $DEBUG;
5041   join(', ', $self->invoicing_list_emailonly);
5042 }
5043
5044 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
5045
5046 Returns an array of customers referred by this customer (referral_custnum set
5047 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
5048 customers referred by customers referred by this customer and so on, inclusive.
5049 The default behavior is DEPTH 1 (no recursion).
5050
5051 =cut
5052
5053 sub referral_cust_main {
5054   my $self = shift;
5055   my $depth = @_ ? shift : 1;
5056   my $exclude = @_ ? shift : {};
5057
5058   my @cust_main =
5059     map { $exclude->{$_->custnum}++; $_; }
5060       grep { ! $exclude->{ $_->custnum } }
5061         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
5062
5063   if ( $depth > 1 ) {
5064     push @cust_main,
5065       map { $_->referral_cust_main($depth-1, $exclude) }
5066         @cust_main;
5067   }
5068
5069   @cust_main;
5070 }
5071
5072 =item referral_cust_main_ncancelled
5073
5074 Same as referral_cust_main, except only returns customers with uncancelled
5075 packages.
5076
5077 =cut
5078
5079 sub referral_cust_main_ncancelled {
5080   my $self = shift;
5081   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
5082 }
5083
5084 =item referral_cust_pkg [ DEPTH ]
5085
5086 Like referral_cust_main, except returns a flat list of all unsuspended (and
5087 uncancelled) packages for each customer.  The number of items in this list may
5088 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
5089
5090 =cut
5091
5092 sub referral_cust_pkg {
5093   my $self = shift;
5094   my $depth = @_ ? shift : 1;
5095
5096   map { $_->unsuspended_pkgs }
5097     grep { $_->unsuspended_pkgs }
5098       $self->referral_cust_main($depth);
5099 }
5100
5101 =item referring_cust_main
5102
5103 Returns the single cust_main record for the customer who referred this customer
5104 (referral_custnum), or false.
5105
5106 =cut
5107
5108 sub referring_cust_main {
5109   my $self = shift;
5110   return '' unless $self->referral_custnum;
5111   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
5112 }
5113
5114 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
5115
5116 Applies a credit to this customer.  If there is an error, returns the error,
5117 otherwise returns false.
5118
5119 REASON can be a text string, an FS::reason object, or a scalar reference to
5120 a reasonnum.  If a text string, it will be automatically inserted as a new
5121 reason, and a 'reason_type' option must be passed to indicate the
5122 FS::reason_type for the new reason.
5123
5124 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
5125
5126 Any other options are passed to FS::cust_credit::insert.
5127
5128 =cut
5129
5130 sub credit {
5131   my( $self, $amount, $reason, %options ) = @_;
5132
5133   my $cust_credit = new FS::cust_credit {
5134     'custnum' => $self->custnum,
5135     'amount'  => $amount,
5136   };
5137
5138   if ( ref($reason) ) {
5139
5140     if ( ref($reason) eq 'SCALAR' ) {
5141       $cust_credit->reasonnum( $$reason );
5142     } else {
5143       $cust_credit->reasonnum( $reason->reasonnum );
5144     }
5145
5146   } else {
5147     $cust_credit->set('reason', $reason)
5148   }
5149
5150   $cust_credit->addlinfo( delete $options{'addlinfo'} )
5151     if exists($options{'addlinfo'});
5152
5153   $cust_credit->insert(%options);
5154
5155 }
5156
5157 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
5158
5159 Creates a one-time charge for this customer.  If there is an error, returns
5160 the error, otherwise returns false.
5161
5162 =cut
5163
5164 sub charge {
5165   my $self = shift;
5166   my ( $amount, $quantity, $pkg, $comment, $taxclass, $additional, $classnum );
5167   my ( $taxproduct, $override );
5168   if ( ref( $_[0] ) ) {
5169     $amount     = $_[0]->{amount};
5170     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
5171     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
5172     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
5173                                            : '$'. sprintf("%.2f",$amount);
5174     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
5175     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
5176     $additional = $_[0]->{additional};
5177     $taxproduct = $_[0]->{taxproductnum};
5178     $override   = { '' => $_[0]->{tax_override} };
5179   }else{
5180     $amount     = shift;
5181     $quantity   = 1;
5182     $pkg        = @_ ? shift : 'One-time charge';
5183     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
5184     $taxclass   = @_ ? shift : '';
5185     $additional = [];
5186   }
5187
5188   local $SIG{HUP} = 'IGNORE';
5189   local $SIG{INT} = 'IGNORE';
5190   local $SIG{QUIT} = 'IGNORE';
5191   local $SIG{TERM} = 'IGNORE';
5192   local $SIG{TSTP} = 'IGNORE';
5193   local $SIG{PIPE} = 'IGNORE';
5194
5195   my $oldAutoCommit = $FS::UID::AutoCommit;
5196   local $FS::UID::AutoCommit = 0;
5197   my $dbh = dbh;
5198
5199   my $part_pkg = new FS::part_pkg ( {
5200     'pkg'           => $pkg,
5201     'comment'       => $comment,
5202     'plan'          => 'flat',
5203     'freq'          => 0,
5204     'disabled'      => 'Y',
5205     'classnum'      => $classnum ? $classnum : '',
5206     'taxclass'      => $taxclass,
5207     'taxproductnum' => $taxproduct,
5208   } );
5209
5210   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
5211                         ( 0 .. @$additional - 1 )
5212                   ),
5213                   'additional_count' => scalar(@$additional),
5214                   'setup_fee' => $amount,
5215                 );
5216
5217   my $error = $part_pkg->insert( options       => \%options,
5218                                  tax_overrides => $override,
5219                                );
5220   if ( $error ) {
5221     $dbh->rollback if $oldAutoCommit;
5222     return $error;
5223   }
5224
5225   my $pkgpart = $part_pkg->pkgpart;
5226   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
5227   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
5228     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
5229     $error = $type_pkgs->insert;
5230     if ( $error ) {
5231       $dbh->rollback if $oldAutoCommit;
5232       return $error;
5233     }
5234   }
5235
5236   my $cust_pkg = new FS::cust_pkg ( {
5237     'custnum'  => $self->custnum,
5238     'pkgpart'  => $pkgpart,
5239     'quantity' => $quantity,
5240   } );
5241
5242   $error = $cust_pkg->insert;
5243   if ( $error ) {
5244     $dbh->rollback if $oldAutoCommit;
5245     return $error;
5246   }
5247
5248   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5249   '';
5250
5251 }
5252
5253 #=item charge_postal_fee
5254 #
5255 #Applies a one time charge this customer.  If there is an error,
5256 #returns the error, returns the cust_pkg charge object or false
5257 #if there was no charge.
5258 #
5259 #=cut
5260 #
5261 # This should be a customer event.  For that to work requires that bill
5262 # also be a customer event.
5263
5264 sub charge_postal_fee {
5265   my $self = shift;
5266
5267   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
5268   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
5269
5270   my $cust_pkg = new FS::cust_pkg ( {
5271     'custnum'  => $self->custnum,
5272     'pkgpart'  => $pkgpart,
5273     'quantity' => 1,
5274   } );
5275
5276   my $error = $cust_pkg->insert;
5277   $error ? $error : $cust_pkg;
5278 }
5279
5280 =item cust_bill
5281
5282 Returns all the invoices (see L<FS::cust_bill>) for this customer.
5283
5284 =cut
5285
5286 sub cust_bill {
5287   my $self = shift;
5288   sort { $a->_date <=> $b->_date }
5289     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
5290 }
5291
5292 =item open_cust_bill
5293
5294 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
5295 customer.
5296
5297 =cut
5298
5299 sub open_cust_bill {
5300   my $self = shift;
5301   grep { $_->owed > 0 } $self->cust_bill;
5302 }
5303
5304 =item cust_credit
5305
5306 Returns all the credits (see L<FS::cust_credit>) for this customer.
5307
5308 =cut
5309
5310 sub cust_credit {
5311   my $self = shift;
5312   sort { $a->_date <=> $b->_date }
5313     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
5314 }
5315
5316 =item cust_pay
5317
5318 Returns all the payments (see L<FS::cust_pay>) for this customer.
5319
5320 =cut
5321
5322 sub cust_pay {
5323   my $self = shift;
5324   sort { $a->_date <=> $b->_date }
5325     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
5326 }
5327
5328 =item cust_pay_void
5329
5330 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
5331
5332 =cut
5333
5334 sub cust_pay_void {
5335   my $self = shift;
5336   sort { $a->_date <=> $b->_date }
5337     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
5338 }
5339
5340 =item cust_pay_batch
5341
5342 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
5343
5344 =cut
5345
5346 sub cust_pay_batch {
5347   my $self = shift;
5348   sort { $a->_date <=> $b->_date }
5349     qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
5350 }
5351
5352 =item cust_refund
5353
5354 Returns all the refunds (see L<FS::cust_refund>) for this customer.
5355
5356 =cut
5357
5358 sub cust_refund {
5359   my $self = shift;
5360   sort { $a->_date <=> $b->_date }
5361     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
5362 }
5363
5364 =item display_custnum
5365
5366 Returns the displayed customer number for this customer: agent_custid if
5367 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
5368
5369 =cut
5370
5371 sub display_custnum {
5372   my $self = shift;
5373   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
5374     return $self->agent_custid;
5375   } else {
5376     return $self->custnum;
5377   }
5378 }
5379
5380 =item name
5381
5382 Returns a name string for this customer, either "Company (Last, First)" or
5383 "Last, First".
5384
5385 =cut
5386
5387 sub name {
5388   my $self = shift;
5389   my $name = $self->contact;
5390   $name = $self->company. " ($name)" if $self->company;
5391   $name;
5392 }
5393
5394 =item ship_name
5395
5396 Returns a name string for this (service/shipping) contact, either
5397 "Company (Last, First)" or "Last, First".
5398
5399 =cut
5400
5401 sub ship_name {
5402   my $self = shift;
5403   if ( $self->get('ship_last') ) {
5404     my $name = $self->ship_contact;
5405     $name = $self->ship_company. " ($name)" if $self->ship_company;
5406     $name;
5407   } else {
5408     $self->name;
5409   }
5410 }
5411
5412 =item name_short
5413
5414 Returns a name string for this customer, either "Company" or "First Last".
5415
5416 =cut
5417
5418 sub name_short {
5419   my $self = shift;
5420   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
5421 }
5422
5423 =item ship_name_short
5424
5425 Returns a name string for this (service/shipping) contact, either "Company"
5426 or "First Last".
5427
5428 =cut
5429
5430 sub ship_name_short {
5431   my $self = shift;
5432   if ( $self->get('ship_last') ) {
5433     $self->ship_company !~ /^\s*$/
5434       ? $self->ship_company
5435       : $self->ship_contact_firstlast;
5436   } else {
5437     $self->name_company_or_firstlast;
5438   }
5439 }
5440
5441 =item contact
5442
5443 Returns this customer's full (billing) contact name only, "Last, First"
5444
5445 =cut
5446
5447 sub contact {
5448   my $self = shift;
5449   $self->get('last'). ', '. $self->first;
5450 }
5451
5452 =item ship_contact
5453
5454 Returns this customer's full (shipping) contact name only, "Last, First"
5455
5456 =cut
5457
5458 sub ship_contact {
5459   my $self = shift;
5460   $self->get('ship_last')
5461     ? $self->get('ship_last'). ', '. $self->ship_first
5462     : $self->contact;
5463 }
5464
5465 =item contact_firstlast
5466
5467 Returns this customers full (billing) contact name only, "First Last".
5468
5469 =cut
5470
5471 sub contact_firstlast {
5472   my $self = shift;
5473   $self->first. ' '. $self->get('last');
5474 }
5475
5476 =item ship_contact_firstlast
5477
5478 Returns this customer's full (shipping) contact name only, "First Last".
5479
5480 =cut
5481
5482 sub ship_contact_firstlast {
5483   my $self = shift;
5484   $self->get('ship_last')
5485     ? $self->first. ' '. $self->get('ship_last')
5486     : $self->contact_firstlast;
5487 }
5488
5489 =item country_full
5490
5491 Returns this customer's full country name
5492
5493 =cut
5494
5495 sub country_full {
5496   my $self = shift;
5497   code2country($self->country);
5498 }
5499
5500 =item geocode DATA_VENDOR
5501
5502 Returns a value for the customer location as encoded by DATA_VENDOR.
5503 Currently this only makes sense for "CCH" as DATA_VENDOR.
5504
5505 =cut
5506
5507 sub geocode {
5508   my ($self, $data_vendor) = (shift, shift);  #always cch for now
5509
5510   my $geocode = $self->get('geocode');  #XXX only one data_vendor for geocode
5511   return $geocode if $geocode;
5512
5513   my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
5514                ? 'ship_'
5515                : '';
5516
5517   my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
5518     if $self->country eq 'US';
5519
5520   #CCH specific location stuff
5521   my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
5522
5523   my @cust_tax_location =
5524     qsearch( {
5525                'table'     => 'cust_tax_location',
5526                'hashref'   => { 'zip' => $zip, 'data_vendor' => $data_vendor },
5527                'extra_sql' => $extra_sql,
5528                'order_by'  => 'ORDER BY plus4hi',#overlapping with distinct ends
5529              }
5530            );
5531   $geocode = $cust_tax_location[0]->geocode
5532     if scalar(@cust_tax_location);
5533
5534   $geocode;
5535 }
5536
5537 =item cust_status
5538
5539 =item status
5540
5541 Returns a status string for this customer, currently:
5542
5543 =over 4
5544
5545 =item prospect - No packages have ever been ordered
5546
5547 =item active - One or more recurring packages is active
5548
5549 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
5550
5551 =item suspended - All non-cancelled recurring packages are suspended
5552
5553 =item cancelled - All recurring packages are cancelled
5554
5555 =back
5556
5557 =cut
5558
5559 sub status { shift->cust_status(@_); }
5560
5561 sub cust_status {
5562   my $self = shift;
5563   for my $status (qw( prospect active inactive suspended cancelled )) {
5564     my $method = $status.'_sql';
5565     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
5566     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
5567     $sth->execute( ($self->custnum) x $numnum )
5568       or die "Error executing 'SELECT $sql': ". $sth->errstr;
5569     return $status if $sth->fetchrow_arrayref->[0];
5570   }
5571 }
5572
5573 =item ucfirst_cust_status
5574
5575 =item ucfirst_status
5576
5577 Returns the status with the first character capitalized.
5578
5579 =cut
5580
5581 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
5582
5583 sub ucfirst_cust_status {
5584   my $self = shift;
5585   ucfirst($self->cust_status);
5586 }
5587
5588 =item statuscolor
5589
5590 Returns a hex triplet color string for this customer's status.
5591
5592 =cut
5593
5594 use vars qw(%statuscolor);
5595 tie %statuscolor, 'Tie::IxHash',
5596   'prospect'  => '7e0079', #'000000', #black?  naw, purple
5597   'active'    => '00CC00', #green
5598   'inactive'  => '0000CC', #blue
5599   'suspended' => 'FF9900', #yellow
5600   'cancelled' => 'FF0000', #red
5601 ;
5602
5603 sub statuscolor { shift->cust_statuscolor(@_); }
5604
5605 sub cust_statuscolor {
5606   my $self = shift;
5607   $statuscolor{$self->cust_status};
5608 }
5609
5610 =item tickets
5611
5612 Returns an array of hashes representing the customer's RT tickets.
5613
5614 =cut
5615
5616 sub tickets {
5617   my $self = shift;
5618
5619   my $num = $conf->config('cust_main-max_tickets') || 10;
5620   my @tickets = ();
5621
5622   if ( $conf->config('ticket_system') ) {
5623     unless ( $conf->config('ticket_system-custom_priority_field') ) {
5624
5625       @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
5626
5627     } else {
5628
5629       foreach my $priority (
5630         $conf->config('ticket_system-custom_priority_field-values'), ''
5631       ) {
5632         last if scalar(@tickets) >= $num;
5633         push @tickets,
5634           @{ FS::TicketSystem->customer_tickets( $self->custnum,
5635                                                  $num - scalar(@tickets),
5636                                                  $priority,
5637                                                )
5638            };
5639       }
5640     }
5641   }
5642   (@tickets);
5643 }
5644
5645 # Return services representing svc_accts in customer support packages
5646 sub support_services {
5647   my $self = shift;
5648   my %packages = map { $_ => 1 } $conf->config('support_packages');
5649
5650   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
5651     grep { $_->part_svc->svcdb eq 'svc_acct' }
5652     map { $_->cust_svc }
5653     grep { exists $packages{ $_->pkgpart } }
5654     $self->ncancelled_pkgs;
5655
5656 }
5657
5658 =back
5659
5660 =head1 CLASS METHODS
5661
5662 =over 4
5663
5664 =item statuses
5665
5666 Class method that returns the list of possible status strings for customers
5667 (see L<the status method|/status>).  For example:
5668
5669   @statuses = FS::cust_main->statuses();
5670
5671 =cut
5672
5673 sub statuses {
5674   #my $self = shift; #could be class...
5675   keys %statuscolor;
5676 }
5677
5678 =item prospect_sql
5679
5680 Returns an SQL expression identifying prospective cust_main records (customers
5681 with no packages ever ordered)
5682
5683 =cut
5684
5685 use vars qw($select_count_pkgs);
5686 $select_count_pkgs =
5687   "SELECT COUNT(*) FROM cust_pkg
5688     WHERE cust_pkg.custnum = cust_main.custnum";
5689
5690 sub select_count_pkgs_sql {
5691   $select_count_pkgs;
5692 }
5693
5694 sub prospect_sql { "
5695   0 = ( $select_count_pkgs )
5696 "; }
5697
5698 =item active_sql
5699
5700 Returns an SQL expression identifying active cust_main records (customers with
5701 active recurring packages).
5702
5703 =cut
5704
5705 sub active_sql { "
5706   0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
5707       )
5708 "; }
5709
5710 =item inactive_sql
5711
5712 Returns an SQL expression identifying inactive cust_main records (customers with
5713 no active recurring packages, but otherwise unsuspended/uncancelled).
5714
5715 =cut
5716
5717 sub inactive_sql { "
5718   0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
5719   AND
5720   0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
5721 "; }
5722
5723 =item susp_sql
5724 =item suspended_sql
5725
5726 Returns an SQL expression identifying suspended cust_main records.
5727
5728 =cut
5729
5730
5731 sub suspended_sql { susp_sql(@_); }
5732 sub susp_sql { "
5733     0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
5734     AND
5735     0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
5736 "; }
5737
5738 =item cancel_sql
5739 =item cancelled_sql
5740
5741 Returns an SQL expression identifying cancelled cust_main records.
5742
5743 =cut
5744
5745 sub cancelled_sql { cancel_sql(@_); }
5746 sub cancel_sql {
5747
5748   my $recurring_sql = FS::cust_pkg->recurring_sql;
5749   my $cancelled_sql = FS::cust_pkg->cancelled_sql;
5750
5751   "
5752         0 < ( $select_count_pkgs )
5753     AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql   )
5754     AND 0 = ( $select_count_pkgs AND $recurring_sql
5755                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
5756             )
5757     AND 0 = (  $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
5758   ";
5759
5760 }
5761
5762 =item uncancel_sql
5763 =item uncancelled_sql
5764
5765 Returns an SQL expression identifying un-cancelled cust_main records.
5766
5767 =cut
5768
5769 sub uncancelled_sql { uncancel_sql(@_); }
5770 sub uncancel_sql { "
5771   ( 0 < ( $select_count_pkgs
5772                    AND ( cust_pkg.cancel IS NULL
5773                          OR cust_pkg.cancel = 0
5774                        )
5775         )
5776     OR 0 = ( $select_count_pkgs )
5777   )
5778 "; }
5779
5780 =item balance_sql
5781
5782 Returns an SQL fragment to retreive the balance.
5783
5784 =cut
5785
5786 sub balance_sql { "
5787     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
5788         WHERE cust_bill.custnum   = cust_main.custnum     )
5789   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
5790         WHERE cust_pay.custnum    = cust_main.custnum     )
5791   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
5792         WHERE cust_credit.custnum = cust_main.custnum     )
5793   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
5794         WHERE cust_refund.custnum = cust_main.custnum     )
5795 "; }
5796
5797 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5798
5799 Returns an SQL fragment to retreive the balance for this customer, only
5800 considering invoices with date earlier than START_TIME, and optionally not
5801 later than END_TIME (total_owed_date minus total_unapplied_credits minus
5802 total_unapplied_payments).
5803
5804 Times are specified as SQL fragments or numeric
5805 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
5806 L<Date::Parse> for conversion functions.  The empty string can be passed
5807 to disable that time constraint completely.
5808
5809 Available options are:
5810
5811 =over 4
5812
5813 =item unapplied_date
5814
5815 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)
5816
5817 =item total
5818
5819 (unused.  obsolete?)
5820 set to true to remove all customer comparison clauses, for totals
5821
5822 =item where
5823
5824 (unused.  obsolete?)
5825 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
5826
5827 =item join
5828
5829 (unused.  obsolete?)
5830 JOIN clause (typically used with the total option)
5831
5832 =back
5833
5834 =cut
5835
5836 sub balance_date_sql {
5837   my( $class, $start, $end, %opt ) = @_;
5838
5839   my $owed         = FS::cust_bill->owed_sql;
5840   my $unapp_refund = FS::cust_refund->unapplied_sql;
5841   my $unapp_credit = FS::cust_credit->unapplied_sql;
5842   my $unapp_pay    = FS::cust_pay->unapplied_sql;
5843
5844   my $j = $opt{'join'} || '';
5845
5846   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
5847   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
5848   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
5849   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
5850
5851   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
5852     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
5853     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
5854     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
5855   ";
5856
5857 }
5858
5859 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5860
5861 Helper method for balance_date_sql; name (and usage) subject to change
5862 (suggestions welcome).
5863
5864 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
5865 cust_refund, cust_credit or cust_pay).
5866
5867 If TABLE is "cust_bill" or the unapplied_date option is true, only
5868 considers records with date earlier than START_TIME, and optionally not
5869 later than END_TIME .
5870
5871 =cut
5872
5873 sub _money_table_where {
5874   my( $class, $table, $start, $end, %opt ) = @_;
5875
5876   my @where = ();
5877   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
5878   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
5879     push @where, "$table._date <= $start" if defined($start) && length($start);
5880     push @where, "$table._date >  $end"   if defined($end)   && length($end);
5881   }
5882   push @where, @{$opt{'where'}} if $opt{'where'};
5883   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5884
5885   $where;
5886
5887 }
5888
5889 =item search_sql HASHREF
5890
5891 (Class method)
5892
5893 Returns a qsearch hash expression to search for parameters specified in HREF.
5894 Valid parameters are
5895
5896 =over 4
5897
5898 =item agentnum
5899
5900 =item status
5901
5902 =item cancelled_pkgs
5903
5904 bool
5905
5906 =item signupdate
5907
5908 listref of start date, end date
5909
5910 =item payby
5911
5912 listref
5913
5914 =item current_balance
5915
5916 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
5917
5918 =item cust_fields
5919
5920 =item flattened_pkgs
5921
5922 bool
5923
5924 =back
5925
5926 =cut
5927
5928 sub search_sql {
5929   my ($class, $params) = @_;
5930
5931   my $dbh = dbh;
5932
5933   my @where = ();
5934   my $orderby;
5935
5936   ##
5937   # parse agent
5938   ##
5939
5940   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
5941     push @where,
5942       "cust_main.agentnum = $1";
5943   }
5944
5945   ##
5946   # parse status
5947   ##
5948
5949   #prospect active inactive suspended cancelled
5950   if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
5951     my $method = $params->{'status'}. '_sql';
5952     #push @where, $class->$method();
5953     push @where, FS::cust_main->$method();
5954   }
5955
5956   ##
5957   # parse cancelled package checkbox
5958   ##
5959
5960   my $pkgwhere = "";
5961
5962   $pkgwhere .= "AND (cancel = 0 or cancel is null)"
5963     unless $params->{'cancelled_pkgs'};
5964
5965   ##
5966   # dates
5967   ##
5968
5969   foreach my $field (qw( signupdate )) {
5970
5971     next unless exists($params->{$field});
5972
5973     my($beginning, $ending) = @{$params->{$field}};
5974
5975     push @where,
5976       "cust_main.$field IS NOT NULL",
5977       "cust_main.$field >= $beginning",
5978       "cust_main.$field <= $ending";
5979
5980     $orderby ||= "ORDER BY cust_main.$field";
5981
5982   }
5983
5984   ###
5985   # payby
5986   ###
5987
5988   my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
5989   if ( @payby ) {
5990     push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
5991   }
5992
5993   ##
5994   # amounts
5995   ##
5996
5997   #my $balance_sql = $class->balance_sql();
5998   my $balance_sql = FS::cust_main->balance_sql();
5999
6000   push @where, map { s/current_balance/$balance_sql/; $_ }
6001                    @{ $params->{'current_balance'} };
6002
6003   ##
6004   # custbatch
6005   ##
6006
6007   if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
6008     push @where,
6009       "cust_main.custbatch = '$1'";
6010   }
6011
6012   ##
6013   # setup queries, subs, etc. for the search
6014   ##
6015
6016   $orderby ||= 'ORDER BY custnum';
6017
6018   # here is the agent virtualization
6019   push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
6020
6021   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
6022
6023   my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum  ) ';
6024
6025   my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
6026
6027   my $select = join(', ',
6028                  'cust_main.custnum',
6029                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
6030                );
6031
6032   my(@extra_headers) = ();
6033   my(@extra_fields)  = ();
6034
6035   if ($params->{'flattened_pkgs'}) {
6036
6037     if ($dbh->{Driver}->{Name} eq 'Pg') {
6038
6039       $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";
6040
6041     }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
6042       $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
6043       $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
6044     }else{
6045       warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
6046            "omitting packing information from report.";
6047     }
6048
6049     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";
6050
6051     my $sth = dbh->prepare($header_query) or die dbh->errstr;
6052     $sth->execute() or die $sth->errstr;
6053     my $headerrow = $sth->fetchrow_arrayref;
6054     my $headercount = $headerrow ? $headerrow->[0] : 0;
6055     while($headercount) {
6056       unshift @extra_headers, "Package ". $headercount;
6057       unshift @extra_fields, eval q!sub {my $c = shift;
6058                                          my @a = split '\|', $c->magic;
6059                                          my $p = $a[!.--$headercount. q!];
6060                                          $p;
6061                                         };!;
6062     }
6063
6064   }
6065
6066   my $sql_query = {
6067     'table'         => 'cust_main',
6068     'select'        => $select,
6069     'hashref'       => {},
6070     'extra_sql'     => $extra_sql,
6071     'order_by'      => $orderby,
6072     'count_query'   => $count_query,
6073     'extra_headers' => \@extra_headers,
6074     'extra_fields'  => \@extra_fields,
6075   };
6076
6077 }
6078
6079 =item email_search_sql HASHREF
6080
6081 (Class method)
6082
6083 Emails a notice to the specified customers.
6084
6085 Valid parameters are those of the L<search_sql> method, plus the following:
6086
6087 =over 4
6088
6089 =item from
6090
6091 From: address
6092
6093 =item subject
6094
6095 Email Subject:
6096
6097 =item html_body
6098
6099 HTML body
6100
6101 =item text_body
6102
6103 Text body
6104
6105 =item job
6106
6107 Optional job queue job for status updates.
6108
6109 =back
6110
6111 Returns an error message, or false for success.
6112
6113 If an error occurs during any email, stops the enture send and returns that
6114 error.  Presumably if you're getting SMTP errors aborting is better than
6115 retrying everything.
6116
6117 =cut
6118
6119 sub email_search_sql {
6120   my($class, $params) = @_;
6121
6122   my $from = delete $params->{from};
6123   my $subject = delete $params->{subject};
6124   my $html_body = delete $params->{html_body};
6125   my $text_body = delete $params->{text_body};
6126
6127   my $job = delete $params->{'job'};
6128
6129   my $sql_query = $class->search_sql($params);
6130
6131   my $count_query   = delete($sql_query->{'count_query'});
6132   my $count_sth = dbh->prepare($count_query)
6133     or die "Error preparing $count_query: ". dbh->errstr;
6134   $count_sth->execute
6135     or die "Error executing $count_query: ". $count_sth->errstr;
6136   my $count_arrayref = $count_sth->fetchrow_arrayref;
6137   my $num_cust = $count_arrayref->[0];
6138
6139   #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
6140   #my @extra_fields  = @{ delete($sql_query->{'extra_fields'})  };
6141
6142
6143   my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
6144
6145   #eventually order+limit magic to reduce memory use?
6146   foreach my $cust_main ( qsearch($sql_query) ) {
6147
6148     my $to = $cust_main->invoicing_list_emailonly_scalar;
6149     next unless $to;
6150
6151     my $error = send_email(
6152       generate_email(
6153         'from'      => $from,
6154         'to'        => $to,
6155         'subject'   => $subject,
6156         'html_body' => $html_body,
6157         'text_body' => $text_body,
6158       )
6159     );
6160     return $error if $error;
6161
6162     if ( $job ) { #progressbar foo
6163       $num++;
6164       if ( time - $min_sec > $last ) {
6165         my $error = $job->update_statustext(
6166           int( 100 * $num / $num_cust )
6167         );
6168         die $error if $error;
6169         $last = time;
6170       }
6171     }
6172
6173   }
6174
6175   return '';
6176 }
6177
6178 use Storable qw(thaw);
6179 use Data::Dumper;
6180 use MIME::Base64;
6181 sub process_email_search_sql {
6182   my $job = shift;
6183   #warn "$me process_re_X $method for job $job\n" if $DEBUG;
6184
6185   my $param = thaw(decode_base64(shift));
6186   warn Dumper($param) if $DEBUG;
6187
6188   $param->{'job'} = $job;
6189
6190   my $error = FS::cust_main->email_search_sql( $param );
6191   die $error if $error;
6192
6193 }
6194
6195 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
6196
6197 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
6198 records.  Currently, I<first>, I<last> and/or I<company> may be specified (the
6199 appropriate ship_ field is also searched).
6200
6201 Additional options are the same as FS::Record::qsearch
6202
6203 =cut
6204
6205 sub fuzzy_search {
6206   my( $self, $fuzzy, $hash, @opt) = @_;
6207   #$self
6208   $hash ||= {};
6209   my @cust_main = ();
6210
6211   check_and_rebuild_fuzzyfiles();
6212   foreach my $field ( keys %$fuzzy ) {
6213
6214     my $all = $self->all_X($field);
6215     next unless scalar(@$all);
6216
6217     my %match = ();
6218     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
6219
6220     my @fcust = ();
6221     foreach ( keys %match ) {
6222       push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
6223       push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
6224     }
6225     my %fsaw = ();
6226     push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
6227   }
6228
6229   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
6230   my %saw = ();
6231   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
6232
6233   @cust_main;
6234
6235 }
6236
6237 =item masked FIELD
6238
6239 Returns a masked version of the named field
6240
6241 =cut
6242
6243 sub masked {
6244 my ($self,$field) = @_;
6245
6246 # Show last four
6247
6248 'x'x(length($self->getfield($field))-4).
6249   substr($self->getfield($field), (length($self->getfield($field))-4));
6250
6251 }
6252
6253 =back
6254
6255 =head1 SUBROUTINES
6256
6257 =over 4
6258
6259 =item smart_search OPTION => VALUE ...
6260
6261 Accepts the following options: I<search>, the string to search for.  The string
6262 will be searched for as a customer number, phone number, name or company name,
6263 as an exact, or, in some cases, a substring or fuzzy match (see the source code
6264 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
6265 skip fuzzy matching when an exact match is found.
6266
6267 Any additional options are treated as an additional qualifier on the search
6268 (i.e. I<agentnum>).
6269
6270 Returns a (possibly empty) array of FS::cust_main objects.
6271
6272 =cut
6273
6274 sub smart_search {
6275   my %options = @_;
6276
6277   #here is the agent virtualization
6278   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
6279
6280   my @cust_main = ();
6281
6282   my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
6283   my $search = delete $options{'search'};
6284   ( my $alphanum_search = $search ) =~ s/\W//g;
6285
6286   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
6287
6288     #false laziness w/Record::ut_phone
6289     my $phonen = "$1-$2-$3";
6290     $phonen .= " x$4" if $4;
6291
6292     push @cust_main, qsearch( {
6293       'table'   => 'cust_main',
6294       'hashref' => { %options },
6295       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
6296                      ' ( '.
6297                          join(' OR ', map "$_ = '$phonen'",
6298                                           qw( daytime night fax
6299                                               ship_daytime ship_night ship_fax )
6300                              ).
6301                      ' ) '.
6302                      " AND $agentnums_sql", #agent virtualization
6303     } );
6304
6305     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
6306       #try looking for matches with extensions unless one was specified
6307
6308       push @cust_main, qsearch( {
6309         'table'   => 'cust_main',
6310         'hashref' => { %options },
6311         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
6312                        ' ( '.
6313                            join(' OR ', map "$_ LIKE '$phonen\%'",
6314                                             qw( daytime night
6315                                                 ship_daytime ship_night )
6316                                ).
6317                        ' ) '.
6318                        " AND $agentnums_sql", #agent virtualization
6319       } );
6320
6321     }
6322
6323   # custnum search (also try agent_custid), with some tweaking options if your
6324   # legacy cust "numbers" have letters
6325   }
6326
6327   if ( $search =~ /^\s*(\d+)\s*$/
6328             || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
6329                  && $search =~ /^\s*(\w\w?\d+)\s*$/
6330                )
6331           )
6332   {
6333
6334     my $num = $1;
6335
6336     if ( $num <= 2147483647 ) { #need a bigint custnum?  wow.
6337       push @cust_main, qsearch( {
6338         'table'     => 'cust_main',
6339         'hashref'   => { 'custnum' => $num, %options },
6340         'extra_sql' => " AND $agentnums_sql", #agent virtualization
6341       } );
6342     }
6343
6344     push @cust_main, qsearch( {
6345       'table'     => 'cust_main',
6346       'hashref'   => { 'agent_custid' => $num, %options },
6347       'extra_sql' => " AND $agentnums_sql", #agent virtualization
6348     } );
6349
6350   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
6351
6352     my($company, $last, $first) = ( $1, $2, $3 );
6353
6354     # "Company (Last, First)"
6355     #this is probably something a browser remembered,
6356     #so just do an exact search
6357
6358     foreach my $prefix ( '', 'ship_' ) {
6359       push @cust_main, qsearch( {
6360         'table'     => 'cust_main',
6361         'hashref'   => { $prefix.'first'   => $first,
6362                          $prefix.'last'    => $last,
6363                          $prefix.'company' => $company,
6364                          %options,
6365                        },
6366         'extra_sql' => " AND $agentnums_sql",
6367       } );
6368     }
6369
6370   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
6371                                               # try (ship_){last,company}
6372
6373     my $value = lc($1);
6374
6375     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
6376     # # full strings the browser remembers won't work
6377     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
6378
6379     use Lingua::EN::NameParse;
6380     my $NameParse = new Lingua::EN::NameParse(
6381              auto_clean     => 1,
6382              allow_reversed => 1,
6383     );
6384
6385     my($last, $first) = ( '', '' );
6386     #maybe disable this too and just rely on NameParse?
6387     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
6388
6389       ($last, $first) = ( $1, $2 );
6390
6391     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
6392     } elsif ( ! $NameParse->parse($value) ) {
6393
6394       my %name = $NameParse->components;
6395       $first = $name{'given_name_1'};
6396       $last  = $name{'surname_1'};
6397
6398     }
6399
6400     if ( $first && $last ) {
6401
6402       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
6403
6404       #exact
6405       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
6406       $sql .= "
6407         (     ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
6408            OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
6409         )";
6410
6411       push @cust_main, qsearch( {
6412         'table'     => 'cust_main',
6413         'hashref'   => \%options,
6414         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
6415       } );
6416
6417       # or it just be something that was typed in... (try that in a sec)
6418
6419     }
6420
6421     my $q_value = dbh->quote($value);
6422
6423     #exact
6424     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
6425     $sql .= " (    LOWER(last)         = $q_value
6426                 OR LOWER(company)      = $q_value
6427                 OR LOWER(ship_last)    = $q_value
6428                 OR LOWER(ship_company) = $q_value
6429               )";
6430
6431     push @cust_main, qsearch( {
6432       'table'     => 'cust_main',
6433       'hashref'   => \%options,
6434       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
6435     } );
6436
6437     #no exact match, trying substring/fuzzy
6438     #always do substring & fuzzy (unless they're explicity config'ed off)
6439     #getting complaints searches are not returning enough
6440     unless ( @cust_main  && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
6441
6442       #still some false laziness w/search_sql (was search/cust_main.cgi)
6443
6444       #substring
6445
6446       my @hashrefs = (
6447         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
6448         { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
6449       );
6450
6451       if ( $first && $last ) {
6452
6453         push @hashrefs,
6454           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
6455             'last'         => { op=>'ILIKE', value=>"%$last%" },
6456           },
6457           { 'ship_first'   => { op=>'ILIKE', value=>"%$first%" },
6458             'ship_last'    => { op=>'ILIKE', value=>"%$last%" },
6459           },
6460         ;
6461
6462       } else {
6463
6464         push @hashrefs,
6465           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
6466           { 'ship_last'    => { op=>'ILIKE', value=>"%$value%" }, },
6467         ;
6468       }
6469
6470       foreach my $hashref ( @hashrefs ) {
6471
6472         push @cust_main, qsearch( {
6473           'table'     => 'cust_main',
6474           'hashref'   => { %$hashref,
6475                            %options,
6476                          },
6477           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
6478         } );
6479
6480       }
6481
6482       #fuzzy
6483       my @fuzopts = (
6484         \%options,                #hashref
6485         '',                       #select
6486         " AND $agentnums_sql",    #extra_sql  #agent virtualization
6487       );
6488
6489       if ( $first && $last ) {
6490         push @cust_main, FS::cust_main->fuzzy_search(
6491           { 'last'   => $last,    #fuzzy hashref
6492             'first'  => $first }, #
6493           @fuzopts
6494         );
6495       }
6496       foreach my $field ( 'last', 'company' ) {
6497         push @cust_main,
6498           FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
6499       }
6500
6501     }
6502
6503     #eliminate duplicates
6504     my %saw = ();
6505     @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
6506
6507   }
6508
6509   @cust_main;
6510
6511 }
6512
6513 =item email_search
6514
6515 Accepts the following options: I<email>, the email address to search for.  The
6516 email address will be searched for as an email invoice destination and as an
6517 svc_acct account.
6518
6519 #Any additional options are treated as an additional qualifier on the search
6520 #(i.e. I<agentnum>).
6521
6522 Returns a (possibly empty) array of FS::cust_main objects (but usually just
6523 none or one).
6524
6525 =cut
6526
6527 sub email_search {
6528   my %options = @_;
6529
6530   local($DEBUG) = 1;
6531
6532   my $email = delete $options{'email'};
6533
6534   #we're only being used by RT at the moment... no agent virtualization yet
6535   #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
6536
6537   my @cust_main = ();
6538
6539   if ( $email =~ /([^@]+)\@([^@]+)/ ) {
6540
6541     my ( $user, $domain ) = ( $1, $2 );
6542
6543     warn "$me smart_search: searching for $user in domain $domain"
6544       if $DEBUG;
6545
6546     push @cust_main,
6547       map $_->cust_main,
6548           qsearch( {
6549                      'table'     => 'cust_main_invoice',
6550                      'hashref'   => { 'dest' => $email },
6551                    }
6552                  );
6553
6554     push @cust_main,
6555       map  $_->cust_main,
6556       grep $_,
6557       map  $_->cust_svc->cust_pkg,
6558           qsearch( {
6559                      'table'     => 'svc_acct',
6560                      'hashref'   => { 'username' => $user, },
6561                      'extra_sql' =>
6562                        'AND ( SELECT domain FROM svc_domain
6563                                 WHERE svc_acct.domsvc = svc_domain.svcnum
6564                             ) = '. dbh->quote($domain),
6565                    }
6566                  );
6567   }
6568
6569   my %saw = ();
6570   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
6571
6572   warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
6573     if $DEBUG;
6574
6575   @cust_main;
6576
6577 }
6578
6579 =item check_and_rebuild_fuzzyfiles
6580
6581 =cut
6582
6583 use vars qw(@fuzzyfields);
6584 @fuzzyfields = ( 'last', 'first', 'company' );
6585
6586 sub check_and_rebuild_fuzzyfiles {
6587   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6588   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
6589 }
6590
6591 =item rebuild_fuzzyfiles
6592
6593 =cut
6594
6595 sub rebuild_fuzzyfiles {
6596
6597   use Fcntl qw(:flock);
6598
6599   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6600   mkdir $dir, 0700 unless -d $dir;
6601
6602   foreach my $fuzzy ( @fuzzyfields ) {
6603
6604     open(LOCK,">>$dir/cust_main.$fuzzy")
6605       or die "can't open $dir/cust_main.$fuzzy: $!";
6606     flock(LOCK,LOCK_EX)
6607       or die "can't lock $dir/cust_main.$fuzzy: $!";
6608
6609     open (CACHE,">$dir/cust_main.$fuzzy.tmp")
6610       or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
6611
6612     foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
6613       my $sth = dbh->prepare("SELECT $field FROM cust_main".
6614                              " WHERE $field != '' AND $field IS NOT NULL");
6615       $sth->execute or die $sth->errstr;
6616
6617       while ( my $row = $sth->fetchrow_arrayref ) {
6618         print CACHE $row->[0]. "\n";
6619       }
6620
6621     }
6622
6623     close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
6624
6625     rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
6626     close LOCK;
6627   }
6628
6629 }
6630
6631 =item all_X
6632
6633 =cut
6634
6635 sub all_X {
6636   my( $self, $field ) = @_;
6637   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6638   open(CACHE,"<$dir/cust_main.$field")
6639     or die "can't open $dir/cust_main.$field: $!";
6640   my @array = map { chomp; $_; } <CACHE>;
6641   close CACHE;
6642   \@array;
6643 }
6644
6645 =item append_fuzzyfiles LASTNAME COMPANY
6646
6647 =cut
6648
6649 sub append_fuzzyfiles {
6650   #my( $first, $last, $company ) = @_;
6651
6652   &check_and_rebuild_fuzzyfiles;
6653
6654   use Fcntl qw(:flock);
6655
6656   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6657
6658   foreach my $field (qw( first last company )) {
6659     my $value = shift;
6660
6661     if ( $value ) {
6662
6663       open(CACHE,">>$dir/cust_main.$field")
6664         or die "can't open $dir/cust_main.$field: $!";
6665       flock(CACHE,LOCK_EX)
6666         or die "can't lock $dir/cust_main.$field: $!";
6667
6668       print CACHE "$value\n";
6669
6670       flock(CACHE,LOCK_UN)
6671         or die "can't unlock $dir/cust_main.$field: $!";
6672       close CACHE;
6673     }
6674
6675   }
6676
6677   1;
6678 }
6679
6680 =item batch_charge
6681
6682 =cut
6683
6684 sub batch_charge {
6685   my $param = shift;
6686   #warn join('-',keys %$param);
6687   my $fh = $param->{filehandle};
6688   my @fields = @{$param->{fields}};
6689
6690   eval "use Text::CSV_XS;";
6691   die $@ if $@;
6692
6693   my $csv = new Text::CSV_XS;
6694   #warn $csv;
6695   #warn $fh;
6696
6697   my $imported = 0;
6698   #my $columns;
6699
6700   local $SIG{HUP} = 'IGNORE';
6701   local $SIG{INT} = 'IGNORE';
6702   local $SIG{QUIT} = 'IGNORE';
6703   local $SIG{TERM} = 'IGNORE';
6704   local $SIG{TSTP} = 'IGNORE';
6705   local $SIG{PIPE} = 'IGNORE';
6706
6707   my $oldAutoCommit = $FS::UID::AutoCommit;
6708   local $FS::UID::AutoCommit = 0;
6709   my $dbh = dbh;
6710
6711   #while ( $columns = $csv->getline($fh) ) {
6712   my $line;
6713   while ( defined($line=<$fh>) ) {
6714
6715     $csv->parse($line) or do {
6716       $dbh->rollback if $oldAutoCommit;
6717       return "can't parse: ". $csv->error_input();
6718     };
6719
6720     my @columns = $csv->fields();
6721     #warn join('-',@columns);
6722
6723     my %row = ();
6724     foreach my $field ( @fields ) {
6725       $row{$field} = shift @columns;
6726     }
6727
6728     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
6729     unless ( $cust_main ) {
6730       $dbh->rollback if $oldAutoCommit;
6731       return "unknown custnum $row{'custnum'}";
6732     }
6733
6734     if ( $row{'amount'} > 0 ) {
6735       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
6736       if ( $error ) {
6737         $dbh->rollback if $oldAutoCommit;
6738         return $error;
6739       }
6740       $imported++;
6741     } elsif ( $row{'amount'} < 0 ) {
6742       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
6743                                       $row{'pkg'}                         );
6744       if ( $error ) {
6745         $dbh->rollback if $oldAutoCommit;
6746         return $error;
6747       }
6748       $imported++;
6749     } else {
6750       #hmm?
6751     }
6752
6753   }
6754
6755   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6756
6757   return "Empty file!" unless $imported;
6758
6759   ''; #no error
6760
6761 }
6762
6763 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
6764
6765 Sends a templated email notification to the customer (see L<Text::Template>).
6766
6767 OPTIONS is a hash and may include
6768
6769 I<from> - the email sender (default is invoice_from)
6770
6771 I<to> - comma-separated scalar or arrayref of recipients
6772    (default is invoicing_list)
6773
6774 I<subject> - The subject line of the sent email notification
6775    (default is "Notice from company_name")
6776
6777 I<extra_fields> - a hashref of name/value pairs which will be substituted
6778    into the template
6779
6780 The following variables are vavailable in the template.
6781
6782 I<$first> - the customer first name
6783 I<$last> - the customer last name
6784 I<$company> - the customer company
6785 I<$payby> - a description of the method of payment for the customer
6786             # would be nice to use FS::payby::shortname
6787 I<$payinfo> - the account information used to collect for this customer
6788 I<$expdate> - the expiration of the customer payment in seconds from epoch
6789
6790 =cut
6791
6792 sub notify {
6793   my ($self, $template, %options) = @_;
6794
6795   return unless $conf->exists($template);
6796
6797   my $from = $conf->config('invoice_from', $self->agentnum)
6798     if $conf->exists('invoice_from', $self->agentnum);
6799   $from = $options{from} if exists($options{from});
6800
6801   my $to = join(',', $self->invoicing_list_emailonly);
6802   $to = $options{to} if exists($options{to});
6803
6804   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
6805     if $conf->exists('company_name', $self->agentnum);
6806   $subject = $options{subject} if exists($options{subject});
6807
6808   my $notify_template = new Text::Template (TYPE => 'ARRAY',
6809                                             SOURCE => [ map "$_\n",
6810                                               $conf->config($template)]
6811                                            )
6812     or die "can't create new Text::Template object: Text::Template::ERROR";
6813   $notify_template->compile()
6814     or die "can't compile template: Text::Template::ERROR";
6815
6816   $FS::notify_template::_template::company_name =
6817     $conf->config('company_name', $self->agentnum);
6818   $FS::notify_template::_template::company_address =
6819     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
6820
6821   my $paydate = $self->paydate || '2037-12-31';
6822   $FS::notify_template::_template::first = $self->first;
6823   $FS::notify_template::_template::last = $self->last;
6824   $FS::notify_template::_template::company = $self->company;
6825   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
6826   my $payby = $self->payby;
6827   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6828   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6829
6830   #credit cards expire at the end of the month/year of their exp date
6831   if ($payby eq 'CARD' || $payby eq 'DCRD') {
6832     $FS::notify_template::_template::payby = 'credit card';
6833     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6834     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6835     $expire_time--;
6836   }elsif ($payby eq 'COMP') {
6837     $FS::notify_template::_template::payby = 'complimentary account';
6838   }else{
6839     $FS::notify_template::_template::payby = 'current method';
6840   }
6841   $FS::notify_template::_template::expdate = $expire_time;
6842
6843   for (keys %{$options{extra_fields}}){
6844     no strict "refs";
6845     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
6846   }
6847
6848   send_email(from => $from,
6849              to => $to,
6850              subject => $subject,
6851              body => $notify_template->fill_in( PACKAGE =>
6852                                                 'FS::notify_template::_template'                                              ),
6853             );
6854
6855 }
6856
6857 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
6858
6859 Generates a templated notification to the customer (see L<Text::Template>).
6860
6861 OPTIONS is a hash and may include
6862
6863 I<extra_fields> - a hashref of name/value pairs which will be substituted
6864    into the template.  These values may override values mentioned below
6865    and those from the customer record.
6866
6867 The following variables are available in the template instead of or in addition
6868 to the fields of the customer record.
6869
6870 I<$payby> - a description of the method of payment for the customer
6871             # would be nice to use FS::payby::shortname
6872 I<$payinfo> - the masked account information used to collect for this customer
6873 I<$expdate> - the expiration of the customer payment method in seconds from epoch
6874 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
6875
6876 =cut
6877
6878 sub generate_letter {
6879   my ($self, $template, %options) = @_;
6880
6881   return unless $conf->exists($template);
6882
6883   my $letter_template = new Text::Template
6884                         ( TYPE       => 'ARRAY',
6885                           SOURCE     => [ map "$_\n", $conf->config($template)],
6886                           DELIMITERS => [ '[@--', '--@]' ],
6887                         )
6888     or die "can't create new Text::Template object: Text::Template::ERROR";
6889
6890   $letter_template->compile()
6891     or die "can't compile template: Text::Template::ERROR";
6892
6893   my %letter_data = map { $_ => $self->$_ } $self->fields;
6894   $letter_data{payinfo} = $self->mask_payinfo;
6895
6896   #my $paydate = $self->paydate || '2037-12-31';
6897   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
6898
6899   my $payby = $self->payby;
6900   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6901   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6902
6903   #credit cards expire at the end of the month/year of their exp date
6904   if ($payby eq 'CARD' || $payby eq 'DCRD') {
6905     $letter_data{payby} = 'credit card';
6906     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6907     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6908     $expire_time--;
6909   }elsif ($payby eq 'COMP') {
6910     $letter_data{payby} = 'complimentary account';
6911   }else{
6912     $letter_data{payby} = 'current method';
6913   }
6914   $letter_data{expdate} = $expire_time;
6915
6916   for (keys %{$options{extra_fields}}){
6917     $letter_data{$_} = $options{extra_fields}->{$_};
6918   }
6919
6920   unless(exists($letter_data{returnaddress})){
6921     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
6922                                                   $self->agent_template)
6923                      );
6924     if ( length($retadd) ) {
6925       $letter_data{returnaddress} = $retadd;
6926     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
6927       $letter_data{returnaddress} =
6928         join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
6929                           $conf->config('company_address', $self->agentnum)
6930         );
6931     } else {
6932       $letter_data{returnaddress} = '~';
6933     }
6934   }
6935
6936   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
6937
6938   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
6939
6940   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
6941   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
6942                            DIR      => $dir,
6943                            SUFFIX   => '.tex',
6944                            UNLINK   => 0,
6945                          ) or die "can't open temp file: $!\n";
6946
6947   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
6948   close $fh;
6949   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
6950   return $1;
6951 }
6952
6953 =item print_ps TEMPLATE
6954
6955 Returns an postscript letter filled in from TEMPLATE, as a scalar.
6956
6957 =cut
6958
6959 sub print_ps {
6960   my $self = shift;
6961   my $file = $self->generate_letter(@_);
6962   FS::Misc::generate_ps($file);
6963 }
6964
6965 =item print TEMPLATE
6966
6967 Prints the filled in template.
6968
6969 TEMPLATE is the name of a L<Text::Template> to fill in and print.
6970
6971 =cut
6972
6973 sub queueable_print {
6974   my %opt = @_;
6975
6976   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
6977     or die "invalid customer number: " . $opt{custvnum};
6978
6979   my $error = $self->print( $opt{template} );
6980   die $error if $error;
6981 }
6982
6983 sub print {
6984   my ($self, $template) = (shift, shift);
6985   do_print [ $self->print_ps($template) ];
6986 }
6987
6988 #these three subs should just go away once agent stuff is all config overrides
6989
6990 sub agent_template {
6991   my $self = shift;
6992   $self->_agent_plandata('agent_templatename');
6993 }
6994
6995 sub agent_invoice_from {
6996   my $self = shift;
6997   $self->_agent_plandata('agent_invoice_from');
6998 }
6999
7000 sub _agent_plandata {
7001   my( $self, $option ) = @_;
7002
7003   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
7004   #agent-specific Conf
7005
7006   use FS::part_event::Condition;
7007
7008   my $agentnum = $self->agentnum;
7009
7010   my $regexp = '';
7011   if ( driver_name =~ /^Pg/i ) {
7012     $regexp = '~';
7013   } elsif ( driver_name =~ /^mysql/i ) {
7014     $regexp = 'REGEXP';
7015   } else {
7016     die "don't know how to use regular expressions in ". driver_name. " databases";
7017   }
7018
7019   my $part_event_option =
7020     qsearchs({
7021       'select'    => 'part_event_option.*',
7022       'table'     => 'part_event_option',
7023       'addl_from' => q{
7024         LEFT JOIN part_event USING ( eventpart )
7025         LEFT JOIN part_event_option AS peo_agentnum
7026           ON ( part_event.eventpart = peo_agentnum.eventpart
7027                AND peo_agentnum.optionname = 'agentnum'
7028                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
7029              )
7030         LEFT JOIN part_event_condition
7031           ON ( part_event.eventpart = part_event_condition.eventpart
7032                AND part_event_condition.conditionname = 'cust_bill_age'
7033              )
7034         LEFT JOIN part_event_condition_option
7035           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
7036                AND part_event_condition_option.optionname = 'age'
7037              )
7038       },
7039       #'hashref'   => { 'optionname' => $option },
7040       #'hashref'   => { 'part_event_option.optionname' => $option },
7041       'extra_sql' =>
7042         " WHERE part_event_option.optionname = ". dbh->quote($option).
7043         " AND action = 'cust_bill_send_agent' ".
7044         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
7045         " AND peo_agentnum.optionname = 'agentnum' ".
7046         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
7047         " ORDER BY
7048            CASE WHEN part_event_condition_option.optionname IS NULL
7049            THEN -1
7050            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
7051         " END
7052           , part_event.weight".
7053         " LIMIT 1"
7054     });
7055
7056   unless ( $part_event_option ) {
7057     return $self->agent->invoice_template || ''
7058       if $option eq 'agent_templatename';
7059     return '';
7060   }
7061
7062   $part_event_option->optionvalue;
7063
7064 }
7065
7066 sub queued_bill {
7067   ## actual sub, not a method, designed to be called from the queue.
7068   ## sets up the customer, and calls the bill_and_collect
7069   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
7070   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
7071       $cust_main->bill_and_collect(
7072         %args,
7073       );
7074 }
7075
7076 =back
7077
7078 =head1 BUGS
7079
7080 The delete method.
7081
7082 The delete method should possibly take an FS::cust_main object reference
7083 instead of a scalar customer number.
7084
7085 Bill and collect options should probably be passed as references instead of a
7086 list.
7087
7088 There should probably be a configuration file with a list of allowed credit
7089 card types.
7090
7091 No multiple currency support (probably a larger project than just this module).
7092
7093 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
7094
7095 Birthdates rely on negative epoch values.
7096
7097 The payby for card/check batches is broken.  With mixed batching, bad
7098 things will happen.
7099
7100 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
7101
7102 =head1 SEE ALSO
7103
7104 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
7105 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
7106 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
7107
7108 =cut
7109
7110 1;
7111