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