FS/FS/cust_main.pm

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