FS/FS/cust_main.pm

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